c---- freadpathP-------------------------------------------------------------

      integer function  freadpathP(hdf_file,project,dataset_name,
     &    	        source_name,processing_level,reference_date,
     &   		start_date,stop_date,position_type,grid_type,
     &                  grid_name,projection,latitude,longitude,
     &                  Temporal_Res,Spatial_X_Res,Spatial_Y_Res,
     &                  lat_grid,
     &                  lon_grid,temp,wvapor,sktemp,fcld,clpress,
     &    		cltemp,zangle,emiss,pblstrat,Cg,alpha,
     &		        IIIreject,obs,temp_sd,
     &	         	wvapor_sd,sktemp_sd,fcld_sd,clpress_sd,cltemp_sd,
     &                  zangle_sd,emiss_sd,pblstrat_sd,Cg_sd,alpha_sd)
c-------------------------------------------------------------------------------
c This program provides a fortran interface to the TOVS pathP files in HDF
c format.
c
      implicit none

      integer*4 DFACC_RDONLY,XGRDSZ,YGRDSZ

      parameter(DFACC_RDONLY=1,YGRDSZ=67,XGRDSZ=67)
c input:
      character *(*) hdf_file

c output:

c Meta Data
      character*256   project
      character*256   dataset_name
      character*256   source_name
      character*256   processing_level
      character*256   reference_date
      character*256   start_date
      character*256   stop_date
      character*256   position_type
      character*256   grid_type
      character*256   projection
      character*256   grid_name
      real*4          latitude(4)
      real*4          longitude(4)
      character*256   Temporal_Res
      character*256   Spatial_X_Res
      character*256   Spatial_Y_Res

c scientific data sets

      real*4         lat_grid(XGRDSZ,YGRDSZ)
      real*4         lon_grid(XGRDSZ,YGRDSZ)
      real*4         temp(XGRDSZ,YGRDSZ,9)
      real*4         wvapor(XGRDSZ,YGRDSZ,5)
      real*4         sktemp(XGRDSZ,YGRDSZ)
      real*4         fcld(XGRDSZ,YGRDSZ)
      real*4         clpress(XGRDSZ,YGRDSZ)
      real*4         cltemp(XGRDSZ,YGRDSZ)
      real*4         zangle(XGRDSZ,YGRDSZ)
      real*4         emiss(XGRDSZ,YGRDSZ)
      real*4         pblstrat(XGRDSZ,YGRDSZ)
      real*4         cg(XGRDSZ,YGRDSZ)
      real*4         alpha(XGRDSZ,YGRDSZ)
      real*4         iiireject(XGRDSZ,YGRDSZ)
      real*4         obs(XGRDSZ,YGRDSZ)

      real*4         temp_sd(XGRDSZ,YGRDSZ,9)
      real*4         wvapor_sd(XGRDSZ,YGRDSZ,5)
      real*4         sktemp_sd(XGRDSZ,YGRDSZ)
      real*4         fcld_sd(XGRDSZ,YGRDSZ)
      real*4         clpress_sd(XGRDSZ,YGRDSZ)
      real*4         cltemp_sd(XGRDSZ,YGRDSZ)
      real*4         zangle_sd(XGRDSZ,YGRDSZ)
      real*4         emiss_sd(XGRDSZ,YGRDSZ)
      real*4         pblstrat_sd(XGRDSZ,YGRDSZ)
      real*4         cg_sd(XGRDSZ,YGRDSZ)
      real*4         alpha_sd(XGRDSZ,YGRDSZ)

c HDF function declarations

      integer*4 sfn2index,sfrdata,sfselect,sfginfo,sfstart,sffinfo
      integer*4 ppgetattr_c,ppgetattr_f,sfattr,sfend

c internal variables

      integer*4 hdf_id,ret,ndatasets,nglobal_attr,error

      integer*4 rank,nattrs,number_type,i
      integer*4	ppgetsds


c Memory storage notes:
c  C:
c     buffer [NVARS][YGRDSZ][XGRDSZ]

c  Fortran,IDL:
c    buffer(XGRDSZ,YGRDSZ,NVARS)

c initializations

      error=0

c open SD interface to access file  with name HDF_FILE

      hdf_id =sfstart(HDF_FILE, DFACC_RDONLY)
c You can obtain information about the hdf file through this call

      ret = sffinfo(hdf_id,ndatasets, nglobal_attr)

