c**************************************************************** c Name : hdfread c Purpose : a simple program to demonstrate how to read c an MAS HDF file containing c SDS's and Global Attributes c using HDF function calls. c Programmer : Paul Hubanks, Research and Data Systems, Corp. c Date : 19 May 1994 c Version : 3.0 c**************************************************************** c --- include the HDF FORTRAN parameters include 'mas_constant.i' real*4 rad integer*4 ipix,irec,ichan character name*72 c --- HDF integer functions (must be declared) integer*4 sfstart, sffinfo , sfend integer*4 sfn2index, sfselect, sfginfo integer*4 sfgainfo , sfrattr , sfrdata c --- HDF variables integer*4 status , fid , ndsets , ngattrs integer*4 index, sds_id , rank , dimsizes(5) integer*4 number_type , nattrs integer*4 count integer*4 level character*50 sds_name character*50 attr_name character*1 cont c --- set up arrays to hold data read from HDF file character*1 cdata(1000) integer*4 idata(10000) real*4 rdata(10000) character*1 cbuff(1) integer*2 i2buff(1) integer*4 i4buff(1) real*4 rbuff(1) c --- set up input arrays for "sfrdata" (hyperslab data read) integer*4 start(3) integer*4 stride(3) integer*4 edge(3) c --- Initialize start,stride edge arrays for hyperslab data read c --- This will handle SDS"S of single, double, or triple dimensions c --- This will read the 1st element of each dimension c --- start is the multi-dim index of the starting corner of the slab c --- stride is the number of values to skip when reading a dimension c --- edge is the number of values to read along a given dimension c **************************************************************** c --- WARNING WARNING WARNING WARNING WARNING WARNING WARNING --- c **************************************************************** write(6,*)' WARNING: This version fixes a bug in HDF3.3r3' c --- HDF 3.3r3 has a bug in the fortran version routine sfrdata() c --- THis is the way stride should work c --- stride should be set to 0 for contiguous data read c --- stride=1 would skip 1 data point c --- stride=2 would skip 2 data points c c --- This is how stride in HDF3.3r3 works (with the bug) c --- the bug will not allow stride to be set to 0 c --- stride=1 for contiguous data read c --- stride=2 skips 2 data points c --- there is no way to skip 1 data point with the bug c **************************************************************** do 11 m=1,3 c --- start is the multi-dim index of the starting corner of the slab c --- note start=1 actually reads the 2nd variable in the array c --- indexing starts at 0 start(m)=1 c --- stride is the number of values to skip when reading a dimension c --- set to 1 to bypass bug in HDF3.3r3 stride(m)=1 c --- edge is the number of values to read along a given dimension edge(m)=1 11 continue c --- Note HDF function calls will return c --- status = 0 for success c --- status = -1 for failure c --- Get the HDF file name write(*,' ( '' Enter HDF file name : '' $ ) ' ) read(*,'(a72)') name write(6,*)'name=',name c --- Initialize the file and return fid (interface file handle) c --- Open file as read-only fid = sfstart ( name , DFACC_RDONLY ) write(6,*)' HDF file id = ',fid c --- Return the number of data sets and global attributes status = sffinfo ( fid , ndsets , ngattrs ) c --- Write out number of data sets and global attributes write(6,*)' ' write(6,*)' # of Global Attributes = ',ngattrs write(6,*)' # of Scientific Data Sets (SDS"s) = ',ndsets write(6,*)' ' write(6,*) ' Read Global Attributes ? ( or n ) : ' read(5,1002) cont if(cont.eq.'n'.or.cont.eq.'N') go to 15 c --- Loop through all the global attributes --- c --- jindex is the position of the SDS in the file do 2 jindex = 0 , ngattrs-1 status = sfgainfo ( fid, jindex , attr_name , & number_type , count ) write(6,1005) attr_name , jindex , number_type , count 1005 format(' ******** GLOBAL ATTRIBUTE ********* ',/, & ' Attribute_Name = ',a50,/, & ' Attribute Index = ',i3,/, & ' Number_Type = ',i9, & ' Count = ',i10,/) c --- read attribute depending on number_type if(number_type.eq.4)status=sfrattr(fid,jindex,cdata) if(number_type.eq.4)write(6,2000) (cdata(k),k=1,count) 2000 format(' - - - Attribute Value - - - ',13(/,1x,75a1)) if(number_type.eq.24)status=sfrattr(fid,jindex,idata) if(number_type.eq.24)write(6,2001) (idata(k),k=1,count) 2001 format(' - - - Attribute Value - - - ',13(/,1x,15i5)) if(number_type.eq.5)status=sfrattr(fid,jindex,rdata) if(number_type.eq.5)write(6,2002) (rdata(k),k=1,count) 2002 format(' - - - Attribute Value - - - ',13(/,1x,5f15.5)) write(6,*)' ********************************** ' write(6,1001) 1001 format(/,' Continue ? ( or n ) : ') read(5,1002) cont 1002 format(a1) if(cont.eq.'n'.or.cont.eq.'N') go to 15 2 continue 15 continue write(6,*) ' ' write(6,*) ' Read Scientific Data Set"s (SDS"s) ? ( or n) : ' read(5,1002) cont if(cont.eq.'n'.or.cont.eq.'N') go to 20 c --- Loop through all SDS's to c --- get the name, rank, dimension sizes, number type, and c --- attribute count for each c --- Index is the position of the SDS in the file do 10 index = 0 , ndsets-1 c --- initialize dimsizes array do 5 i=1,5 5 dimsizes(i)=0 c --- Get the sds_id for a specific SDS (variable) sds_id = sfselect ( fid , index ) c --- Get information about an SDS (variable) status = sfginfo ( sds_id , sds_name , rank , dimsizes , & number_type , nattrs ) write(6,1000) sds_name , index , sds_id , rank, & dimsizes , number_type , nattrs 1000 format(' ************* Scientific Data Set **************',/, & ' SDS_Name = ',a50,/, & ' Index = ',i3,' SDS_ID = ',i10,/, & ' # of Dims = ',i2,' DimSizes = ',5i6,/, & ' Number_Type = ',i4, & ' Number of Attributes = ',i2,/) if(rank.ge.4)write(6,*)'Need to modify pgm to handle 4+ dims' c --- Read SDS data depending on rank and data type if(rank.eq.1) then if(number_type.eq.4) & status = sfrdata(sds_id,start,stride,edge,cbuff) if(number_type.eq.4)write(6,4000) cbuff(1) 4000 format(' - - - Sample Data Value - - - ',/,1x,a1) if(number_type.eq.22) & status = sfrdata(sds_id,start,stride,edge,i2buff) if(number_type.eq.22)write(6,4001) i2buff(1) if(number_type.eq.24) & status = sfrdata(sds_id,start,stride,edge,i4buff) if(number_type.eq.24)write(6,4001) i4buff(1) 4001 format(' - - - Sample Data Value - - - ',/,1x,i20) if(number_type.eq.5) & status = sfrdata(sds_id,start,stride,edge,rbuff) if(number_type.eq.5)write(6,4002) rbuff(1) 4002 format(' - - - Sample Data Value - - - ',/,1x,f20.9) endif if(rank.eq.2) then if(number_type.eq.4) & status = sfrdata(sds_id,start,stride,edge,cbuff) if(number_type.eq.4)write(6,4000) cbuff(1) if(number_type.eq.22) & status = sfrdata(sds_id,start,stride,edge,i2buff) if(number_type.eq.22)write(6,4001) i2buff(1) if(number_type.eq.24) & status = sfrdata(sds_id,start,stride,edge,i4buff) if(number_type.eq.24)write(6,4001) i4buff(1) if(number_type.eq.5) & status = sfrdata(sds_id,start,stride,edge,rbuff) if(number_type.eq.5)write(6,4002) rbuff(1) endif if(rank.eq.3) then if(number_type.eq.4) & status = sfrdata(sds_id,start,stride,edge,cbuff) if(number_type.eq.4)write(6,4000) cbuff(1) if(number_type.eq.22) & status = sfrdata(sds_id,start,stride,edge,i2buff) if(number_type.eq.22)write(6,4001) i2buff(1) if(number_type.eq.24) & status = sfrdata(sds_id,start,stride,edge,i4buff) if(number_type.eq.24)write(6,4001) i4buff(1) if(number_type.eq.5) & status = sfrdata(sds_id,start,stride,edge,rbuff) if(number_type.eq.5)write(6,4002) rbuff(1) endif write(6,*)' - - - - - - - - - - - - - - - ' write(6,*)' ' 45 if(nattrs.eq.0) go to 7 c --- Read SDS attributes (if any) write(6,*) ' Read SDS attribute string ? ( or n ) : ' read(5,1002) cont if(cont.eq.'n'.or.cont.eq.'N') go to 7 c --- Loop through SDS attributes do 6 jindex = 0 , nattrs-1 status = sfgainfo ( sds_id, jindex , attr_name , & number_type , count ) write(6,1015) attr_name , jindex , number_type , count 1015 format(' -------- Local Attribute ----------- ',/, & ' Attribute_Name = ',a50,/, & ' Attribute Index = ',i3,/, & ' Number_Type = ',i9, & ' Count = ',i10) c --- Read SDS attribute depending on type if(number_type.eq.4)status=sfrattr(sds_id,jindex,cdata) if(number_type.eq.4)write(6,2000) (cdata(k),k=1,count) if(number_type.eq.24)status=sfrattr(sds_id,jindex,idata) if(number_type.eq.24)write(6,2001) (idata(k),k=1,count) if(number_type.eq.5)status=sfrattr(sds_id,jindex,rdata) if(number_type.eq.5)write(6,2002) (rdata(k),k=1,count) write(6,3001) 3001 format('--------------------------------------') 6 continue 7 write(6,*)' ************************************************ ' write(6,1001) read(5,1002) cont if(cont.eq.'n'.or.cont.eq.'N') go to 20 10 continue 20 continue write(6,*) ' ' write(6,*) ' Dump Descaled Calibrated Radiances ? ( or n) : ' read(5,1002) cont if(cont.eq.'n'.or.cont.eq.'N') go to 90 c ******************************************************* c *** This part is relevent only to MAS SLFT granules *** c ******************************************************* c --- Look up an index for a given SDS c --- then pass this to sfselect to return an id for the c --- data set (sds_id) index = sfn2index ( fid , 'CalibratedData' ) c --------------------------------------------------------- c --- initialize dimsizes array do 51 i=1,5 51 dimsizes(i)=0 c --- Get the sds_id for a specific SDS (variable) sds_id = sfselect ( fid , index ) c --- Get information about an SDS (variable) status = sfginfo ( sds_id , sds_name , rank , dimsizes , & number_type , nattrs ) write(6,1000) sds_name , index , sds_id , rank, & dimsizes , number_type , nattrs c --- Read SDS attributes c --- Loop through SDS attributes do 61 jindex = 0 , nattrs-1 status = sfgainfo ( sds_id, jindex , attr_name , & number_type , count ) write(6,1015) attr_name , jindex , number_type , count c --- Read SDS attribute depending on type if(number_type.eq.4)status=sfrattr(sds_id,jindex,cdata) if(number_type.eq.4)write(6,2000) (cdata(k),k=1,count) if(number_type.eq.24)status=sfrattr(sds_id,jindex,idata) if(number_type.eq.24)write(6,2001) (idata(k),k=1,count) if(number_type.eq.5)status=sfrattr(sds_id,jindex,rdata) if(number_type.eq.5)write(6,2002) (rdata(k),k=1,count) 61 continue write(6,*)' ' 800 write(6,*)' Enter Pixel(1-716), Record(1-',dimsizes(3),'),', & ' Channel(1-12) ? ' read(*,*) ipix, irec, ichan c --- note indexing starts at 0 c --- Adjust index's to reflect start(1) = ipix - 1 start(2) = ichan - 1 start(3) = irec - 1 c --- Read i*2 rank=3 data status = sfrdata(sds_id,start,stride,edge,i2buff) c --- status ne 0 means error in reading data if(status.ne.0) then level=1 c --- print error msgs in stack (if any) call heprnt(level) write(6,*)' Input values out of range' go to 2222 endif rad = real(i2buff(1)) * rdata(ichan) write(6,4005) ipix, irec, ichan, i2buff(1), & rdata(ichan), rad 4005 format(1x,' At Pixel = ',i5,' Record = ',i5,/, & 1x,' For Channel = ',i2,/, & 1x,' Stored Value = ',i5,' Scale Factor = ',f7.3,/, & 1x,' Calibrated Radiance = ',f20.10) 2222 write(6,4007) 4007 format(/,' Another ? ( or n ) : ') read(5,1002) cont if(cont.eq.'n'.or.cont.eq.'N') go to 90 go to 800 c ********************************************************* c *** End the part - relevent only to MAS SLFT granules *** c ********************************************************* 90 continue c --- Close the file and clean up memory status = sfend ( fid ) stop end