

C     SAMPLE CODE TO READ 1 YEAR OF OLR DATA IN FORTRAN 
C     DATA IS RETURNED IN A GRID N-S
C     ALSO, THE DATE IS RETURNED AS IYEAR,IMONTH,IDAY
C
C     COMPILE WITH -lnetcdf -ludunits
C     YOU MUST HAVE THE NETCDF LIBRARY and THE UDUNITS
C     LIBRARY INSTALLED!!!!!!!!!!!
C
C	  netCDF can be found at
C	  http://www.unidata.ucar.edu/packages/netcdf/index.html
C
C	  UDUNITS can be found at
C	  http://www.unidata.ucar.edu/packages/udunits/index.html
C
C     also you may need to change line 44 for location of udunits.dat!!!!
C     YOUR INCLUDE FILES MAY DIFFER IN LOCATION
      
      include '/usr/local/include/udunits.inc'
      include '/usr/local/include/netcdf.inc'
      parameter (ntime=365)
      parameter ( jlat=73)
      parameter (ilon=144)

      integer*2 data(144,73)
      real*4 olr(144,73)
      integer count(3),start(3)
      integer icount2(1),istart2(1)
      integer*2 miss

C     UDUNITS STUFF TO UNPACK TIME:
C     TIME IS A DOUBLE, HOURS SINCE 1-1-1

      integer*4 year,iminute,retcode,timeid,second,retcode
      integer*4 unitptr
      character*1024 unitstrin
      character*1024 unitstr

      inet=ncopn('/Datasets/interp_OLR/olr.day.mean.nc',ncnowrit,i)
      ivar=ncvid(inet,'olr',icode)
      itimeid=NCVID(inet,'time',icode)

C     UDUNITS STUFF TO UNPACK TIME:
C     You may need to change the location of this file!!!
      retcode=utopen('/usr/local/src/udunits/etc/udunits.dat')
      unitptr=utmake()
      call ncainq(inet,itimeid,'units',iNCCHAR,mlen,i)
      call ncagtc(inet,itimeid,'units',unitstrin,mlen,icode)
      unitstr=unitstrin(1:iblank(unitstrin))
      retcode=utdec(unitstr,unitptr)
      retcode=uttime(unitptr)

C     SLAB INFO FOR OLR ARRAY

      start(1)=1
      start(2)=1
      start(3)=1

      count(1)=ilon
      count(2)=jlat
      count(3)=1

C     GET SCALE FACTOR AND MISSING VALUE

      call ncagt(inet,ivar,'scale_factor',xscale,icode)
      call ncagt(inet,ivar,'add_offset',xoff,icode)
      call ncagt(inet,ivar,'missing_value',miss,icode)

C     LOOP THROUGH 1 YEAR OF DATA, UNPACK ARRAY, UNPACK TIME
C     AND READ HEADER

      do it=1,ntime
         start(3)=it
         call ncvgt(inet,ivar,start,count,data,icode)
         call unpack(data,olr,xscale,xoff,miss)
         call ncvgt(inet,itimeid,it,1,xtime,icode)
         istart2(1)=it
         icount2(1)=1
         call ncvgt(inet,itimeid,istart2,icount2,xtime,iercode)
         call udparse(unitstrin,xtime,iyear,imonth,iday,ihour)
         print*,it,olr(30,30),iyear,imonth,iday,ihour         
      enddo
         
      stop
      end

      subroutine unpack(x,y,xscale,xadd,miss)
      parameter (nlon=144)
      parameter (nlat=73)
      parameter (zmiss=1e30)
      
      integer*2 x(nlon,nlat),miss
      real y(nlon,nlat)
      
      do i=1,nlon
         do j=1,nlat
            if(x(i,j).eq.miss)then
               y(i,j)=zmiss
            else
              y(i,j)=(x(i,j)*xscale)+xadd
           endif
         enddo
      enddo      
      
      return
      end      
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C     This subroutine is part of the netopen Fortran callable CDC
C     group of routines for reading generic netCDF files in the new
C     cooperative standard as presented in:
C	http://ferret.wrc.noaa.gov/noaa_coop/coop_cdf_profile.html
C
C     This routine takes a time value pulled from the netCDF file,
C     determines if it is in the new or old time format (by using the 
C     udunits function) and then returns the representative year, 
C     month, day and hour represented by the time value.
C
C     Written by Cathy Smith of CDC on ???
C     Modified by Tom Baltzer of CDC on Feb. 8, 1995
C	- To determine if time is old or new format and parse 
C		accordingly
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      subroutine udparse(timeunit,intime,oyear,omonth,oday,ohour)

      include '/usr/local/include/udunits.inc'

C     declare function calls for odd compilers
      integer UTMAKE,UTDEC,UTCALTIME