c read Meta data stored as SD attribtutes

      ret = ppgetattr_c(hdf_id,"PROJECT", project)
      error = error+ret

      ret = ppgetattr_c(hdf_id,"DATASET_NAME", dataset_name)
      error = error+ret

      ret = ppgetattr_c(hdf_id,"SOURCE_NAME", source_name)
      error = error+ret

      ret = ppgetattr_c(hdf_id,"PROCESSING_LEVEL", processing_level)
      error = error+ret

      ret = ppgetattr_c(hdf_id,"REFERENCE_DATE", reference_date)
      error = error+ret

      ret = ppgetattr_c(hdf_id,"START_DATE", start_date)
      error = error+ret

      ret = ppgetattr_c(hdf_id,"STOP_DATE", stop_date)
      error = error+ret

      ret = ppgetattr_c(hdf_id,"POSITION_TYPE", position_type)
      error = error+ret

      ret = ppgetattr_c(hdf_id,"GRID_TYPE", grid_type)
      error = error+ret

      ret = ppgetattr_c(hdf_id,"PROJECTION", projection)
      error = error+ret

      ret = ppgetattr_c(hdf_id,"Temporal_Res", Temporal_Res)
      error = error+ret

      ret = ppgetattr_c(hdf_id,"Spatial_X_Res", Spatial_X_Res)
      error = error+ret

      ret = ppgetattr_c(hdf_id,"Spatial_Y_Res", Spatial_Y_Res)
      error = error+ret

      ret = ppgetattr_f(hdf_id,"LATITUDE", latitude)
      error = error+ret

      ret = ppgetattr_f(hdf_id,"LONGITUDE", longitude)
      error = error+ret

c The below call would allow you to obtain information about a
c specific scientific data set

c	ret    = sfginfo(sds_id,DATASET_NAME, rank, dimsizes,
c     &	               number_type, nattrs)

c
c Latitude and Longitude Grids are external files;
c there is no lat/lon information in the TOVS SDS HDF files
c The files LatGrd.exhdf and LonGrd.exhdf must be in the
c same directory from which this software is run
c
      ret=ppgetsds(hdf_id,"LATITUDE_GRID",lat_grid,1)
      error=error+ret
      ret=ppgetsds(hdf_id,"LONGITUDE_GRID",lon_grid,1)
      error=error+ret
c
      ret=ppgetsds(hdf_id,"TEMP",temp,9)
      error=error+ret
      ret=ppgetsds(hdf_id,"WVAPOR",wvapor,5)
      error=error+ret
      ret=ppgetsds(hdf_id,"SKTEMP",sktemp,1)
      error=error+ret
      ret=ppgetsds(hdf_id,"FCLD",fcld,1)
      error=error+ret
      ret=ppgetsds(hdf_id,"CLPRESS",clpress,1)
      error=error+ret
      ret=ppgetsds(hdf_id,"CLTEMP",cltemp,1)
      error=error+ret
      ret=ppgetsds(hdf_id,"ZANGLE",zangle,1)
      error=error+ret
      ret=ppgetsds(hdf_id,"EMISS",emiss,1)
      error=error+ret
      ret=ppgetsds(hdf_id,"PBLSTRAT",pblstrat,1)
      error=error+ret
      ret=ppgetsds(hdf_id,"Cg",cg,1)
      error=error+ret
      ret=ppgetsds(hdf_id,"ALPHA",alpha,1)
      error=error+ret
      ret=ppgetsds(hdf_id,"IIIreject",iiireject,1)
      error=error+ret
      ret=ppgetsds(hdf_id,"OBS",obs,1)
      error=error+ret
      ret=ppgetsds(hdf_id,"TEMP-SD",temp_sd,9)
      error=error+ret
      ret=ppgetsds(hdf_id,"WVAPOR-SD",wvapor_sd,5)
      error=error+ret
      ret=ppgetsds(hdf_id,"SKTEMP-SD",sktemp_sd,1)
      error=error+ret
      ret=ppgetsds(hdf_id,"FCLD-SD",fcld_sd,1)
      error=error+ret
      ret=ppgetsds(hdf_id,"CLPRESS-SD",clpress_sd,1)
      error=error+ret
      ret=ppgetsds(hdf_id,"CLTEMP-SD",cltemp_sd,1)
      error=error+ret
      ret=ppgetsds(hdf_id,"ZANGLE-SD",zangle_sd,1)
      error=error+ret
      ret=ppgetsds(hdf_id,"EMISS-SD",emiss_sd,1)
      error=error+ret
      ret=ppgetsds(hdf_id,"PBLSTRAT-SD",pblstrat_sd,1)
      error=error+ret
      ret=ppgetsds(hdf_id,"Cg-SD",cg_sd,1)
      error=error+ret
      ret=ppgetsds(hdf_id,"ALPHA-SD",alpha_sd,1)
      error=error+ret
      if (error.lt.0) then
	write(0,*) 'Error reading file : ', hdf_file
      endif
      ret=sfend(hdf_id)
      return
      end

      integer function ppgetsds(hdf_id, sdsname,sds,nz)
