program rdsrbhdf C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C name - rdsrbhdf type - program C version - 1.0 date - 11/2/92 programmer - R. DiPasquale,Lockheed C J. Travers, SAIC C C Purpose - This program reads the SRB DAILY and MONTHLY HDF files C C Input - HDF file named srb_monavgs_yymm or srb_dayavgs_yymm C Output - Report file named srb_monagv_yymm.rpt or srb_dayavgs_yymm.rpt C C Key Local Parameters - maxrank - max rank of HDF SDS C ddate - data date yymm C hdfname - name of HDF file C type - whether daily or monthly SRB files C areatyp - type of geographical subsetting C begin1 - beginning cell number C end1 - ending cell number C dataitems - data items to be read C C Subroutines Called - getinput - gets data date and file type C getfile - gets file names and opens output file C readhdf - reads file id and description, etc. C getarea - gets area to subset C getdata - gets parameters to subset C readdata - reads data, max, mins, etc C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C integer maxrank,listsize parameter (maxrank=2,listsize=52) integer dataitems(listsize) character ddate*4, type*1, hdfname*36, areatyp*1 real begin1, end1 call getinput(ddate,type) call getfile(ddate,type,hdfname) call readhdf(hdfname) call getarea(areatyp,begin1,end1) call getdata(hdfname,dataitems) call readdata(hdfname,dataitems,areatyp,begin1,end1) end subroutine getinput(ddate,type) C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C name - getinput type - subroutine C version - 1.0 date - 11/2/92 programmer - J. Travers, SAIC C C Purpose - This subroutine accepts user input for data date and type C of SRB data to read C C Input parameters - none C Output parameters - ddate - the data date (yymm) C type - type of data to read (D-daily, M-monthly) C C Key Local Parameters - NONE C Subroutines Called - NONE CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C character ddate*4, type*1, contkey write(6,*) 'This program reads the SRB Daily or Monthly HDF' write(6,*) 'formatted data. The file name is built according to' write(6,*) 'naming conventions formed at the Langley DAAC. If' write(6,*) 'you have changed the name of the file or need to' write(6,*) 'specify a path, you will need to modify this program.' write(6,*) 'Please enter Q to Quit or return to continue' read(5,'(a)') contkey if (contkey.eq.'Q' .or. contkey.eq.'q') then write(6,*) 'Exiting program ...' stop else write(6,*) write(6,10) 10 format('Enter data date of SRB data to read (yymm) ',$) read(5,'(a4)') ddate write(6,15) 15 format('Enter type of SRB data to read (D-Daily,M-Monthly) ',$) read(5,'(a1)') type endif return end subroutine getfile(ddate,type,hdfname) C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C name - getfile type - subroutine C version - 1.0 date - 11/2/92 programmer - J. Travers,SAIC C C Purpose - This subroutine gets the files names and opens the C output file C C Input parameters - ddate - the data date C type - whether daily or monthly SRB data C C Output parameters - hdfname - name of HDF file C C Key local parameters - outfile - name of output file C typename - day or mon CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC character ddate*4, type*1, hdfname*36, outfile*50, typename*7 if (type.eq.'D' .or. type.eq.'d') then typename = 'dayavgs' else typename = 'monavgs' endif hdfname = 'srb_' // typename // '_' // ddate outfile = 'srb_' // typename // '_' // ddate // '.rpt' open(20,file=outfile,form='formatted') write(6,*) write(6,*) 'Input file is ',hdfname write(6,*) 'Output file is ',outfile return end subroutine readhdf(hdfname) C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C name - readhdf type - subroutine C version - 1.0 date - 11/06/92 programmer - J. Travers C C Purpose - This subroutine reads the file id and file description C C Input - hdfname - the name of the HDF input file C C Key Local Parameters : iret - return code from HDF routines C dfile - pointer to HDF file C id - file id C filedesc - file description C C Functions Called : HDF functions to get file id, file description, C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C integer maxrank, DFACC_read, first,maxlabel parameter (maxrank=2, DFACC_read=1, first=1,maxlabel=255) integer Hopen,dagfidl,dagfid,dfile,Hclose character hdfname*36, id*255 dfile = Hopen(hdfname,DFACC_read,0) if (dfile.eq.0) then print*, 'Error opening HDF file' stop endif C *** get file id *** iret = dagfidl(dfile,first) iret = dagfid(dfile,id,maxlabel,first) if (iret.eq.-1) then write(20,*) 'Error on getting file id' write(20,*) stop else write(20,*) 'File ID: ',id write(20,*) endif iret = Hclose(dfile) return end subroutine getarea(areatyp,begin1,end1) C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C Name - getarea type - subroutine C Version - 1.0 Date -11/06/92 Programmer - J. Travers,SAIC C C Purpose - This functions asks the user to enter the cell C numbers to subset data C C Input Parameters - NONE C Output Parameters -areatyp - enter cell number(C) or none C begin1-beginning cell number C end1 - ending cell number C C Key Local Parameters -NONE C C Functions Called - NONE CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC character areatyp*1 real begin1,end1 print *, ' ' print *, 'Enter whether you would like to further subset based' write(*,55) 'cell number (C) or no subsetting (N) ' 55 format(A,$) read (*,'(a1)') areatyp print *, ' ' if (areatyp.ne.'N' .and. areatyp.ne.'n') then if (areatyp.eq.'C'.or.areatyp.eq.'c') then write(*,57) write(*,58) 57 format('Enter beginning and ending cell number (1-6592) ',$) 58 format('separated by a space ',$) read (*,*) begin1,end1 endif else begin1 = 0.0 end1 = 0.0 endif return end subroutine getdata(hdfname,dataitems) CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C Name - getdata Type - Subroutine C Version - 1.0 Date - 11/06/92 Programmer - J. Travers,SAIC C C Purpose - This subroutine allows the user to choose from the annotation C labels, which data parameters to dump C C Input - hdfname - the number of HDF file C Output - dataitems - list of reference numbers of data to dump C C Key Local Parameters - nlabels - number of reference labels C i,j,k - counters C itemnum - number for user to choose C startpos - starting position in HDF file C reflist - list of reference numbers C labellist - list of annotation labels C C Functions called - annotation label routines from HDF CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C integer listsize,startpos,maxlng,DFTAG_NDG parameter (listsize=52,startpos=1,maxlng=21,DFTAG_NDG=720) character hdfname*36, labellist*21 integer dataitems(listsize), reflist(listsize) integer dallist,nlabels,i,j,k,itemnum dimension labellist(listsize) C *** initialize dataitems array *** do 40, i=1,listsize dataitems(i) = 65535 40 continue C *** get annotation labels *** nlabels = dallist(hdfname,DFTAG_NDG,reflist,labellist, 1 listsize,maxlng,startpos) if (nlabels.eq.-1) then write(20,*) 'Error in getting annotation labels' write(20,*) stop endif print *, ' ' j=1 k=1 do 50, i=1,nlabels if (j.eq.1) then itemnum = 1 print *, ' Item Number Label' print *,' ' endif write(*,41) i,labellist(i) 41 format(15x,i2,15x,a21) j = j+1 if (j.gt.26 .or. j.gt.nlabels) then print *, 'Please choose the numbers of the data items' print *, 'you wish to dump, one per line. Enter -1 to' print *, 'continue to next list or 0 to quit choosing items' print *, ' ' do while (itemnum.ne.-1 .and. itemnum.ne.0) read(*,*) itemnum if (itemnum.eq.-1) go to 45 if (itemnum.eq.0) then dataitems(k) = 0 return else dataitems(k) = reflist(itemnum) k = k+1 endif 45 end do j = 1 endif 50 continue dataitems(k) = 0 return end subroutine readdata(hdfname,dataitems,areatyp,begin1,end1) C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C Name - readdata type - C Version - 1.0 Date-11/06/92 Programmer- J. Travers,SAIC C C Purpose - This function determines the data slice to retrieve and using C the reference numbers gets the appropriate data, data C attributes, max, and min and then prints the data. C C Input Parameters - hdfname - name of hdf file to read C dataitems- stores reference numbers of data chosen C areatyp-type of subsetting (cell # or none) C begin1- beginning cell number C end1- ending cell number C C Output Parameters - none C C Key Local Parameters - winst - stores starting dimensions of data slice C windims- stores length of slice C dims - stores dimension of data array C data - stores data gotten from HDF file C datalabel - stores label for data C dataunit- stores units for data C datafmt - stores format for data C max,imax - stores maximum value C min,imin - stores minimum value C dataval,idataval - stores data values C numdims - number of dimensions of SDS C dimsize - dimension sizes C listsize - the max number of parameters C numtype - HDF number type, 5 floating, 24 - C 32 bit integer C C Subroutines Called - HDF routines to read the SDS data slice, max,min C data attributes, etc. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C integer listsize,maxrank integer dsgdims,dsgnt,dsgdast,dsgrang,dsgslc parameter (listsize=52,maxrank=2) integer dataitems(listsize),numdims,dimsize(maxrank),numtype integer idataval(204476), imax,imin,winst(maxrank) integer windims(maxrank),dims(maxrank),winend(maxrank) real begin1,end1,dataval(204476),max,min character dataunt*25, datafmt*10, missingval*25,hdfname*36 character areatyp*1,datalabel*260 C *** subset by cell numbers *** if (areatyp.eq.'C' .or. areatyp.eq.'c') then winst(1) = 1 winst(2) = int(begin1) winend(1) = 1 winend(2) = int(end1) windims(1) = 1 windims(2) = int(end1-begin1+1) dims(1) = windims(1) dims(2) = windims(2) else winst(1) = 1 winst(2) = 1 winend(1)=1 winend(2) = 6596 windims(1) = 1 windims(2) = 6596 dims(1) = windims(1) dims(2) = windims(2) endif C *** get data slice, max, min, etc *** write(6,*) write(6,*) 'Getting data, Please wait ...' k=1 do while(dataitems(k).ne.0) iret = dsrref(hdfname,dataitems(k)) if (iret.eq.-1) then write(20,*) 'Error on going to specified reference ', 1 'number -',dataitems(k) write(20,*) stop endif C *** get dimensions *** iret = dsgdims(hdfname,numdims,dimsize,maxrank) if (iret.ne.0) then write(20,*) 'Error on getting dimensions' write(20,*) stop else write(20,*) 'Dimensions are', dimsize(1), ' by', dimsize(2) write(20,*) endif C *** get dimension one is not 1 then set windims(1) and dims(1) to dimsize(1) *** if (dimsize(1).ne.1) then windims(1) = dimsize(1) dims(1) = windims(1) endif C *** get number type *** iret = dsgnt(numtype) if (iret.ne.0) then write(20,*) 'Error on getting number type' write(20,*) stop endif C *** get data attributes *** iret = dsgdast(datalabel,dataunt,datafmt,missingval) if (iret.ne.0) then write(20,*) 'Error on getting data attributes' write(20,*) stop else write(20,*) 'Data attributes are as follows:' write(20,*) write(20,*) 'Label : ' write(20,*) datalabel(1:80) write(20,*) datalabel(81:160) write(20,*) datalabel(161:240) write(20,*) datalabel(241:260) write(20,*) 'Units : ',dataunt write(20,*) 'Format : ',datafmt write(20,*) 'Missingvalue: ',missingval write(20,*) endif C *** get max and mins and data values *** if (numtype.eq.5) then iret = dsgrang(max,min) if (iret.eq.-1) then write(20,*) 'Error on getting max and min' write(20,*) stop else write(20,*) 'Data max: ', max write(20,*) 'Data min: ', min write(20,*) endif C *** get data slice *** iret = dsgslc(hdfname,winst,windims,dataval,dims) if (iret.eq.-1) then write(20,*) 'Error on getting data slice' write(20,*) stop else C *** print out data *** write(20,100) 'Data values for cells',winst(2),' to' write(20,*) winend(2),' are as follows:' write(20,*) if (dimsize(1).ne.1) then iendvl1= dims(2) iendvl2 = dims(1) else iendvl1= dims(1) iendvl2 =dims(2) endif do 65, j=1,iendvl1 do 60, i=1,iendvl2 index = (j-1)*iendvl2+i write(20,52) dataval(index) 52 format(f12.4,$) if ((mod(i,6)).eq.0) then write(20,*) endif 60 continue write(20,*) write(20,*) 65 continue endif else if (numtype.eq.24) then C ** get max and min *** iret = dsgrang(imax,imin) if (iret.eq.-1) then write(20,*) 'Error on getting max and min' write(20,*) stop else write(20,*) 'Data max: ', imax write(20,*) 'Data min: ', imin write(20,*) endif C *** get data slice *** iret = dsgslc(hdfname,winst,windims,idataval,dims) if (iret.eq.-1) then write(20,*) 'Error on getting data slice' write(20,*) stop else C *** print out data *** write(20,100) 'Data values for cells',winst(2),' to' write(20,*) winend(2),' are as follows:' write(20,*) if (dimsize(1).ne.1) then iendvl1= dims(2) iendvl2 = dims(1) else iendvl1= dims(1) iendvl2 =dims(2) endif do 75, j=1,iendvl1 do 70, i=1,iendvl2 index = (j-1)*iendvl2+i write(20,67) idataval(index) 67 format(i7,$) if ((mod(i,11)).eq.0) then write(20,*) endif 70 continue write(20,*) write(20,*) 75 continue endif else write(20,*) 'Invalid data type cannot get data' stop endif write(20,*) write(20,*) k = k + 1 end do 100 format(a,i5,a,$) return end