C ------------------------------------------------------------------------- C These functions write out gms compatible BINARY dataset files. C The main function shows an example of how to use these subroutines. C C For questions on format, see the gms file formats document, OR, C contact tech support at tech2@ems-i.com C ------------------------------------------------------------------------- C ------------------------------------------------------------------------- C TEST MAIN FUNCTION C to read test.dat into gms, you must create a 3dgrid with 30 cells C ------------------------------------------------------------------------- program main integer ifile,numdata,numcells,statusflags real value,datavalues,x,y,z character name*40 dimension datavalues(30),x(30),y(30),z(30),statusflags(30) ifile=10 numdata=30 numcells=30 open(ifile,file='test.dat',err=100,form='unformatted', & status='unknown') goto 200 100 write (*,101) 'test.dat' 101 format(1X, 'Error: File Cannot Be Found or Opened =>',A50) 200 name='functiontest' value=0 do i=1,numdata value = value + 5; x(i) = value y(i) = value z(i) = value datavalues(i) = value if (i.GT.15) then statusflags(i) = 1 else statusflags(i) = 0 endif enddo C uncomment below to test scalar dataset OR call InitializeGMSDatasetFile(ifile,name,numdata,numcells,.true.) call WriteGMSScalarTimeStep(ifile,numdata,numcells,12.0, & statusflags,datavalues,.false.) call WriteGMSScalarTimeStep(ifile,numdata,numcells,13.0, & statusflags,datavalue,.true.) C uncomment below to test vector dataset C call InitializeGMSDatasetFile(ifile,name,numdata,numcells,.false.) C call WriteGMSVectorTimeStep(ifile,numdata,numcells,13.0, C & statusflags,x,y,z,.true.) C call WriteGMSVectorTimeStep(ifile,numdata,numcells,12.0, C & statusflags,x,y,z,.false.) call EndGMSDatasetFile(ifile) close(ifile); write(*,*) 'File test.dat has been written' pause end C ----------------------------------------------------------------------------- C NAME: InitializeGMSDatasetFile C PURPOSE: Writes all starting flags for a GMS binary data set file C PRE: file is valid and ready for writing. C ifile is the iunit C name is the data set name C numdata is the number of values in the data set C numcells is the number of cells in the data set C *** for cell-centered grids, numdata = numcells C scalar is 1 scalar data set, 0 vector data set C POST: The file is ready for time steps for data the size of numdata C AUTHOR: jig 6/2/1999 C ----------------------------------------------------------------------------- subroutine InitializeGMSDatasetFile (ifile, name, numdata, & numcells, scalar) integer ifile,numdata,numcells logical scalar character name*40 integer objectcard,sizefloatcard,sizeflagcard,beginscalarcard, & beginvectorcard,numdatacard,numcellscard,namecard, & vectortypecard integer sizefloat,sizeflag,objecttype,version,vectortype objectcard = 100 sizefloatcard = 110 sizeflagcard = 120 beginscalarcard = 130 beginvectorcard = 140 numdatacard = 170 numcellscard = 180 namecard = 190 vectortypecard = 150 sizefloat = 4; sizeflag = 4; objecttype = 7; ! 3D grid version = 3000; ! GMS binary data set file format version vectortype = 1; ! Vectors will be applied to cells (not gridnodes) write(ifile) version,objectcard,objecttype,sizefloatcard, & sizefloat,sizeflagcard,sizeflag if (scalar.EQ. .true.) then write(ifile) beginscalarcard else write(ifile) beginvectorcard,vectortypecard,vectortype endif write(ifile) numdatacard,numdata write(ifile) numcellscard,numcells ! cell-centered grids numdata=numcells write(ifile) namecard,name ! nume MUST be 40 characters return end C ----------------------------------------------------------------------------- C NAME: WriteGMSScalarTimeStep C PURPOSE: Writes a scalar time step to a GMS binary data set file C PRE: File is valid and has been initialized C ifile is the iunit C numdata is the number of values in the data set C timestep is the time corresponding to the time step C statflags is an array of stat flags - size(numcells). C datavalues is an array of scalar values - size(numdata). C usestatflags write stat flags C POST: One more time step has been written and file is ready for another C scalar time step or time step end flag C AUTHOR: jig 6/2/1999 C ----------------------------------------------------------------------------- subroutine WriteGMSScalarTimeStep (ifile,numdata,numcells, & timestep,statflags,datavalues, & usestatflags) integer ifile,numdata,numcells,statflags logical usestatflags real timestep,datavalues dimension datavalues(numdata),statflags(numcells) integer timestepcard,activeflag timestepcard = 200 activeflag = 0 if (usestatflags.EQ. .true.) activeflag=1 write(ifile) timestepcard,activeflag,timestep if (usestatflags.EQ. .true.) then write(ifile) (statflags(i),i=1,numcells) endif write(ifile) (datavalues(i),i=1,numdata) return end C ----------------------------------------------------------------------------- C NAME: WriteGMSVectorTimeStep C PURPOSE: Writes a vector time step to a GMS binary data set file C PRE: File is valid and has been initialized for vector data C ifile is the iunit C numdata is the number of values in the data set C timestep is the time corresponding to the time step C statflags is an array of stat flags - size(numcells). C x,y,z are arrays of vector values - each of C size(numdata). C usestatflags write stat flags C POST: One more time step has been written and file is ready for another C vector time step or time step end flag C AUTHOR: jig 6/2/1999 C ----------------------------------------------------------------------------- subroutine WriteGMSVectorTimeStep (ifile,numdata,numcells, & timestep,statflags,x,y,z, & usestatflags) integer ifile,numdata,numcells,statflags real timestep,x,y,z logical usestatflags dimension statflags(numcells),x(numdata),y(numdata),z(numdata) integer timestepcard,activeflag timestepcard = 200 activeflag = 0 if (usestatflags.EQ. .true.) activeflag = 1 write(ifile) timestepcard,activeflag,timestep if (usestatflags.EQ. .true.) then write(ifile) (statflags(i),i=1,numcells) endif write(ifile) (x(i),y(i),z(i),i=1,numdata) return end C --------------------------------------------------------------------------- C NAME: EndGMSDatasetFile C PURPOSE: Writes the end flag for a GMS binary data set file C PRE: File is valid and all timesteps have been written C POST: End flag is written and file is ready to be closed C AUTHOR: jig 6/2/1999 C --------------------------------------------------------------------------- subroutine EndGMSDatasetFile (ifile) integer ifile,endcard endcard = 210 ! signifies the end of a dataset write(ifile) endcard return end