c-------------------------------------------------------------------------------
c This function obtains a single scientific data set in file pointed to by
c hdf_id. The name of the scientific data sets is given in sdsname
c
c Input:
c      integer*4  hdf_id    HDF file ID as returned by sfstart
c      character *(*)       name of Scientific Data set
c      real*4    sds(MAXSIZE)
c                           This buffer must be large enough to
c                           hold the entire data set
c      integer*4  nz        number of elements in z dimension

      implicit none

      integer*4  	     MAXSIZE
      parameter(MAXSIZE=67*67*9)

      integer*4  	     hdf_id,nz,i
      character*(*)	     sdsname
      real*4                 sds(MAXSIZE)

c internal variabels

      integer*4              index,sds_id,ret
      integer*4	START(3),STRIDE(3),EDGE(3)

c hdf function declarations

      integer*4 sfn2index,sfrdata,sfselect,sfendacc

c WARNING: STRIDE is set to 1,1,1 due to a bug in HDF3.3r3 the correct
c     values should be 0,0,0. Future versions of HDF may have this fixed

      data (START(i),i=1,3)  /0,0,0/
      data (STRIDE(i),i=1,3) /1,1,1/
      data (EDGE(i),i=1,3)   /67,67,0/

      EDGE(3)= nz

c get index of data set in HDF file
      print*,'sdsname :',sdsname

      index = sfn2index(hdf_id,sdsname)

c select data data set

      sds_id = sfselect(hdf_id, index)

      ppgetsds    = sfrdata(sds_id, START, STRIDE, EDGE,sds)
      ret = sfendacc(sds_id)
      call     heprnt(0)
      return
      end

      integer function ppgetattr_c(hdf_id,attribute_name,attribute)
C-----------------------------------------------------------------------
c This function obtains a single global character attributes from the
c PATH P hdf file which is pointed to by hdf_id
c
c input:
c         integer*4       hdf_id           id returned from sfstart
c         character*(*)   attribute_name   Metadata attribute to return
c         character*(*)   attribute        value  of attribute
c returns:
c         0 : success
c         -1: error
c-----------------------------------------------------------------------
      implicit none

c interface

      integer*4	hdf_id
      character*(*)   attribute_name,attribute
c FIX for SOLARIS 
      character*64    attr_name

c HDF functions
      integer*4 sfrattr,sffattr,sfgainfo

c internal variables

      integer*4     index,number_type,length,ret

c      print*,'attribute_name :',attribute_name

      index=sffattr(hdf_id,attribute_name)

c      print*,'Index:',index

      ret = sfgainfo(hdf_id,index,attr_name, number_type,
     &	             length)

      ppgetattr_c=sfrattr(hdf_id,index,attribute(1:length))

c
c print attribute value to standard output
c
	print *,attribute(1:length)

      return
      end


      integer function ppgetattr_f(hdf_id,attribute_name,attribute)
C-----------------------------------------------------------------------
c This function obtains a 4 element floating point  attribute from the
c PATH P hdf file which is pointed to by hdf_id
c
c input:
c         integer*4       hdf_id           id returned from sfstart
c         character*(*)   attribute_name   Metadata attribute to return
c         real*4          attribute(4)     value  of attribute
c returns:
c         0 : success
c         -1: error
c-----------------------------------------------------------------------
      implicit none

c interface

      integer*4	hdf_id
      character*(*)   attribute_name
      real*4          attribute

c HDF functions

      integer*4 sfrattr,sffattr

c internal variables

      integer*4     index

      index=sffattr(hdf_id,attribute_name)
      ppgetattr_f=sfrattr(hdf_id,index,attribute)

      return
      end