C     Note: POINTER type is integer*4 on the CDC SparcCenter 2000
C     system running SunOS 5.3
      integer*4 unitptr ! Pointer to udunits "unit" type

      character*100 timeunit
			! The unit attribute for time in the netCDF file
      real*8 intime,xx	! The input time value and var to work with it
      integer oyear,omonth,oday,ohour
			! The output year,month,day and hour
      integer tmin	! Temporary storage for minutes value
      real    tsec	! Temporary storage for seconds value
      integer ercode    ! For determining udunits result
      
      unitptr = UTMAKE()
      ercode = UTDEC(timeunit(1:iblank(timeunit)),unitptr)
      if (ercode.ne.0) then

C        Assume old CDC standard if time unit is unknown

         if (ercode.eq.UT_EUNKNOWN.and.(timeunit(1:1).eq.'y'.or.
     &	     	timeunit(1:1).eq.'Y')) then  
            xx=0.
            oyear=int(intime/10000000000.d0)
            xx=oyear*10000000000.d0
            omonth=int((intime-xx)/100000000.d0)
            xx=xx+omonth*100000000.
            oday=int((intime-xx)/1000000.)
            xx=xx+oday*1000000.
            ohour=int((intime-xx)/10000.)
         else
            call uduerr(ercode,'UTDEC','')
            write(0,*) ''
            write(0,*) 'NOTE: You must call netop_init to use gridread,'
            write(0,*) '      gridreadx, dayread, and dayreadx'
            stop
         endif
      else
         ercode = UTCALTIME(intime,unitptr,oyear,omonth,oday,ohour,
     &                      tmin,tsec)
         if (ercode.ne.0) then
            call uduerr(ercode,'UTCALTIME','')
            stop
         endif
      endif

C     Free up the pointer
      call UTFREE(unitptr)

      return
      end
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C  This function is intended to handle all possible error conditions
C  for the Udunits package  (Version 1.7.1) from Unidata, it takes the 
C  error code returned from a udunits function, the function name and 
C  the filename the function was accessing (applicable only for utopen
C  function).  It prints an indication to the user of the error and 
C  function in which it occurred.
C
C  Written by: Tom Baltzer of CDC  February 10, 1995
C
C  File:  uduerr.f  (To be added to netopen.subr.f)
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      subroutine uduerr(ercode, funcname, filename)

      include '/usr/local/include/udunits.inc'

      integer ercode 		! The Udunits Error number
      character* (*) funcname 	! Function name which returned error
      character* (*) filename	! Name of file on which funct operates
      character*1024 path	! Path to file on which funct really works

      if (filename.eq.'') then
         call getenv('UDUNITS_PATH',path)
         if (path.eq.'') then
            path = '/usr/local/src/udunits'
         endif
      else
         path = filename
      endif
      
      write(0,*) 'Error in udunits function: ',funcname
      if (ercode.eq.UT_ENOFILE) then
         write(0,*) 'File: ',path(1:iblank(path))
         write(0,*) 'Does not exist!'
      elseif (ercode.eq.UT_ESYNTAX) then
         write(0,*) 'A Udunits syntax error was detected'
         if (path.ne.'') then
            write(0,*) 'Possibly in the file: ',
     &			path(1:iblank(path))
         endif
      elseif (ercode.eq.UT_EUNKNOWN) then
         write(0,*) 'Udunits unknown specification found'
         if (path.ne.'') then
            write(0,*) 'Possibly in the file: ',
     &			path(1:iblank(path))
         endif
      elseif (ercode.eq.UT_EIO) then
         write(0,*) 'I/O Error detected'
         if (path.ne.'') then
            write(0,*) 'Possibly in the file: ',
     &			path(1:iblank(path))
         endif
      elseif (ercode.eq.UT_EINVALID) then
         write(0,*) 'An invalid udunits structure was found'
         write(0,*) ' Note: probably a temporal struct'
      elseif (ercode.eq.UT_ENOINIT) then
         write(0,*) 'Udunits package has not been initialized'
      elseif (ercode.eq.UT_ECONVERT) then
         write(0,*) 'No conversion between the two units is possible'
      elseif (ercode.eq.UT_ENOROOM) then
         write(0,*) 'Not enough room in character string for conversion'
      elseif (ercode.eq.UT_EALLOC) then
         write(0,*) 'Memory allocation falure'
      else
         write(0,*) 'UTOPEN: Unknown error: ',ercode
      endif

      return
      end

      integer function iblank(c)
      character * (*) c

      i=len(c)
      iblank=0
      do j=i,1,-1
         if(c(j:j).ne.' ')then
            iblank=j
            goto 444
         endif
      enddo
      
 444  return
      end
