c Program to test the C UF routines for Fortran c ------------------------------------------------------------------------------ c f77 uftest.f /usr/local/lib/libufroutines.a -o uftest (same for g77) c ------------------------------------------------------------------------------ c You need to know the UF data format. See Barnes, 1980 in Bul. Amer. Met. Soc. c (especially Table 2 page 1403). The data returned is all INTEGER*2 except c for the radar field values which have been scaled and are REAL*4. (Note c the missing data values were not scaled to make it easier to find the values.) c And field names are CHARACTER*2 (but C routines treat them as INTEGER*2). c UF-Write calculates the positioning variables (words), but outside of that c one must supply UF-Write with the rest of the information in proper header c position. c Note: UF-Read and UF-Write refer to groups of subroutine calls to read c and write UF rays. c ------------------------------------------------------------------------------ c UF-Routines: [Returned values in square brackets] c ------------ c ufopen(InputFilename,[InfileUnitNumber]).........ufopen(string,int4) c c ufcreate(OutputFilename,[OutfileUnitNumber]).....ufcreate(string,int4) c c ufclose(FileUnitNumber)..........................ufclose(int4) c c ufreadrayhdr(InUnit#,[Man.Header],[#Fields],[FieldNames],[Status])............ c...................ufreadrayhdr(int4,array_int2,int2,array_string(size_2),int2) c c ufreadrayfld(InUnit#,[FieldHeaderLength],[FieldHeader],[FieldData],[Status]).. c...................ufreadrayfld(int4,int2,array_int2,array_real4,int2) c c ufreadrayend(InUnit#,[Status])...................ufreadrayend(int4,int2) c c ufstartray(MissingDataFlag)......................ufstartray(int2) c c ufbuildrayfld(FieldHeaderLength,FieldHeader,FieldData)........................ c...................ufbuildrayfld(int2,array_int2,array_real4) c c ufwriteray(OutUnit#,RayCount,Man.Header,FieldNames)........................... c...................ufwriteray(int4,int2,array_int2,array_string(size_2)) c -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- c Version 1.3 adds c ufreadstring(HeaderIndex,StringLength,Header,[String])........................ c...................ufreadstring(int4,int4,array_int2,array_string) c ufwritestring(HeaderIndex,StringLength,String,[Header])....................... c...................ufreadstring(int4,int4,array_string,array_int2) c ------------------------------------------------------------------------------ c To read a UF file (UF-Read) c --------------------------- c ufopen c for each ray c ufreadrayhdr c for each data field c ufreadrayfld c ufreadrayend c ufclose c ------------------------------------------------------------------------------ c To write a UF file (UF-Write) c ----------------------------- c ufcreate c for each ray c ufstartray c for each data field c ufbuildrayfld c ufwriteray c ufclose c ------------------------------------------------------------------------------ c Limitations: c UF-Read does not return the optional header and the local use header. c UF-Read assumes one record per ray, so you need to call UF-Read N times to c read a ray that covers N records. Also UF-Read only returns the names of c fields in the data header. (The rest of the data header is mostly the c positions of the data.) For each ray one MUST read all the data fields c (ufreadrayfld). c UF-Write does not write any optional header or local use header. UF-Write c will write one ray to one record. For long ray records this can break the c UF 4095 byte limit (though it is not uncommon to do so). c One can read/write several UF files at once, however one need to read c an entire ray from one UF file before reading part of a ray from another c UF file. The same is true with writing: one must write an entire ray before c writing a ray to another file. (You are able to mix the read and write c subroutine calls though.) c Uses 4 bytes for the start and end tape record blocks. (Some UF files c use 2 bytes.) c ------------------------------------------------------------------------------ c This test program does not make any assumption about the rays. Each c ray could be very different with very different headers. If you do c assume the rays have similar characteristics you can save space by only c saving the few variables that change in the header if you need to save c a sweep or a volume in memory. You should try to figure out if you can c read a ray, process it, and write it out. If you can not you will need c to copy the data (including headers or header parts) into large arrays. c ------------------------------------------------------------------------------ c This program does c ----------------- c ufopen * c ufcreate * c for each ray c ufreadrayhdr * c for each data field c ufreadrayfld * c if a ray we want c if first field c ufstartray * c ufbuildrayfld * c if this field is to be modified c create new field via modification c ufreadrayend * c if a ray we want c for fun - ufreadstring * c adjust headers for new data - ufwritestring * c ufbuildrayfld (the new one) * c ufwriteray * c ufclose * c ufclose * c ------------------------------------------------------------------------------ c Set array size large enough parameter (NVAR=16, NFMAX=48, NGATE=1024) integer*2 mhead(45),fhead(NFMAX),lenfh integer*2 nfields,krec integer*4 iin,iout,ifld real*4 fdata(NGATE) character*2 fname(NVAR) character*80 infile, outfile real*4 fdnew(NGATE) integer*2 fhnew(NFMAX),lenfhn integer*2 sweep, i, istat character*8 generat logical field1, new c Initialize sweep = 2 krec = 0 infile = "MIT_930212_1932.uf" outfile = "MIT_930212_1932_test.uf" c-Open uf file to read call ufopen(infile, iin) c+Open uf file to write call ufcreate(outfile, iout) cccccccccccccccccccccccccccccccccccccccccccccccccccccc c Read UF rays keeping only the ones we want (Sweep 2) cccccccccccccccccccccccccccccccccccccccccccccccccccccc 20 continue krec = krec + 1 c-Read in ray headers call ufreadrayhdr(iin,mhead,nfields,fname,istat) if (istat.ne.1) then print *,istat,"<--Status Sweep-->",mhead(10) print *, 'Error or End of File while reading UF file header' stop endif field1 = .true. new = .false. c-One MUST read all the fields and they will be read in order do 40 ifld = 1,nfields c-Read in a data field header and field data call ufreadrayfld(iin,lenfh,fhead,fdata,istat) if (istat.ne.1) then print *,istat,"<--Status Sweep-->",mhead(10) print *,'Error or End of File while reading UF file field' stop endif c+If it is the sweep we want if (mhead(10).eq.sweep) then c+If it is the first field to build then initialize ray to write routines if (field1) then call ufstartray(mhead(45)) field1 = .false. endif c+Add data and field header to ray build call ufbuildrayfld(lenfh,fhead,fdata) c*If data field is one to make a new field from if (fname(ifld).eq.'DZ'.or.fname(ifld).eq.'DZ') then c*Create new data and field header new = .true. lenfhn = lenfh do 30 i = 1, lenfhn 30 fhnew(i) = fhead(i) do 35 i = 1, fhnew(6) 35 fdnew(i) = fdata(i)*1.1 endif endif 40 continue c-Read in last 4 bytes of the ray call ufreadrayend(iin,istat) if (istat.ne.1) then print *,istat,"<--Status Sweep-->",mhead(10) print *,'Error or End of File while reading UF file ray end' stop endif c+If it is the sweep we want if (mhead(10).eq.sweep) then c for fun let us look at the string we are going to change call ufreadstring(41,8,mhead,generat) c*Change character data in integer*2 mhead generat = "testing " call ufwritestring(41,8,generat,mhead) c old way that works correctly on the Suns but letters are swapped c on Linux Intel machines c mhead(41) = ichar(generat(1:1))*256+ichar(generat(2:2)) c mhead(42) = ichar(generat(3:3))*256+ichar(generat(4:4)) c mhead(43) = ichar(generat(5:5))*256+ichar(generat(6:6)) c mhead(44) = ichar(generat(7:7))*256+ichar(generat(8:8)) c*Adjust headers to account for new data if (new) then fname(nfields+1)="ZC" c+Add new data and new field header to the build call ufbuildrayfld(lenfhn,fhnew,fdnew) endif c+Write out the ray we have prepared with proper headers call ufwriteray(iout,krec,mhead,fname) endif c-Loop back up to read the next ray if (mhead(10).le.sweep) goto 20 c-Done with input uf file so close it call ufclose(iin) c+Done with output uf file so close it call ufclose(iout) c All done stop end