File: C:\NOAA\NEMS_11731\src\chem\gocart\src\GMAO_Shared\GMAO_gfio\gfio.f

1     !-------------------------------------------------------------------------
2     !         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
3     !-------------------------------------------------------------------------
4     !BOI
5     !
6     !  !TITLE: The Grid File I/O (Gfio) Library \\ Version 1.0.8
7     !
8     !  !AUTHORS: Rob Lucchesi and  Arlindo da Silva
9     !
10     !  !AFFILIATION: Data Assimilation Office, NASA/GSFC, Greenbelt, MD 20771
11     !
12     !  !DATE: November 2, 1999 (Original design October 1997)
13     !
14     !  !INTRODUCTION: System Overview
15     !
16     !   \begin{verbatim}
17     !
18     !    Basic Requirements:
19     !    ------------------
20     !
21     !    (1) Design an interface for writing HDF format data files from 
22     !        the June 1998 GEOS-3 production system without requiring the 
23     !        direct insertion of HDF Toolkit calls in the code.
24     !
25     !    (2) Design this interface to be flexible enough to support usage in
26     !        other DAO applications that read or write HDF data.
27     !
28     !    (3) Output files should conform the COARDS conventions. This allows the 
29     !        data to be immediately usable by GrADS, other visualization packages 
30     !        and utilites such as ncdump.
31     !                          
32     !    (4) Provide a library that is callable from a Fortran 77 application
33     !        with a portable interface.
34     !
35     !    (5) The library must also be callable by C, perhaps with the use of a
36     !        tool like Cfortran.h.
37     !
38     !    The primary motivation behind GFIO is to provide an easy way for
39     !    the GEOS-DAS to write HDF format data while hiding calls to the HDF
40     !    libraries.  Additionally, it is hoped that this library will be of general 
41     !    use for reading or writing HDF files in applications other than the 
42     !    GEOS-DAS.
43     !
44     !    The typical calling sequence for creating a file would be:
45     !
46     !        GFIO_Create(...)
47     !      
48     !        GFIO_PutVar(...)
49     !        GFIO_PutVar(...)
50     !        GFIO_PutVar(...)
51     !            .
52     !            .
53     !            .
54     !        GFIO_Close(...)
55     !
56     !    One could subsequently open the file for more writing with:
57     !
58     !        GFIO_Open(...)
59     !
60     !    NOTES:
61     !    -----
62     !
63     !    * Surface data is permitted in the same file as upper air data, however
64     !      all upper air data must be defined with the same number of levels but
65     !      it is not necessary to write data for each defined level.  In the case
66     !      that data is not written for a given level, HDF will put fills.
67     !
68     !    * Packing is not yet implemented.
69     !
70     !    * The time increment cannot be defined as 0, even if only writing one
71     !      time.
72     !
73     !    * Files are written using the NetCDF interface provided in the HDF
74     !      library.  The files conform to the COARDS conventions, meaning they
75     !      have specific metadata defined by the convention.  
76     !
77     !    * As of v1.0.8 some generic COARDS compliant files (as those written by
78     !      by LATS4d) can be read with GFIO.
79     !
80     !   \end{verbatim}
81     !
82     !EOI
83     !-------------------------------------------------------------------------
84     
85     !
86     !                    INTERFACE FOR WRITING A FILE
87     !                    ----------------------------
88     !
89     
90     !-------------------------------------------------------------------------
91     !         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
92     !-------------------------------------------------------------------------
93     !BOP
94     !
95     ! !ROUTINE:  GFIO_Create -- Creates a DAO gridded file for writing
96     ! 
97     ! !DESCRIPTION: This routine is used to open a new file for a GFIO stream.
98     !               Packing is not yet supported.  Information about each opened
99     !               stream is stored in a COMMON block contained in gfio.h.  
100     !               This information is later used by GFIO\_PutVar.  GFIO\_Open
101     !               should be used to open an existing file for reading or writing.
102     !
103     ! !INTERFACE:
104     !
105           subroutine GFIO_Create ( fname, title, source, contact, amiss,
106          &                         im, jm, km, lon, lat, levs, levunits, 
107          &                         yyyymmdd_beg, hhmmss_beg, timinc,
108          &                         nvars, vname, vtitle, vunits, kmvar,
109          &                         valid_range, packing_range, prec,
110          &                         fid, rc )
111     !
112     ! !USES:
113     !
114           Implicit NONE  
115           include "netcdf.inc"
116           include "gfio.h"
117     !
118     ! !INPUT PARAMETERS: 
119     !
120                                         ! ------- Global Metadata ------
121           character*(*)   fname         ! File name
122           character*(*)   title         ! A title for the data set
123           character*(*)   source        ! Source of data, e.g. NASA/DAO
124           character*(*)   contact       ! Who to contact about the data set, e.g.,
125                                         ! 'Contact data@gmao.gsfc.nasa.gov'
126           real            amiss         ! Missing value such as 1.0E15
127     
128                                         ! ------- Dimension Metadata -------
129           integer         im            ! size of longitudinal dimension
130           integer         jm            ! size of latitudinal  dimension
131           integer         km            ! size of vertical     dimension 
132                                         ! (surface only=1)
133           real            lon(im)       ! longitude of center of gridbox in 
134                                         ! degrees east of Greenwich (can be 
135                                         ! -180 -> 180 or 0 -> 360)
136           real            lat(jm)       ! latitude of center of gridbox in 
137                                         ! degrees north of equator
138           real            levs(km)      ! Level (units given by levunits) of
139                                         !   center of gridbox
140           character*(*)   levunits      ! units of level dimension, e.g.,
141                                         !   "millibar", "hPa", or "sigma_level"
142           integer        yyyymmdd_beg   ! First year-month-day to be written 
143           integer          hhmmss_beg   ! First hour-minute-second to be written
144           integer         timinc        ! Increment between output times (HHMMSS)
145     
146                                         ! ------- Variable Metadata -------
147           integer         nvars         ! number of variables in file
148           character*(*)   vname(nvars)  ! variable short name, e.g., "hght"
149           integer         vmode         ! variable type
150           character*(*)   vtitle(nvars) ! variable long name, e.g.,
151                                         !   "Geopotential Height"
152           character*(*)   vunits(nvars) ! variable units, e.g., "meter/second"
153           integer         kmvar(nvars)  ! number of levels for variable; it can
154                                         !  either be 0 (2-D fields) or equal to km
155     
156           real    valid_range(2,nvars)  ! Variable valid range; GFIO_PutVar
157                                         ! will return a non-fatal error if a value is 
158                                         ! outside of this range. IMPORTANT: If packing
159                                         ! is not desired for a given variable, YOU MUST
160                                         ! set both components of valid_range to amiss.
161                                         ! ------ Packing Metadata ----
162           real   packing_range(2,nvars) ! Packing range to be used for 16-bit packing 
163                                         ! of each variable. IMPORTANT: If packing is not 
164                                         ! desired for a given variable, YOU MUST set both
165                                         ! components of packing_range to amiss.
166                                         ! NOTE:
167                                         ! * The packing algorithm sets all values
168                                         !    outside the packing range to missing.
169                                         ! * The larger the packing range, the greater
170                                         !    the loss of precision.
171           integer        prec           ! Desired precision of data:
172                                         !   0 = 32 bit
173                                         !   1 = 64 bit
174                                         !   NOTE: mixing precision in the same 
175                                         !   * Mixing 32 and 64 bit precision in the 
176                                         !      same file is not supported.
177                                         !   * If packing is turned on for a variable,
178                                         !      the prec flag is ignored.
179         
180     !
181     ! !OUTPUT PARAMETERS:
182     !
183           integer        fid     ! File handle
184           integer        rc      ! Error return code:
185                                  !  rc = 0   all is well
186                                  !  rc = -1  time increment is 0
187                                  !  rc = -18 incorrect time increment
188                                  !
189                                  !  NetCDF Errors
190                                  !  -------------
191                                  !  rc = -30  error from nccre (file create)
192                                  !  rc = -31  error from ncddef
193                                  !  rc = -32  error from ncvdef (dimension variable)
194                                  !  rc = -33  error from ncaptc (dimension attribute)
195                                  !  rc = -34  error from ncvdef (variable)
196                                  !  rc = -35  error from ncaptc (variable attribute)
197                                  !  rc = -36  error from ncaptc/ncapt (global attribute)
198                                  !  rc = -37  error from ncendf
199                                  !  rc = -38  error from ncvpt (dimension variable)
200                                         
201     
202     ! !REVISION HISTORY: 
203     !
204     !  1997.09.13  da Silva/Lucchesi  Initial interface design.
205     !  1997.09.22  Lucchesi           Added timinc to interface.
206     !  1998.02.10  Lucchesi           Added support for applications running with
207     !                                 64-bit reals.
208     !  1998.02.17  Lucchesi           Added time_inc, begin_time, and begin_date 
209     !                                 attributes to the time dimension.
210     !  1998.03.30  Lucchesi           Documentation expanded.  Clean-up of code.
211     !  1998.07.07  Lucchesi           Removed vids from argument list
212     !  1998.07.09  Lucchesi           Converted timinc to seconds before saving
213     !  1998.10.09  Lucchesi           Precision flag, documentation changes.
214     !  1998.10.27  Lucchesi           Added support for packing and range checks
215     !  1998.11.18  Lucchesi           Modified timinc to be HHMMSS as given by user
216     !  1999.01.04  Lucchesi           Changed variable initialization
217     !  1999.03.30  Lucchesi           Added 'positive=down' attribute to lev.
218     !  2009.04.28  Lucchesi           Changed lon/lat/lev from float to double.
219     !
220     !EOP
221     !-------------------------------------------------------------------------
222     
223           ! REAL*4 variables for 32-bit output to netCDF file.
224     
225           real*4 amiss_32
226           real*4 lon_32(im), lat_32(jm), levs_32(km)
227           real*8 lon_64(im), lat_64(jm), levs_64(km)
228           real*4 scale_32, offset_32
229           real*4 high_32,low_32
230           integer vid(nvars)
231           integer i, j
232           integer timeid, latid, lonid, levid
233           integer timedim, latdim, londim, levdim
234           integer dims3D(4), dims2D(3)
235           integer corner(4), edges(4)
236           character*80 timeUnits 
237           logical surfaceOnly
238           character*8 strBuf
239           character*14 dateString
240           integer year,mon,day,hour,min,sec
241           integer err
242     
243     ! Variables for packing
244     
245           integer*2 amiss_16
246           real*4 pRange_32(2,nvars),vRange_32(2,nvars)
247           logical packflag
248     
249     ! Set metadata strings.  These metadata values are specified in the 
250     ! COARDS conventions
251     
252           character (len=50) :: lonName = "longitude"
253           character (len=50) :: lonUnits = "degrees_east"
254           character (len=50) :: latName = "latitude"
255           character (len=50) :: latUnits = "degrees_north"
256           character (len=50) :: levName = "vertical level"
257     c                           levUnits: specified by user in argument list
258           character (len=50) :: timeName = "time"
259     c                           timeUnits: string is built below
260           character (len=50) :: conventions = "COARDS"
261           character (len=50) :: history = "File written by GFIO v1.0.8"
262             
263           amiss_16 = PACK_FILL
264     
265     
266     ! Variable initialization
267     
268           surfaceOnly = .TRUE.
269     
270     ! Basic error-checking.
271     
272           if (timinc .eq. 0) then
273             rc=-1
274             return
275           endif
276     
277     ! Check to see if there is only surface data in this file definition
278     
279           do i=1,nvars
280             if (kmvar(i) .NE. 0) then
281               surfaceOnly = .FALSE.
282               exit
283             endif
284           enddo
285     
286     ! Convert double-precision output variables to single-precision
287     
288           do i=1,im
289              lon_64(i) = lon(i)
290           enddo
291           do i=1,jm
292              lat_64(i) = lat(i)
293           enddo
294           do i=1,km
295              levs_64(i) = levs(i)
296           enddo
297           do j=1,nvars
298             do i=1,2
299                vRange_32(i,j) = valid_range(i,j)
300                pRange_32(i,j) = packing_range(i,j)
301             enddo
302           enddo
303     
304           amiss_32 = amiss
305     
306     ! Make NetCDF errors non-fatal, but issue warning messages.
307     
308           call ncpopt(NCVERBOS)
309     
310     ! Create the new NetCDF file. [ Enter define mode. ]
311     
312     #if defined(HAS_NETCDF4)
313           rc = nf_create (fname, IOR(NF_CLOBBER,NF_NETCDF4), fid)
314     #else
315           fid = nccre (fname, NCCLOB, rc)
316     #endif
317           if (err("Create: can't create file",rc,-30) .LT. 0) return
318     
319     ! Define dimensions.
320     
321           londim = ncddef (fid, 'lon', im, rc)
322           if (err("Create: error defining lon",rc,-31) .LT. 0) return
323           latdim = ncddef (fid, 'lat', jm, rc)
324           if (err("Create: error defining lat",rc,-31) .LT. 0) return
325           if (.NOT. surfaceOnly) then
326             levdim = ncddef (fid, 'lev', km, rc)
327             if (err("Create: error defining lev",rc,-31) .LT. 0) return
328           endif
329           timedim = ncddef(fid, 'time', NCUNLIM, rc)
330           if (err("Create: error defining time",rc,-31) .LT. 0) return
331     
332     ! Define dimension variables.
333     
334           lonid = ncvdef (fid, 'lon', NCDOUBLE, 1, londim, rc)
335           if (err("Create: error creating lon",rc,-32) .LT. 0) return
336           latid = ncvdef (fid, 'lat', NCDOUBLE, 1, latdim, rc)
337           if (err("Create: error creating lat",rc,-32) .LT. 0) return
338           if (.NOT. surfaceOnly) then
339             levid = ncvdef (fid, 'lev', NCDOUBLE, 1, levdim, rc)
340             if (err("Create: error creating lev",rc,-32) .LT. 0) return
341           endif
342           timeid = ncvdef (fid, 'time', NCLONG, 1, timedim, rc)
343           if (err("Create: error creating time",rc,-32) .LT. 0) return
344     
345     ! Set attributes for dimensions.
346     
347           call ncaptc (fid,lonid,'long_name',NCCHAR,LEN_TRIM(lonName),
348          .             lonName,rc)
349           if (err("Create: error creating lon attribute",rc,-33) .LT. 0)
350          .   return
351           call ncaptc (fid,lonid,'units',NCCHAR,LEN_TRIM(lonUnits),
352          .             lonUnits,rc)
353           if (err("Create: error creating lon attribute",rc,-33) .LT. 0) 
354          .   return
355     
356           call ncaptc (fid,latid,'long_name',NCCHAR,LEN_TRIM(latName),
357          .             latName,rc)
358           if (err("Create: error creating lat attribute",rc,-33) .LT. 0) 
359          .   return
360           call ncaptc (fid,latid,'units',NCCHAR,LEN_TRIM(latUnits),
361          .             latUnits,rc)
362           if (err("Create: error creating lat attribute",rc,-33) .LT. 0) 
363          .   return
364     
365           if (.NOT. surfaceOnly) then
366             call ncaptc (fid,levid,'long_name',NCCHAR,LEN_TRIM(levName),
367          .               levName,rc)
368             if (err("Create: error creating lev attribute",rc,-33) .LT. 0)
369          .      return
370             call ncaptc (fid,levid,'units',NCCHAR,LEN_TRIM(levunits),
371          .               levunits,rc)
372             if (err("Create: error creating lev attribute",rc,-33) .LT. 0)
373          .      return
374             call ncaptc (fid,levid,'positive',NCCHAR,LEN_TRIM('down'),
375          .               'down',rc)
376             if (err("Create: error creating lev attribute",rc,-33) .LT. 0)
377          .      return
378           endif
379     
380           call ncaptc (fid, timeid, 'long_name', NCCHAR, LEN_TRIM(timeName),
381          .             timeName, rc)
382           if (err("Create: error creating time attribute",rc,-33) .LT. 0)
383          .   return
384     
385     !ams      write (dateString,200) yyyymmdd_beg, hhmmss_beg
386     !ams 200   format (I8,I6)
387     !ams      read (dateString,201) year,mon,day,hour,min,sec
388     !ams 201   format (I4,5I2)
389     
390           call GFIO_parseIntTime ( yyyymmdd_beg, year, mon, day )
391           call GFIO_parseIntTime (   hhmmss_beg, hour, min, sec )
392     
393           write (timeUnits,202) year,mon,day,hour,min,sec
394     202   format ('minutes since ',I4.4,'-',I2.2,'-',I2.2,' ',I2.2,':',
395          .         I2.2,':',I2.2)
396           call ncaptc (fid, timeid, 'units', NCCHAR, LEN_TRIM(timeUnits), 
397          .             timeUnits, rc)
398           if (err("Create: error creating time attribute",rc,-33) .LT. 0)
399          .   return
400           
401     !ams      write (strBuf,203) timinc
402     !ams 203   format (I6)
403     !ams      read (strBuf,204) hour, min, sec
404     !ams 204   format (3I2)
405     
406           call GFIO_parseIntTime ( timinc, hour, min, sec )
407     
408           if ( sec .NE. 0) then
409             print *, 'GFIO_Create: Time increments not on minute',
410          .           ' boundaries are not currently allowed.'
411             rc = -18
412             return
413           endif
414           call ncapt (fid, timeid, 'time_increment', NCLONG, 1, timInc, rc)
415           if (err("Create: error creating time attribute",rc,-33) .LT. 0)
416          .   return
417           call ncapt (fid,timeid,'begin_date',NCLONG,1,yyyymmdd_beg,rc)
418           if (err("Create: error creating time attribute",rc,-33) .LT. 0)
419          .   return
420           call ncapt (fid,timeid,'begin_time',NCLONG,1,hhmmss_beg,rc)
421           if (err("Create: error creating time attribute",rc,-33) .LT. 0)
422          .   return
423     
424           dims3D(4) = timedim
425           dims3D(3) = levdim
426           dims3D(2) = latdim
427           dims3D(1) = londim
428           
429           dims2D(3) = timedim
430           dims2D(2) = latdim
431           dims2D(1) = londim
432     
433           scale_32 = 1.0     ! No packing for now.
434           offset_32 = 0.0    ! No packing for now.
435     
436     ! Set up packing attributes for each variable.  
437     ! Define physical variables.  Set attributes for physical variables.
438     
439           do i=1,nvars
440             scale_32 = 1.0                        ! default to no packing.
441             offset_32 = 0.0
442             if (pRange_32(1,i) .NE. amiss_32 .OR. pRange_32(2,i) .NE. 
443          .  amiss_32) then
444               if (pRange_32(1,i) .GT. pRange_32(2,i)) then
445                 high_32 = pRange_32(1,i)
446                 low_32  = pRange_32(2,i)
447               else
448                 high_32 = pRange_32(2,i)
449                 low_32  = pRange_32(1,i)
450               endif
451               scale_32 = (high_32 - low_32)/PACK_BITS*2
452               offset_32 = high_32 - scale_32*PACK_BITS
453               if (scale_32 .EQ. 0.0) then              ! If packing range is 0,
454                  scale_32 = 1.0                        ! no packing.
455                  offset_32 = 0.0
456                  packflag = .FALSE.
457               else
458                  packflag = .TRUE.
459               endif
460             else
461               packflag = .FALSE.
462             endif
463             if ( kmvar(i) .eq. 0 ) then
464               if (packflag) then
465                 vid(i) = ncvdef (fid, vname(i), NCSHORT, 3, dims2D, rc)
466                 vmode=NCSHORT;
467               else if (prec .EQ. 1) then
468                 vid(i) = ncvdef (fid, vname(i), NCDOUBLE, 3, dims2D, rc)
469                 vmode=NCDOUBLE;
470               else
471                 vid(i) = ncvdef (fid, vname(i), NCFLOAT, 3, dims2D, rc)
472                 vmode=NCFLOAT;
473               endif
474             else
475               if (packflag) then
476                 vid(i) = ncvdef (fid, vname(i), NCSHORT, 4, dims3D, rc)
477                 vmode=NCSHORT;
478               else if (prec .EQ. 1) then
479                 vid(i) = ncvdef (fid, vname(i), NCDOUBLE, 4, dims3D, rc)
480                 vmode=NCDOUBLE;
481               else
482                 vid(i) = ncvdef (fid, vname(i), NCFLOAT, 4, dims3D, rc)
483                 vmode=NCFLOAT;
484               endif
485             endif
486             if (err("Create: error defining variable",rc,-34) .LT. 0) 
487          .    return
488     
489             call ncaptc (fid, vid(i), 'long_name', NCCHAR, 
490          .               LEN_TRIM(vtitle(i)),vtitle(i), rc)
491             if (err("Create: error defining variable attribute",rc,-35)
492          .     .LT. 0) return
493             call ncaptc (fid, vid(i), 'units', NCCHAR, 
494          .               LEN_TRIM(vunits(i)),vunits(i), rc)
495             if (err("Create: error defining variable attribute",rc,-35)
496          .     .LT. 0) return
497     
498             if (packflag) then
499               if (vmode .EQ. NCSHORT) then
500                 call ncapt (fid,vid(i),'_FillValue',vmode,1,amiss_16,rc)
501               end if 
502               if (vmode .EQ. NCFLOAT) then
503                 call ncapt (fid,vid(i),'_FillValue',vmode,1,amiss_32,rc)
504               end if 
505               if (vmode .EQ. NCDOUBLE) then
506                 call ncapt (fid,vid(i),'_FillValue',vmode,1,amiss,rc)
507               end if 
508               if (err("Create: error defining variable attribute",rc,-35)
509          .     .LT. 0) return
510               if ( scale_32 .ne. 1.0 .or. offset_32 .ne. 0.0 ) then
511               call ncapt (fid,vid(i),'scale_factor',NCFLOAT,1,scale_32,rc)
512               if (err("Create: error defining variable attribute",rc,-35)
513          .         .LT. 0) return
514               call ncapt (fid,vid(i),'add_offset',NCFLOAT,1,offset_32,rc)
515               if (err("Create: error defining variable attribute",rc,-35)
516          .         .LT. 0) return
517               call ncapt (fid,vid(i),'packmin',NCFLOAT,1,low_32,rc)
518               if (err("Create: error defining variable attribute",rc,-35) 
519          .        .LT. 0) return
520               call ncapt (fid,vid(i),'packmax',NCFLOAT,1,high_32,rc)
521               if (err("Create: error defining variable attribute",rc,-35) 
522          .        .LT. 0) return
523               end if
524               call ncapt (fid,vid(i),'missing_value',NCSHORT,1,amiss_16,rc)
525               if (err("Create: error defining variable attribute",rc,-35)
526          .     .LT. 0) return
527               call ncapt (fid,vid(i),'fmissing_value',NCFLOAT,1,amiss_32,rc)
528               if (err("Create: error defining variable attribute",rc,-35)
529          .     .LT. 0) return
530             else
531               if (vmode .EQ. NCSHORT) then
532                 call ncapt (fid,vid(i),'_FillValue',vmode,1,amiss_16,rc)
533               end if 
534               if (vmode .EQ. NCFLOAT) then
535                 call ncapt (fid,vid(i),'_FillValue',vmode,1,amiss_32,rc)
536               end if 
537               if (vmode .EQ. NCDOUBLE) then
538                 call ncapt (fid,vid(i),'_FillValue',vmode,1,amiss,rc)
539               end if 
540               if (err("Create: error defining variable attribute",rc,-35)
541          .     .LT. 0) return
542               if ( scale_32 .ne. 1.0 .or. offset_32 .ne. 0.0 ) then
543               call ncapt (fid,vid(i),'scale_factor',NCFLOAT,1,scale_32,rc)
544               if (err("Create: error defining variable attribute",rc,-35)
545          .         .LT. 0) return
546               call ncapt (fid,vid(i),'add_offset',NCFLOAT,1,offset_32,rc)
547               if (err("Create: error defining variable attribute",rc,-35)
548          .         .LT. 0) return
549               end if
550               call ncapt (fid,vid(i),'missing_value',NCFLOAT,1,amiss_32,rc)
551               if (err("Create: error defining variable attribute",rc,-35)
552          .     .LT. 0) return
553               call ncapt (fid,vid(i),'fmissing_value',NCFLOAT,1,amiss_32,rc)
554               if (err("Create: error defining variable attribute",rc,-35)
555          .     .LT. 0) return
556             endif
557     
558             if (vRange_32(1,i) .NE. amiss_32 .OR. vRange_32(2,i) .NE. 
559          .      amiss_32) then
560               if (vRange_32(1,i) .GT. vRange_32(2,i)) then
561                 high_32 = vRange_32(1,i)
562                 low_32  = vRange_32(2,i)
563               else
564                 high_32 = vRange_32(2,i)
565                 low_32  = vRange_32(1,i)
566               endif
567               call ncapt (fid,vid(i),'vmin',NCFLOAT,1,low_32,rc)
568               if (err("Create: error defining variable attribute",rc,-35)
569          .        .LT. 0) return
570               call ncapt (fid,vid(i),'vmax',NCFLOAT,1,high_32,rc)
571               if (err("Create: error defining variable attribute",rc,-35)
572          .        .LT. 0) return
573             else
574               call ncapt (fid,vid(i),'vmin',NCFLOAT,1,amiss_32,rc)
575               if (err("Create: error defining variable attribute",rc,-35)
576          .        .LT. 0) return
577               call ncapt (fid,vid(i),'vmax',NCFLOAT,1,amiss_32,rc)
578               if (err("Create: error defining variable attribute",rc,-35)
579          .        .LT. 0) return
580     
581             endif
582           enddo
583      
584     ! Define global file attributes.
585     
586           call ncaptc (fid,NCGLOBAL,'Conventions',NCCHAR,
587          .             LEN_TRIM(conventions),conventions,rc)
588           if (err("Create: error defining Conventions",rc,-36).LT. 0) 
589          .   return
590           call ncaptc (fid,NCGLOBAL,'Source',NCCHAR,LEN_TRIM(source),
591          .             source,rc)
592           if (err("Create: error defining Source",rc,-36).LT. 0) return
593           call ncaptc (fid,NCGLOBAL,'Title',NCCHAR,LEN_TRIM(title),title,
594          .             rc)
595           if (err("Create: error defining Title",rc,-36).LT. 0) return
596           call ncaptc (fid,NCGLOBAL,'Contact',NCCHAR,LEN_TRIM(contact),
597          .             contact,rc)
598           if (err("Create: error defining Contact",rc,-36).LT. 0) return
599           call ncaptc (fid,NCGLOBAL,'History',NCCHAR,LEN_TRIM(history),
600          .             history,rc)
601           if (err("Create: error defining History",rc,-36).LT. 0) return
602     
603     ! Exit define mode.
604     
605           call ncendf (fid, rc)
606           if (err("Create: error exiting define mode",rc,-37) .LT. 0) 
607          .  return
608     
609     ! Write out dimension variables.
610     
611           corner(1) = 1
612           edges(1) = im
613           call ncvpt (fid, lonid, corner, edges, lon_64, rc)
614           if (err("Create: error writing lons",rc,-38) .LT. 0) return
615     
616           corner(1) = 1
617           edges(1) = jm
618           call ncvpt (fid, latid, corner, edges, lat_64, rc)
619           if (err("Create: error writing lats",rc,-38) .LT. 0) return
620     
621           if (.NOT. surfaceOnly) then
622             corner(1) = 1
623             edges(1) = km
624             call ncvpt (fid, levid, corner, edges, levs_64, rc)
625             if (err("Create: error writing levs",rc,-38) .LT. 0) return
626           endif
627     
628           corner(1) = 1
629           edges(1) = 1
630           call ncvpt (fid, timeid, corner, edges, 0, rc)
631           if (err("Create: error writing times",rc,-38) .LT. 0) return
632     
633           rc=0
634           return
635           end
636     
637     !-------------------------------------------------------------------------
638     !         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
639     !-------------------------------------------------------------------------
640     !BOP
641     ! !ROUTINE:  GFIO_Open -- Opens an existing DAO gridded file 
642     !
643     !
644     ! !DESCRIPTION: This routine opens an existing DAO gridded file.  The file
645     !               mode will be read/write.  If the application already knows
646     !               the contents of the file, it may begin interaction with the
647     !               file using the returned file handle.  Otherwise, the file
648     !               handle can be used with the "inquire" routines to gather 
649     !               information about the contents.  A negative return code 
650     !               indicates there were problems opening the file.
651     !
652     !
653     ! !INTERFACE:
654     !
655           subroutine GFIO_Open ( fname, fmode, fid, rc )
656     
657     !
658     ! !USES:
659     !
660     
661           Implicit NONE
662           include "netcdf.inc"
663           include "gfio.h"
664     
665     !
666     ! !INPUT PARAMETERS:
667     !
668     
669           character*(*)   fname         ! File name
670           integer         fmode         ! File mode:  
671                                         !   0 for READ-WRITE 
672                                         !   non-zero for READ-ONLY
673     
674     !
675     ! !OUTPUT PARAMETERS:
676     !
677     
678           integer        fid            ! File handle
679           integer        rc             ! Error return code:
680                                         !   rc = 0    All is well
681                                         !   rc = -39  error from ncopn (file open)
682     ! !REVISION HISTORY:
683     !
684     !  1998.07.02   Lucchesi             Initial interface design.
685     !  1998.07.07   Lucchesi             Initial coding.
686     !  1998.12.09   Lucchesi             Corrected for ncopn bug.
687     !EOP
688     !-------------------------------------------------------------------------
689     
690            integer err
691     
692             if ( fmode .EQ. 0) then
693                fid = ncopn(fname, NCRDWR, rc)
694             else         
695                fid = ncopn(fname, NCNOWRIT, rc)
696             endif
697             if (fid .LT. 0) then    ! ncopn has a bug.  error codes should
698                rc = fid             ! be returned in rc, but in reality they
699             endif                   ! are returned in fid.  
700     
701            if (err("Open: error opening file",rc,-39) .NE. 0) return
702     
703            rc = 0
704            return
705            end
706     
707     !-------------------------------------------------------------------------
708     !         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
709     !-------------------------------------------------------------------------
710     !BOP
711     !
712     ! !ROUTINE:  GFIO_PutVar -- Write a variable to the file
713     ! 
714     ! !DESCRIPTION: This routine is used to write a variable to an open GFIO 
715     !               stream.  Multiple vertical levels can be written at one 
716     !               time provided they are contiguous in memory.  Date and time 
717     !               must be consistent with the time increment and the starting 
718     !               date/time as defined in GFIO\_Create.  Times must fall on 
719     !               minute boundaries to allow GrADS to work.  Error checking is 
720     !               done for dimensions that are out of bounds.
721     !
722     ! !INTERFACE:
723     !
724           subroutine GFIO_PutVar ( fid, vname, yyyymmdd, hhmmss,
725          &                         im, jm, kbeg, kount, grid, 
726          &                         rc )  
727     !
728     ! !USES:
729     
730           Implicit NONE  
731           include "netcdf.inc"
732           include "gfio.h"
733     !
734     ! !INPUT PARAMETERS: 
735     !
736           integer        fid                 ! File handle
737           character*(*)  vname               ! Variable name
738           integer        yyyymmdd            ! Year-month-day, e.g., 19971003
739           integer        hhmmss              ! Hour-minute-second, e.g., 120000
740      
741           integer         im                 ! size of longitudinal dimension
742           integer         jm                 ! size of latitudinal  dimension
743           integer         kbeg               ! first level to write; if 2-D grid
744                                              !   use kbeg = 0.
745           integer         kount              ! number of levels to write
746           real            grid(im,jm,kount)  ! Gridded data to write at this time
747                                          
748     
749     ! !OUTPUT PARAMETERS:
750      
751           integer        rc  ! Error return code:
752                              !  rc =  0  all is well
753                              !  rc = -2  time is inconsistent with increment 
754                              !  rc = -3  number of levels is incompatible with file
755                              !  rc = -4  im is incompatible with file
756                              !  rc = -5  jm is incompatible with file
757                              !  rc = -6  time must fall on a minute boundary    
758                              !  rc = -7  error in diffdate              
759                              !  rc = -12  error determining default precision
760                              !  rc = -13  error determining variable type
761                              !  rc = -15  data outside of valid range
762                              !  rc = -16  data outside of packing range
763                              !  rc = -17  data outside of pack and valid range
764                              !
765                              !  NetCDF Errors
766                              !  -------------
767                              !  rc = -38  error from ncvpt (dimension variable)
768                              !  rc = -40  error from ncvid
769                              !  rc = -41  error from ncdid or ncdinq (lat or lon)
770                              !  rc = -42  error from ncdid or ncdinq (lev)
771                              !  rc = -43  error from ncvid (time variable)
772                              !  rc = -44  error from ncagt (time attribute)
773                              !  rc = -45  error from ncvpt
774                              !  rc = -46  error from ncvgt
775                              !  rc = -52  error from ncvinq
776                              !  rc = -53  error from ncagtc/ncagt
777     
778     ! !REVISION HISTORY: 
779     !
780     !  1997.10.13 da Silva/Lucchesi   Initial interface design.
781     !  1998.02.10 Lucchesi            Added support for applications running with
782     !                                 64-bit reals.
783     !  1998.03.30 Lucchesi            Documentation expanded.  Clean-up of code.
784     !  1998.07.02 Lucchesi            Replaced vid with vname in argument list &
785     !                                 made related mods to code.
786     !  1998.09.24 Lucchesi            Changed error codes, removed DIM_CHECK if-def
787     !  1998.10.27 Lucchesi            Added support for packing and range checks
788     !  1998.12.15 Lucchesi            Added support for skipping times (allTimes)
789     !  1999.01.04 Lucchesi            Fixed bug in skipping times (allTimes)/also 
790     !                                 changed variable initialization.
791     !  1999.07.13 Lucchesi            Changes for REAL or INT time dimension
792     !
793     !EOP
794     !-------------------------------------------------------------------------
795     
796           integer timeid, dimSize, dimId, timeType
797           character*(MAXCHR) dimName
798           integer corner(4), edges(4)
799           integer vid
800           integer seconds, DiffDate, timeIndex
801           integer minutes                       ! added as a work-around
802           integer idx, i, j, k
803           integer begDate, begTime, timInc
804           integer err
805           character*8 strBuf
806           integer hour,min,sec,incSecs
807           integer, allocatable ::  allTimes(:)
808           integer fillTime
809     
810     ! Variables for dealing with precision
811     
812           real*4, allocatable :: grid_32(:,:,:)
813           real*8, allocatable :: grid_64(:,:,:)
814           real*4 dummy32
815           real*8 dummy64
816           real   dummy
817     
818     ! Variables for NCVINQ
819     
820           character*(MAXCHR) varName
821           integer type, nvDims, vdims(MAXVDIMS), nvAtts
822     
823     ! Variables for packing and range checking
824     
825           integer*2, allocatable :: grid_16(:,:,:)
826           real*4, allocatable :: fminutes_32(:)
827           real*4 high_32, low_32, amiss_32
828           real*4 scale_32, offset_32
829           logical outRange
830           logical outPRange
831     
832     ! Variable initialization
833     
834           outRange = .FALSE.
835           outPRange = .FALSE.
836     
837     ! Make NetCDF errors non-fatal, but issue warning messages.
838     
839           call ncpopt(NCVERBOS)
840     
841     ! Check to make sure max string lengths are large enough.  NetCDF defines
842     ! MAXNCNAM, but it can't be used in a character*MAXNCNAM statement.
843     ! MAXCHR is a CPP define in the gfio.h file.
844     
845           if (MAXCHR .LT. MAXNCNAM) then
846             print *, 'GFIO_PutVar warning: MAXNCNAM is larger than ',
847          .           'dimName array size.'
848           endif
849     
850     ! Determine NetCDF variable ID.
851     
852           vid = ncvid (fid, vname, rc)
853           if (err("PutVar: variable not defined",rc,-40) .NE. 0) return
854     
855     ! Basic error checking
856           dimId = ncdid (fid, 'lon', rc)
857           if (err("PutVar: can't get ID for lon",rc,-41) .NE. 0) return
858           call ncdinq (fid, dimId, dimName, dimSize, rc)
859           if (err("PutVar: can't get info for lon",rc,-41) .NE. 0) return
860           if (dimSize .ne. im) then
861             rc = -4
862             return
863           endif
864     
865           dimId = ncdid (fid, 'lat', rc)
866           if (err("PutVar: can't get ID for lat",rc,-41) .NE. 0) return
867           call ncdinq (fid, dimId, dimName, dimSize, rc)
868           if (err("PutVar: can't get info for lat",rc,-41) .NE. 0) return
869           if (dimSize .ne. jm) then
870             rc = -5
871             return
872           endif
873     
874           if (kbeg .NE. 0) then
875             dimId = ncdid (fid, 'lev', rc)
876             if (err("PutVar: can't get ID for lev",rc,-42) .NE. 0) return
877             call ncdinq (fid, dimId, dimName, dimSize, rc)
878             if (err("PutVar: can't get info for lev",rc,-42) .NE. 0) return
879             if (kbeg-1 + kount .gt. dimSize) then
880               rc = -3
881               return
882             endif
883           endif
884     
885     ! Determine number of seconds since starting date/time.
886     
887           timeId = ncvid (fid, 'time', rc)
888           if (err("PutVar: time not defined",rc,-43) .NE. 0) return
889           call ncagt (fid, timeId, 'begin_date', begDate, rc)
890           if (err("PutVar: missing begin_date",rc,-44) .NE. 0) return
891           call ncagt (fid, timeId, 'begin_time', begTime, rc)
892           if (err("PutVar: missing begin_time",rc,-44) .NE. 0) return
893     
894           seconds = DiffDate (begDate, begTime, yyyymmdd, hhmmss)
895     
896           if (seconds .lt. 0) then
897             print *, 'GFIO_PutVar: Error code from diffdate.  Problem with',
898          .           ' date/time.'
899             rc = -7
900             return
901           endif
902           if ( MOD (seconds,60) .eq. 0 ) then 
903             minutes = seconds / 60
904           else
905             print *, 'GFIO_PutVar: Currently, times must fall on minute ',
906          .           'boundaries.'
907             rc = -6
908             return
909           endif
910      
911     ! Confirm that this time is consistent with the starting time coupled with
912     ! the time increment.
913     
914           call ncagt (fid, timeId, 'time_increment', timInc, rc)
915           if (err("PutVar: missing time increment",rc,-44) .NE. 0) return
916           
917     ! Convert time increment to seconds.
918     
919     !ams      write (strBuf,203) timinc
920     !ams 203   format (I6)
921     !ams      read (strBuf,204) hour, min, sec
922     !ams 204   format (3I2)
923     
924           call GFIO_parseIntTime ( timinc, hour, min, sec )
925     
926           incSecs = hour*3600 + min*60 + sec
927     
928           if ( MOD (seconds, incSecs) .ne. 0 ) then
929             print *, 'GFIO_putvar: Absolute time of ',seconds,' not ',
930          .           'possible with an interval of ',incSecs
931             rc = -2
932             return
933           else
934             timeIndex = seconds/incSecs + 1
935           endif
936     
937     ! Load starting indicies.
938     
939           if ( kbeg .eq. 0 ) then
940             corner(1)=1
941             corner(2)=1
942             corner(3)=timeIndex
943             edges(1)=im
944             edges(2)=jm
945             edges(3)=1
946           else
947             corner(1)=1
948             corner(2)=1
949             corner(3)=kbeg
950             corner(4)=timeIndex
951             edges(1)=im
952             edges(2)=jm
953             edges(3)=kount
954             edges(4)=1
955           endif
956     
957     ! Check variable against valid range.
958     
959           call ncagt (fid, vid, 'vmin', low_32, rc)
960           if (err("PutVar: can't get vmin",rc,-53) .NE. 0) return
961           call ncagt (fid, vid, 'vmax', high_32, rc)
962           if (err("PutVar: can't get vmax",rc,-53) .NE. 0) return
963           call ncagt (fid, vid, 'fmissing_value', amiss_32, rc)
964           if (err("PutVar: can't get fmissing_value",rc,-53) .NE. 0) return
965           if (low_32 .NE. amiss_32 .OR. high_32 .NE. amiss_32) then
966             do k=1,kount
967               do j=1,jm
968                 do i=1,im
969                   if (grid(i,j,k) .GT. high_32 .OR. grid(i,j,k) .LT. 
970          .        low_32) then
971                     outRange = .TRUE.
972                     goto 100
973                   endif
974                 enddo
975               enddo
976             enddo
977     100     continue
978           endif
979           
980     ! Determine if we are writing single- or double-precision.
981     
982           call ncvinq (fid, vid, varName, type, nvDims, vDims, nvAtts, rc)
983           if (err("PutVar: error in variable inquire",rc,-52) .NE. 0) return
984     
985     ! Write variable in the appropriate precision.
986     
987           if (HUGE(dummy) .EQ. HUGE(dummy32)) then        ! -r4
988             if (type .EQ. NCFLOAT) then                     ! 32-bit
989               call ncvpt (fid, vid, corner, edges, grid, rc)
990             else if (type .EQ. NCDOUBLE) then               ! 64-bit
991               allocate (grid_64(im,jm,kount))
992               do k=1,kount
993                 do j=1,jm
994                   do i=1,im
995                     grid_64(i,j,k) = grid(i,j,k)
996                   enddo
997                 enddo
998               enddo
999               call ncvpt (fid, vid, corner, edges, grid_64, rc)
1000               deallocate (grid_64)
1001             else if (type .EQ. NCSHORT) then
1002               call ncagt (fid, vid, 'packmax', high_32, rc)
1003               if (err("PutVar: error getting packmax",rc,-53) .NE. 0) return
1004               call ncagt (fid, vid, 'packmin', low_32, rc)
1005               if (err("PutVar: error getting packmin",rc,-53) .NE. 0) return
1006               call ncagt (fid, vid, 'scale_factor', scale_32, rc)
1007               if (err("PutVar: error getting scale",rc,-53) .NE. 0) return
1008               call ncagt (fid, vid, 'add_offset', offset_32, rc)
1009               if (err("PutVar: error getting offset",rc,-53) .NE. 0) return
1010               allocate (grid_16(im,jm,kount))
1011               do k=1,kount
1012                 do j=1,jm
1013                   do i=1,im
1014                     if ( grid(i,j,k) .LT. low_32 .OR. grid(i,j,k) .GT. 
1015          .          high_32) then
1016                       grid_16(i,j,k) = PACK_FILL
1017                       outPRange = .TRUE.
1018                     else
1019                       grid_16(i,j,k) = (grid(i,j,k) - offset_32)/scale_32
1020                     endif
1021                   enddo
1022                 enddo
1023               enddo
1024               call ncvpt (fid, vid, corner, edges, grid_16, rc)
1025               deallocate (grid_16)
1026             else
1027               rc = -13
1028               return
1029             endif
1030           else if (HUGE(dummy) .EQ. HUGE(dummy64)) then   ! -r8
1031             if (type .EQ. NCFLOAT) then                     ! 32-bit
1032               allocate (grid_32(im,jm,kount))
1033               do k=1,kount
1034                 do j=1,jm
1035                   do i=1,im
1036                     grid_32(i,j,k) = grid(i,j,k)
1037                   enddo
1038                 enddo
1039               enddo
1040               call ncvpt (fid, vid, corner, edges, grid_32, rc)
1041               deallocate (grid_32)
1042             else if (type .EQ. NCDOUBLE) then                ! 64-bit
1043               call ncvpt (fid, vid, corner, edges, grid, rc)
1044             else if (type .EQ. NCSHORT) then
1045               call ncagt (fid, vid, 'packmax', high_32, rc)
1046               if (err("PutVar: error getting packmax",rc,-53) .NE. 0) return
1047               call ncagt (fid, vid, 'packmin', low_32, rc)
1048               if (err("PutVar: error getting packmin",rc,-53) .NE. 0) return
1049               call ncagt (fid, vid, 'scale_factor', scale_32, rc)
1050               if (err("PutVar: error getting scale",rc,-53) .NE. 0) return
1051               call ncagt (fid, vid, 'add_offset', offset_32, rc)
1052               if (err("PutVar: error getting offset",rc,-53) .NE. 0) return
1053               allocate (grid_16(im,jm,kount))
1054               do k=1,kount
1055                 do j=1,jm
1056                   do i=1,im
1057                     if ( grid(i,j,k) .LT. low_32 .OR. grid(i,j,k) .GT.
1058          .          high_32) then
1059                       grid_16(i,j,k) = PACK_FILL
1060                       outPRange = .TRUE.
1061                     else
1062                       grid_16(i,j,k) = (grid(i,j,k) - offset_32)/scale_32
1063                     endif
1064                   enddo
1065                 enddo
1066               enddo
1067               call ncvpt (fid, vid, corner, edges, grid_16, rc)
1068               deallocate (grid_16)
1069             else
1070               rc = -13
1071               return
1072             endif
1073           else
1074             rc = -12
1075             return
1076           endif
1077           if (err("PutVar: error writing variable",rc,-45) .NE. 0) return
1078     
1079     ! Read time dimension scale and fill all values up to the current time.
1080     ! This will insure missing times are defined with the proper time value.
1081     
1082           call ncdinq (fid, timeId, dimName, dimSize, rc)
1083           dimSize = dimSize - 1                           ! We've already written the 
1084                                                           ! the new time.
1085           allocate ( allTimes (MAX(timeIndex,dimSize)) )
1086           allocate ( fminutes_32 (MAX(timeIndex,dimSize)) )
1087           call ncvinq (fid,timeId,dimName,timeType,nvDims,vDims,nvAtts,rc)
1088     
1089           if (dimSize .GT. 0) then
1090             ! Depending on the version of GFIO used to write the file, the Time
1091             ! dimension variable can either be floating point or integer.
1092     
1093             corner(1)=1
1094             edges(1)=dimSize
1095     
1096             if (timeType .EQ. NCFLOAT) then
1097               call ncvgt (fid,timeId,corner,edges,fminutes_32,rc)
1098               do i=1,dimSize
1099                 allTimes(i) = INT(fminutes_32(i))
1100               enddo
1101             else if (timeType .EQ. NCLONG) then
1102               call ncvgt (fid,timeId,corner,edges,allTimes,rc)
1103             endif
1104             if (err("PutVar: error reading times from file",rc,-46) .NE. 0)
1105          .      return
1106           endif
1107     
1108           ! This loop fills the time dimension scale based on the time increment 
1109           ! specified in GFIO_Create.  If GFIO ever changes to support variable 
1110           ! time increments, this code MUST be changed.   
1111     
1112           do i=1,timeIndex-1
1113             fillTime = (i-1) * incSecs/60
1114             allTimes(i) = fillTime
1115           enddo
1116           allTimes(timeIndex) = minutes
1117     
1118     ! Write filled time array to file.
1119     
1120           corner(1)=1
1121           edges(1)=timeIndex
1122     
1123           if (timeType .EQ. NCFLOAT) then
1124             do i=1,timeIndex
1125               fminutes_32(i) = INT(allTimes(i))
1126             enddo
1127             call ncvpt (fid,timeId,corner,edges,fminutes_32,rc)
1128           else if (timeType .EQ. NCLONG) then
1129             call ncvpt (fid,timeId,corner,edges,allTimes,rc)
1130           endif
1131           if (err("PutVar: error writing time",rc,-38) .NE. 0) return
1132     
1133           if (outRange .AND. outPRange) then
1134             rc = -17
1135           else if (outPRange) then
1136             rc = -16
1137           else if (outRange) then
1138             rc = -15
1139           else
1140             rc = 0
1141           endif
1142     
1143           deallocate ( allTimes )
1144           deallocate ( fminutes_32 )
1145     
1146           return
1147           end
1148     
1149     !-------------------------------------------------------------------------
1150     !         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
1151     !-------------------------------------------------------------------------
1152     !
1153     !BOP
1154     !
1155     ! !ROUTINE:  GFIO_GetVarT -- Read a variable from the file with interpolation
1156     !
1157     ! !CAHNGE: Ravi 11082004   GFIO_GetVarT, a wrapper to the original GFIO_GetVar
1158     !                          to avoild the optional cyclic argument.
1159     !
1160     ! !DESCRIPTION: This routine will read one or more levels of "vname"
1161     !               into the buffer passed in as "grid."  "fid" is the file
1162     !               handle returned by Gfio\_open. Unlike {\tt Get\_Var()},
1163     !               this routine will interpolate in time if necessary.
1164     !               If interpolation is required between two times in different
1165     !               files, two file IDs can be passed in.
1166     !
1167     ! !INTERFACE:
1168     !
1169           subroutine GFIO_GetVarT ( fid, vname, yyyymmdd, hhmmss,
1170          &                          im, jm, kbeg, kount, grid, rc,
1171          &                          fid2)
1172     !
1173     ! !USES:
1174     !
1175     ! !INPUT PARAMETERS:
1176     !
1177           integer        fid              ! File handle
1178           integer        fid3             ! File handle
1179           integer        fid2             ! File handle
1180           character*(*)  vname            ! Variable name
1181           integer        yyyymmdd         ! Year-month-day, e.g., 19971003
1182           integer          hhmmss         ! Hour-minute-second, e.g., 120000
1183           integer         im              ! size of longitudinal dimension
1184           integer         jm              ! size of latitudinal  dimension
1185           integer         kbeg            ! first level to read; if 2-D grid
1186                                           !  set kbeg = 0.
1187           integer         kount           ! number of levels to read
1188                                          
1189           logical         cyclic          ! whether time dimension is periodic
1190     !
1191     ! !OUTPUT PARAMETERS:
1192     !
1193           real         grid(im,jm,kount)  ! Gridded data read for this time
1194           integer         rc              ! Error return code:
1195     
1196     ! !REVISION HISTORY:
1197     !
1198     !  2004.11.08 Ravi        Wrapper for GFIO_GetvarT
1199     !
1200     !EOP
1201     
1202     
1203            cyclic = .false.
1204             call GFIO_GetVarT1 ( fid, vname, yyyymmdd, hhmmss,
1205          &                       im, jm, kbeg, kount, grid, rc,
1206          &                       cyclic, fid2 )
1207            return
1208            end
1209     
1210     
1211     !-------------------------------------------------------------------------
1212     !         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
1213     !-------------------------------------------------------------------------
1214     !
1215     !BOP
1216     !
1217     ! !ROUTINE:  GFIO_GetVarT1 -- Read a variable from the file with interpolation 
1218     !
1219     ! !DESCRIPTION: This routine will read one or more levels of "vname"
1220     !               into the buffer passed in as "grid."  "fid" is the file
1221     !               handle returned by Gfio\_open. Unlike {\tt Get\_Var()},
1222     !               this routine will interpolate in time if necessary.
1223     !               If interpolation is required between two times in different
1224     !               files, two file IDs can be passed in.
1225     !
1226     ! !INTERFACE:
1227     !
1228           subroutine GFIO_GetVarT1 ( fid, vname, yyyymmdd, hhmmss,
1229          &                          im, jm, kbeg, kount, grid, rc, 
1230          &                          cyclic,fid2 )
1231     !
1232     ! !USES:
1233     !
1234           Implicit NONE
1235           include "netcdf.inc"
1236           include "gfio.h"
1237     !
1238     ! !INPUT PARAMETERS:
1239     !
1240           integer        fid,fid2         ! File handle
1241           character*(*)  vname            ! Variable name
1242           integer        yyyymmdd         ! Year-month-day, e.g., 19971003
1243           integer          hhmmss         ! Hour-minute-second, e.g., 120000
1244           integer         im              ! size of longitudinal dimension
1245           integer         jm              ! size of latitudinal  dimension
1246           integer         kbeg            ! first level to read; if 2-D grid
1247                                           !  set kbeg = 0.
1248           integer         kount           ! number of levels to read
1249     
1250           logical         cyclic          ! whether time dimension is periodic
1251     !
1252     ! !OUTPUT PARAMETERS:
1253     !
1254           real         grid(im,jm,kount)  ! Gridded data read for this time
1255           integer  rc        ! Error return code:
1256                              !  rc  = 0   all is well
1257                              !  rc \= 0   abnormal exit (TO DO: list these)
1258     
1259     ! !REVISION HISTORY:
1260     !
1261     !  1999.11.02 da Silva    Initial code. Undocumented.
1262     !  2001.10.11 B. Yin      Added optional fid2 parameter
1263     !
1264     !
1265     !EOP
1266     !
1267     !-------------------------------------------------------------------------
1268     
1269           integer begDate, begTime, incSecs, timeIndex1, timeIndex2
1270           integer secs, secs1, secs2, nymd1, nymd2, nhms1, nhms2
1271           integer err, diffdate, i, j, k 
1272     
1273           real    grid2(im,jm,kount)  ! workspace for interpolation
1274           real    alpha, amiss, gfio_getmissing
1275     
1276           logical tcyclic
1277     
1278     
1279     ! By default time dimension is not periodic
1280     
1281           tcyclic = cyclic
1282     
1283           rc = 0
1284     
1285     !     Get beginning time & date.  Calculate offset seconds from start.
1286     !     ----------------------------------------------------------------
1287           call GetBegDateTime ( fid, begDate, begTime, incSecs, rc )
1288           if (err("GetVar: could not determine begin_date/begin_time",rc,-44) 
1289          &    .NE. 0) return
1290     
1291           secs = DiffDate (begDate, begTime, yyyymmdd, hhmmss)
1292     
1293           if ( .not. tcyclic ) then
1294              if (yyyymmdd .LT. begDate .OR. (begDate .EQ. yyyymmdd .AND.
1295          .        hhmmss .LT. begTime) .or. secs .LT. 0) then
1296                 print *, 'GFIO_GetVar: Requested time earlier than first time.'
1297                 rc = -7
1298                 return
1299              endif
1300           end if
1301     
1302     !     Determine brackting times
1303     !     -------------------------
1304           if ( secs >= 0 ) then
1305              timeIndex1 = secs/incSecs + 1
1306           else
1307              timeIndex1 = secs/incSecs
1308           end if
1309           timeIndex2 = timeIndex1 + 1
1310           secs1 = (timeIndex1-1) * incSecs
1311           secs2 = (timeIndex2-1) * incSecs
1312           call GetDate ( begDate, begTime, secs1, nymd1, nhms1, rc )
1313           call GetDate ( begDate, begTime, secs2, nymd2, nhms2, rc )
1314     
1315     !ams  print *, 'Cyclic: ', tcyclic
1316     !ams  print *, 'Time 1: ', secs1, nymd1, nhms1
1317     !ams  print *, 'Time  : ', secs,  yyyymmdd, hhmmss
1318     !ams  print *, 'Time 2: ', secs2, nymd2, nhms2
1319     !ams  print *, 'Time Indices: ', timeIndex1, timeIndex2  
1320     !ams  print *, 'incSecs: ', incSecs
1321     !ams  print *, 'begDate/time: ', begDate, begTime
1322     
1323     !     Read grids at first time with GetVar()
1324     !     --------------------------------------
1325           call GFIO_GetVar1 ( fid, vname, nymd1, nhms1, 
1326          &                   im, jm, kbeg, kount, grid, tcyclic, rc )
1327           if ( rc .ne. 0 ) return    
1328     
1329           if ( secs1 .eq. secs ) return   ! no interpolation needed
1330     
1331     
1332     !     Read grids at second time with GetVar()
1333     !     ---------------------------------------
1334           call GFIO_GetVar1 ( fid, vname, nymd2, nhms2, 
1335          &                   im, jm, kbeg, kount, grid2, tcyclic, rc)
1336           if ( rc .ne. 0 ) then
1337              if ( fid /= fid2 )         
1338          &       call GFIO_GetVar1 ( fid2, vname, nymd2, nhms2,
1339          &                          im, jm, kbeg, kount, grid2, tcyclic, rc )
1340              
1341              if ( rc .ne. 0 ) return    
1342           end if
1343     
1344     !     Get missing value
1345     !     -----------------
1346           amiss = GFIO_GetMissing ( fid, rc )
1347           if ( rc .ne. 0 ) return
1348     
1349     !     Do interpolation
1350     !     ----------------
1351           alpha = float(secs - secs1)/float(secs2 - secs1)
1352     !ams  print *, 'alpha = ', alpha
1353           do k = 1, kount
1354              do j = 1, jm
1355                 do i = 1, im
1356                    if ( grid(i,j,k) .ne. amiss .and. grid2(i,j,k) .ne. amiss ) then
1357                       grid(i,j,k) = grid(i,j,k) 
1358          &                        + alpha * (grid2(i,j,k) - grid(i,j,k))
1359                    else
1360                       grid(i,j,k) = amiss
1361                    end if
1362                 end do
1363              end do
1364           end do
1365     
1366     !     All done
1367     !     --------
1368           rc = 0
1369     
1370           return
1371           end
1372     
1373     !-------------------------------------------------------------------------
1374     !         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
1375     !-------------------------------------------------------------------------
1376     !BOP
1377     !
1378     ! !ROUTINE:  GFIO_GetVar -- Read a variable from the file
1379     !
1380     ! !CAHNGE: Ravi 11082004   GFIO_GetVar, a wrapper to the original GFIO_GetVar
1381     !                          to avoild the optional cyclic argument.
1382     !
1383     ! !DESCRIPTION: This routine will read one or more levels of "vname"
1384     !               into the buffer passed in as "grid."  "fid" is the file
1385     !               handle returned by Gfio\_open.
1386     !
1387     ! !INTERFACE:
1388     !
1389           subroutine GFIO_GetVar ( fid, vname, yyyymmdd, hhmmss,
1390          &                         im, jm, kbeg, kount, grid, rc)
1391     !
1392           Implicit NONE
1393     !
1394     ! !INPUT PARAMETERS:
1395     !
1396           integer        fid              ! File handle
1397           character*(*)  vname            ! Variable name
1398           integer        yyyymmdd         ! Year-month-day, e.g., 19971003
1399           integer          hhmmss         ! Hour-minute-second, e.g., 120000
1400           integer         im              ! size of longitudinal dimension
1401           integer         jm              ! size of latitudinal  dimension
1402           integer         kbeg            ! first level to read; if 2-D grid
1403                                           !  set kbeg = 0.
1404           integer         kount           ! number of levels to read
1405           logical         cyclic          ! whether time dimension is periodic
1406           real         grid(im,jm,kount)  ! Gridded data read for this time
1407           integer         rc              ! Error return code:
1408     !
1409     !EOP
1410     
1411           cyclic = .false.
1412           call GFIO_GetVar1 ( fid, vname, yyyymmdd, hhmmss,
1413          &                         im, jm, kbeg, kount, grid,
1414          &                         cyclic,rc )
1415     
1416           return
1417           end
1418     
1419     
1420     !-------------------------------------------------------------------------
1421     !         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
1422     !-------------------------------------------------------------------------
1423     !
1424     !BOP
1425     !
1426     ! !ROUTINE:  GFIO_GetVar1 -- Read a variable from the file 
1427     !
1428     ! !DESCRIPTION: This routine will read one or more levels of "vname"
1429     !               into the buffer passed in as "grid."  "fid" is the file
1430     !               handle returned by Gfio\_open.
1431     !
1432     ! !INTERFACE:
1433     !
1434           subroutine GFIO_GetVar1 ( fid, vname, yyyymmdd, hhmmss,
1435          &                         im, jm, kbeg, kount, grid,
1436          &                         cyclic,rc)
1437     !
1438     ! !USES:
1439     !
1440           Implicit NONE
1441           include "netcdf.inc"
1442           include "gfio.h"
1443     !
1444     ! !INPUT PARAMETERS:
1445     !
1446           integer        fid              ! File handle
1447           character*(*)  vname            ! Variable name
1448           integer        yyyymmdd         ! Year-month-day, e.g., 19971003
1449           integer          hhmmss         ! Hour-minute-second, e.g., 120000
1450           integer         im              ! size of longitudinal dimension
1451           integer         jm              ! size of latitudinal  dimension
1452           integer         kbeg            ! first level to read; if 2-D grid
1453                                           !  set kbeg = 0.
1454           integer         kount           ! number of levels to read
1455           logical         cyclic          ! whether time dimension is periodic
1456     
1457     !
1458     ! !OUTPUT PARAMETERS:
1459     !
1460           real         grid(im,jm,kount)  ! Gridded data read for this time
1461           integer  rc        ! Error return code:
1462                              !  rc = 0   all is well
1463                              !  rc = -2  time is inconsistent with increment
1464                              !  rc = -3  number of levels is incompatible with file
1465                              !  rc = -4  im is incompatible with file  
1466                              !  rc = -5  jm is incompatible with file  
1467                              !  rc = -6  time must fall on a minute boundary
1468                              !  rc = -7  error in diffdate
1469                              !  rc = -12  error determining default precision
1470                              !  rc = -13  error determining variable type
1471                              !  rc = -19  unable to identify coordinate variable
1472                              !
1473                              !  NetCDF Errors
1474                              !  -------------
1475                              !  rc = -38  error from ncvpt (dimension variable)
1476                              !  rc = -40  error from ncvid
1477                              !  rc = -41  error from ncdid or ncdinq (lat or lon)
1478                              !  rc = -42  error from ncdid or ncdinq (lev)
1479                              !  rc = -43  error from ncvid (time variable)
1480                              !  rc = -44  error from ncagt (time attribute)
1481                              !  rc = -46  error from ncvgt
1482                              !  rc = -48  error from ncinq
1483                              !  rc = -52  error from ncvinq
1484     
1485     
1486     ! !REVISION HISTORY:
1487     !
1488     !  1997.10.13 da Silva/Lucchesi   Initial interface design.
1489     !  1998.07.07 Lucchesi            Combined two GetVar routines into this one.
1490     !  1998.09.24 Lucchesi            Updated error codes.
1491     !  1999.06.21 Lucchesi            Bug fixed.  Unable to read HDF-EOS files
1492     !                                 because was still looking for "lon" and "lat"
1493     !  1999.06.21 Lucchesi            Added a check for time too early.
1494     !  1999.11.02 da Silva            Made LATS4D compatible.
1495     !  2004.02.23 da Silva            Added cyclic option
1496     !  2008.12.05  Kokron             Changed ncvid of a dimension to ncdid to make NetCDF4 happy
1497     !  2009.04.07  Lucchesi           Removed assumption that dimension vars are at the top of the file.
1498     !
1499     !
1500     !EOP
1501     !-------------------------------------------------------------------------
1502     
1503           integer timeId, begDate, begTime, seconds, minutes, timInc
1504           integer corner(4), edges(4), timeIndex, timeShift, lm
1505           integer vid
1506           integer DiffDate
1507           integer err
1508           integer i,j,k
1509           character*8 strBuf
1510           integer hour,min,sec,incSecs
1511     
1512     ! Variables for working with dimensions
1513     
1514           character*(MAXCHR) dimName
1515           character*(MAXCHR) dimUnits 
1516           character*(MAXCHR) varName
1517           integer dimSize, dimId
1518           integer nDims,nvars,ngatts
1519           integer varType, index, IdentifyDim
1520     
1521     ! Variables for dealing with precision
1522     
1523           real*4, allocatable :: grid_32(:,:,:)
1524           real*8, allocatable :: grid_64(:,:,:)
1525           real*4 dummy32
1526           real*8 dummy64
1527           real   dummy
1528     
1529     ! Variables for NCVINQ
1530     
1531           integer type, nvDims, vdims(MAXVDIMS), nvAtts
1532     
1533     ! Variables for packing
1534     
1535           integer*2, allocatable :: grid_16(:,:,:)
1536           integer*2 amiss_16
1537           real*4 amiss_32
1538           real*4 scale_32, offset_32
1539     
1540           logical tcyclic
1541     ! Make NetCDF errors non-fatal, but issue warning messages.
1542     
1543           call ncpopt(NCVERBOS)
1544     
1545     ! By default time dimension is not periodic
1546     
1547                tcyclic = cyclic
1548     
1549     !ams  print *, 'GetVar has cyclic ', cyclic
1550              
1551     ! Check to make sure max string lengths are large enough.  NetCDF defines
1552     ! MAXNCNAM, but it can't be used in a character*MAXNCNAM statement.
1553     ! MAXCHR is a CPP define in the gfio.h file.
1554     
1555           if (MAXCHR .LT. MAXNCNAM) then
1556             print *, 'GFIO_GetVar warning: MAXNCNAM is larger than ',
1557          .           'dimName array size.'
1558           endif
1559     
1560     ! Get basic information from file.
1561     
1562           call ncinq (fid, nDims, nvars, ngatts, dimId, rc)
1563           if (err("DimInqure: ncinq failed",rc,-48) .NE. 0)return
1564     
1565     ! Subtract dimension variables from the variable count.
1566     ! Extract dimension information
1567     
1568           do i=1,nvars
1569             call ncvinq (fid,i,varName,varType,nvDims,vDims,nvAtts,rc)
1570             if (err("GFIO_GetVar1: variable inquire error",rc,-52) .NE. 0)
1571          .      return
1572             if (nvDims .EQ. 1) then
1573               nvars = nvars - 1
1574               dimId = ncdid (fid, varName, rc)
1575               if (err("GFIO_GetVar1: ncdid failed",rc,-41) .NE. 0) return
1576               call ncagtc (fid, i, 'units', dimUnits, MAXCHR, rc)
1577               if (err("DimInqure: could not get units for dimension",rc,-53)
1578          .       .NE. 0) return
1579               call ncdinq (fid, dimId, dimName, dimSize, rc)
1580               if (err("DimInqure: can't get dim info",rc,-41) .NE. 0) return
1581               index = IdentifyDim (dimName, dimUnits)
1582               if ( index .EQ. 0 ) then
1583                 if (dimSize .ne. im) then
1584                   rc = -4
1585                   im = dimSize
1586                   return
1587                 endif
1588               else if ( index .EQ. 1 ) then
1589                 if (dimSize .ne. jm) then
1590                   rc = -5
1591                   jm = dimSize
1592                   return
1593                 endif
1594               else if ( index .EQ. 2 ) then
1595                 if (kount .gt. dimSize) then
1596                   rc = -3
1597                   return
1598                 endif
1599               else if ( index .EQ. 3 ) then
1600                   timeId = dimId
1601                   lm = dimSize
1602               else
1603                 print *, 'GFIO_GetVar: Coordinate variable ',
1604          .               TRIM(dimName),' with units of ',TRIM(dimUnits),
1605          .               ' is not understood.'
1606                 rc = -19
1607                 return
1608               endif
1609             endif
1610           enddo
1611     
1612     ! Determine NetCDF variable ID.
1613     
1614           vid = ncvid (fid, vname, rc)
1615           if (err("GetVar: variable not defined",rc,-40) .NE. 0) return
1616      
1617     ! Get beginning time & date.  Calculate offset seconds from start.
1618     
1619     !ams      call ncagt (fid, timeId, 'begin_date', begDate, rc)
1620     !ams     if (err("GetVar: missing begin_date",rc,-44) .NE. 0) return
1621     !ams     call ncagt (fid, timeId, 'begin_time', begTime, rc)
1622     !ams     if (err("GetVar: missing begin_time",rc,-44) .NE. 0) return
1623     
1624           call GetBegDateTime ( fid, begDate, begTime, incSecs, rc )
1625           if (err("GetVar: could not determine begin_date/begin_time",rc,-44) 
1626          &    .NE. 0) return
1627     
1628           seconds = DiffDate (begDate, begTime, yyyymmdd, hhmmss)
1629     
1630     ! Make sure input time are valid, if time is not periodic
1631     
1632     !ams  print *, '+++ incSecs, begDate, begTime: ', incsecs, begDate, begTime
1633     !ams  print *, '+++ seconds, yyyymmdd, hhmmss: ', seconds, yyyymmdd, hhmmss
1634     
1635           if ( .not. tcyclic ) then
1636              if (seconds .LT. 0) then
1637                 print *, 'GFIO_GetVar: Error code from diffdate.  Problem with',
1638          .           ' date/time.'
1639                 rc = -7
1640                 return
1641              endif
1642              if (yyyymmdd .LT. begDate .OR. (begDate .EQ. yyyymmdd .AND.
1643          .        hhmmss .LT. begTime) ) then
1644                 print *, 'GFIO_GetVar: Requested time earlier than first time.'
1645                 rc = -7
1646                 return
1647              endif
1648     
1649           end if
1650     
1651           if ( MOD (seconds,60) .eq. 0 ) then
1652             minutes = seconds / 60
1653           else
1654             print *, 'GFIO_GetVar: Currently, times must fall on minute ',
1655          .           'boundaries.'
1656             rc = -6
1657             return
1658           endif
1659     
1660     ! Determine the time index from the offset and time increment.
1661     
1662     !ams      call ncagt (fid, timeId, 'time_increment', timInc, rc)
1663     !ams      if (err("GetVar: missing time increment",rc,-44) .NE. 0) return
1664     
1665     ! Convert time increment to seconds.
1666     
1667     !ams      write (strBuf,203) timinc
1668     !ams 203   format (I6)
1669     !ams      read (strBuf,204) hour, min, sec
1670     !ams 204   format (3I2)
1671     !ams       incSecs = hour*3600 + min*60 + sec
1672     
1673           if ( MOD (seconds, incSecs) .ne. 0 ) then
1674             print *, 'GFIO_getvar: Absolute time of ',seconds,' not ',
1675          .           'possible with an interval of ',incSecs
1676             rc = -2
1677             return
1678           else
1679             timeIndex = seconds/incSecs + 1
1680           endif
1681     
1682     ! Wrap time index around if time dimension is periodic
1683     
1684     !ams  print *, '--- Time Index: ', timeIndex
1685     
1686           if ( tcyclic ) then
1687              timeShift = mod ( timeIndex, lm )
1688              if ( timeShift > 0 ) then
1689                 timeIndex = timeShift 
1690              else 
1691                 timeIndex = lm + timeShift
1692              end if
1693           end if
1694     
1695     !ams  print *, '+++ Time Index, timeShift: ', timeIndex, timeShift
1696     
1697     ! Load starting indicies.
1698     
1699           if ( kbeg .eq. 0 ) then
1700             corner(1)=1
1701             corner(2)=1
1702             corner(3)=timeIndex
1703             edges(1)=im
1704             edges(2)=jm
1705             edges(3)=1
1706           else
1707             corner(1)=1
1708             corner(2)=1
1709             corner(3)=kbeg
1710             corner(4)=timeIndex
1711             edges(1)=im
1712             edges(2)=jm
1713             edges(3)=kount
1714             edges(4)=1
1715           endif
1716     
1717     ! Determine data type.
1718     
1719           call ncvinq (fid, vid, varName, type, nvDims, vDims, nvAtts, rc)
1720           if (err("GetVar: error in variable inquire",rc,-52) .NE. 0) return
1721     
1722     ! Read variable in the appropriate precision.
1723     
1724           if (HUGE(dummy) .EQ. HUGE(dummy32)) then        ! -r4
1725             if (type .EQ. NCFLOAT) then                     ! 32-bit
1726               call ncvgt (fid, vid, corner, edges, grid, rc)
1727             else if (type .EQ. NCDOUBLE) then               ! 64-bit
1728               allocate (grid_64(im,jm,kount))
1729               call ncvgt (fid, vid, corner, edges, grid_64, rc)
1730               do k=1,kount
1731                 do j=1,jm
1732                   do i=1,im
1733                     grid(i,j,k) = grid_64(i,j,k)
1734                   enddo
1735                 enddo
1736               enddo
1737               deallocate (grid_64)
1738             else if (type .EQ. NCSHORT) then
1739               call ncagt (fid, vid, 'scale_factor', scale_32, rc)
1740               if (err("GetVar: error getting scale",rc,-53) .NE. 0) return
1741               call ncagt (fid, vid, 'add_offset', offset_32, rc)
1742               if (err("GetVar: error getting offset",rc,-53) .NE. 0) return
1743               call ncagt (fid, vid, 'missing_value', amiss_16, rc)
1744               if (err("GetVar: error getting offset",rc,-53) .NE. 0) return
1745               call ncagt (fid, vid, 'fmissing_value', amiss_32, rc)
1746               if (err("GetVar: error getting offset",rc,-53) .NE. 0) return
1747               allocate (grid_16(im,jm,kount))
1748               call ncvgt (fid, vid, corner, edges, grid_16, rc)
1749               do k=1,kount
1750                 do j=1,jm
1751                   do i=1,im
1752                     if ( grid_16(i,j,k) .EQ. amiss_16 ) then
1753                       grid(i,j,k) = amiss_32
1754                     else
1755                       grid(i,j,k) = scale_32*grid_16(i,j,k) + offset_32
1756                     endif
1757                   enddo
1758                 enddo
1759               enddo
1760               deallocate (grid_16)
1761             else
1762               rc = -13
1763               return
1764             endif
1765           else if (HUGE(dummy) .EQ. HUGE(dummy64)) then   ! -r8
1766             if (type .EQ. NCFLOAT) then                     ! 32-bit
1767               allocate (grid_32(im,jm,kount))
1768               call ncvgt (fid, vid, corner, edges, grid_32, rc)
1769               do k=1,kount
1770                 do j=1,jm
1771                   do i=1,im
1772                     grid(i,j,k) = grid_32(i,j,k)
1773                   enddo
1774                 enddo
1775               enddo
1776               deallocate (grid_32)
1777             elseif (type .EQ. NCDOUBLE) then                ! 64-bit
1778               call ncvgt (fid, vid, corner, edges, grid, rc)
1779             else if (type .EQ. NCSHORT) then
1780               call ncagt (fid, vid, 'scale_factor', scale_32, rc)
1781               if (err("GetVar: error getting scale",rc,-53) .NE. 0) return
1782               call ncagt (fid, vid, 'add_offset', offset_32, rc)
1783               if (err("GetVar: error getting offset",rc,-53) .NE. 0) return
1784               call ncagt (fid, vid, 'missing_value', amiss_16, rc)
1785               if (err("GetVar: error getting offset",rc,-53) .NE. 0) return
1786               call ncagt (fid, vid, 'fmissing_value', amiss_32, rc)
1787               if (err("GetVar: error getting offset",rc,-53) .NE. 0) return
1788               allocate (grid_16(im,jm,kount))
1789               call ncvgt (fid, vid, corner, edges, grid_16, rc)
1790               do k=1,kount
1791                 do j=1,jm
1792                   do i=1,im
1793                     if ( grid_16(i,j,k) .EQ. amiss_16 ) then
1794                       grid(i,j,k) = amiss_32
1795                     else
1796                       grid(i,j,k) = scale_32*grid_16(i,j,k) + offset_32
1797                     endif
1798                   enddo
1799                 enddo
1800               enddo
1801               deallocate (grid_16)
1802             else
1803               rc = -13
1804               return
1805             endif
1806           else
1807             rc = -12
1808             return
1809           endif
1810           if (err("GetVar: error reading variable",rc,-46) .NE. 0) return
1811      
1812           rc = 0
1813           return
1814           end
1815     
1816     !-------------------------------------------------------------------------
1817     !         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
1818     !-------------------------------------------------------------------------
1819     !BOP
1820     !
1821     ! !ROUTINE:  GFIO_DimInquire -- Gets dimension information from a GFIO file.
1822     !
1823     ! !DESCRIPTION: This routine is used to get dimension information from
1824     !               an existing GFIO file.  This dimension information can 
1825     !               subsequently be used to allocate arrays for reading data
1826     !               from the file.  For more complete information about the 
1827     !               contents of a file, Gfio\_Inquire should be used.
1828     
1829     ! !INTERFACE:
1830     !
1831           subroutine GFIO_DimInquire (fid,im,jm,km,lm,nvars,ngatts,rc)
1832     !
1833     ! !USES:
1834     !
1835           Implicit NONE
1836           include "netcdf.inc"
1837           include "gfio.h"
1838     !
1839     ! !INPUT PARAMETERS:
1840     !
1841           integer        fid              ! File handle
1842     !
1843     ! !OUTPUT PARAMETERS:
1844     !
1845           integer     im     ! Size of longitudinal dimension
1846           integer     jm     ! Size of latitudinal dimension
1847           integer     km     ! Size of vertical dimension
1848                              !   km=0 if surface-only file
1849           integer     lm     ! Number of times 
1850           integer     nvars  ! Number of variables
1851           integer     ngatts ! Number of global attributes
1852           integer     rc     ! Error return code:
1853     
1854                              !  rc = 0    all is well
1855                              !  rc = -19  unable to identify coordinate variable
1856                              !
1857                              !  NetCDF Errors
1858                              !  -------------
1859                              !  rc = -40  error from ncvid
1860                              !  rc = -41  error from ncdid or ncdinq (lat or lon)
1861                              !  rc = -42  error from ncdid or ncdinq (lev)
1862                              !  rc = -43  error from ncvid (time variable)
1863                              !  rc = -47  error from ncdid or ncdinq (time)
1864                              !  rc = -48  error from ncinq
1865                              !  rc = -53  error from ncagtc/ncagt
1866     
1867     
1868     
1869     ! !REVISION HISTORY:
1870     !
1871     !  1998.07.02  Lucchesi    Initial interface design.
1872     !  1998.08.05  Lucchesi    Added "ngatts"
1873     !  1998.09.24  Lucchesi    Revamped error codes
1874     !  1998.12.22  Lucchesi    Added IdentifyDim and associated code
1875     !  1999.01.04  Lucchesi    Changed variable initialization
1876     !  2008.12.05  Kokron      Changed ncvid of a dimension to ncdid to make NetCDF4 happy
1877     !  2009.04.07  Lucchesi    Removed assumption that dimension vars are at the top of the file.
1878     !
1879     !EOP
1880     !-------------------------------------------------------------------------
1881     
1882           integer timeid, dimId, i
1883           integer attType, attLen
1884           character*(MAXCHR) dimName
1885           character*(MAXCHR) dimUnits
1886           character*(MAXCHR) vname
1887           integer dimSize
1888           integer nDims
1889           integer err
1890           logical surfaceOnly
1891           integer IdentifyDim, index
1892           integer varType, nvDims, vDims(MAXVDIMS), nvAtts
1893     
1894     ! Initialize variables
1895     
1896           surfaceOnly = .FALSE.
1897     
1898     ! Make NetCDF errors non-fatal, but issue warning messages.
1899     
1900           call ncpopt(NCVERBOS)
1901     
1902     ! Check FID here.
1903     
1904     ! Check to make sure max string lengths are large enough.  NetCDF defines
1905     ! MAXNCNAM, but it can't be used in a character*MAXNCNAM statement.
1906     ! MAXCHR is a CPP define in the gfio.h file.
1907     
1908           if (MAXCHR .LT. MAXNCNAM) then
1909             print *, 'GFIO_DimInquire warning: MAXNCNAM is larger than ',
1910          .           'dimName array size.'
1911           endif
1912     
1913     ! Get basic information from file.
1914      
1915         
1916           call ncinq (fid, nDims, nvars, ngatts, dimId, rc)
1917           if (err("DimInquire: ncinq failed",rc,-48) .NE. 0)return
1918     
1919           if (nDims .EQ. 3) then
1920             surfaceOnly = .TRUE.
1921           endif
1922     
1923     ! Subtract dimension variables from the variable count.
1924     ! Extract dimension information
1925     
1926           do i=1,nvars
1927             call ncvinq (fid,i,vname,varType,nvDims,vDims,nvAtts,rc)
1928             if (err("DimInquire: variable inquire error",rc,-52) .NE. 0) 
1929          .      return
1930             if (nvDims .EQ. 1) then
1931               nvars = nvars - 1
1932               dimId = ncdid (fid, vname, rc)
1933               if (err("DimInquire: ncdid failed",rc,-41) .NE. 0) return
1934               call ncdinq (fid, dimId, dimName, dimSize, rc)  
1935               if (err("DimInqure: can't get dim info",rc,-41) .NE. 0) return
1936     !         call ncagtc (fid, dimId, 'units', dimUnits, MAXCHR, rc)
1937               call ncagtc (fid, i, 'units', dimUnits, MAXCHR, rc)
1938               if (err("DimInquire: could not get units for dimension",rc,-53)
1939          .         .NE. 0) return
1940               index = IdentifyDim (dimName, dimUnits)
1941               if ( index .EQ. 0 ) then
1942                 im = dimSize
1943               else if ( index .EQ. 1 ) then
1944                 jm = dimSize
1945               else if ( index .EQ. 2 ) then
1946                 km = dimSize
1947               else if ( index .EQ. 3 ) then
1948                 lm = dimSize
1949               else
1950                 print *, 'GFIO_DimInquire: Coordinate variable ',
1951          .               TRIM(dimName),' with units of ',TRIM(dimUnits),
1952          .               ' is not understood.'
1953                 rc = -19
1954                 return
1955               endif
1956             endif
1957           enddo
1958     
1959           if (surfaceOnly) then
1960             km=0
1961           endif
1962     
1963           rc=0
1964           return
1965           end
1966     
1967     !-------------------------------------------------------------------------
1968     !         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
1969     !-------------------------------------------------------------------------
1970     !BOP
1971     !
1972     ! !ROUTINE:  GFIO_Inquire -- Get information about a GFIO file.
1973     ! 
1974     ! !DESCRIPTION: This routine is used to get as much information as possible
1975     !               about the contents of a GFIO file.  The file handle (fid) is
1976     !               passed in and detailed information about dimensions and 
1977     !               variables are returned to the application.  A simpler inquire
1978     !               routine for dimension information is Gfio\_DimInquire.
1979     !
1980     ! !INTERFACE:
1981     !
1982           subroutine GFIO_Inquire ( fid, im, jm, km, lm, nvars,
1983          &                        title, source, contact, amiss,
1984          &                        lon, lat, levs, levunits, 
1985          &                        yyyymmdd, hhmmss, timinc, 
1986          &                        vname, vtitle, vunits, kmvar,
1987          &                        valid_range , packing_range, rc)
1988     !
1989     ! !USES:
1990     !
1991           Implicit NONE  
1992           include "netcdf.inc"
1993           include "gfio.h"
1994     
1995     !
1996     ! !INPUT PARAMETERS: 
1997     !
1998     
1999                                         ! ------- Global Metadata ------
2000           integer        fid            ! File handle from GFIO_open
2001     !
2002     !
2003     ! !INPUT/OUTPUT PARAMETERS:
2004     !
2005           integer         im            ! size of longitudinal dimension
2006           integer         jm            ! size of latitudinal  dimension
2007           integer         km            ! size of vertical     dimension
2008           integer         lm            ! size of time         dimension
2009                                         ! On input, (im,jm,km,lm) contains the
2010                                         !  size of arrays (lon,lat,lev,yyyymmdd)
2011                                         !  as declared in the calling program.
2012                                         ! On output, (im,jm,km,lm) contains the 
2013                                         !  size of the coordinate variables
2014                                         !  (lon,lat,lev,yyyymmdd) on file.
2015           integer         nvars         ! number of variables on file
2016     
2017     !
2018     ! !OUTPUT PARAMETERS:
2019     !
2020           character*(*)   title         ! Title of the data set
2021           character*(*)   source        ! Where it came from
2022           character*(*)   contact       ! Who to contact about the data set
2023           real            amiss         ! Missing value 
2024     
2025                                         ! ------- Dimension Metadata -------
2026           real            lon(im)       ! longitude of center of gridbox in
2027                                         ! degrees east of Greenwich (can be
2028                                         ! -180 -> 180 or 0 -> 360)
2029           real            lat(jm)       ! latitude of center of gridbox in
2030                                         ! degrees north of equator
2031           real            levs(km)      ! Level (units given by levunits) of
2032                                         !   center of gridbox
2033           character*(*)   levunits      ! units of level dimension, e.g.,
2034                                         !   "hPa", "sigma_level"
2035           integer        yyyymmdd(lm)   ! Year-month-day on file 
2036           integer          hhmmss(lm)   ! Hour-minute-second on file 
2037           integer            timinc     ! Time increment. 
2038     
2039                                         ! ------- Variable Metadata -------
2040           character*(*)   vname(nvars)  ! variable short name, e.g., "hght"
2041           character*(*)   vtitle(nvars) ! variable long name, e.g.,
2042                                         !   "Geopotential Height"
2043           character*(*)   vunits(nvars) ! variable units, e.g., "meter/second"
2044           integer         kmvar(nvars)  ! number of levels for variable; it can
2045                                         !  either be 0 (2-D fields) or equal to km
2046           real    valid_range(2,nvars)  ! Variable valid range; set to
2047                                         !   "amiss" if not known.
2048      
2049                                         ! ------ Packing Metadata ----
2050           real  packing_range(2,nvars)  ! Variable packing range used
2051                                         !  for 16-bit packing. If packing was not
2052                                         !  used then returned values will be amiss. 
2053                                         ! NOTE: all unpacking is done transparently
2054                                         !       by GFIO_GetVar(). 
2055         
2056           integer    rc      ! Error return code:
2057                              !   rc = 0    all is well
2058                              !   rc = -3  number of levels is incompatible with file
2059                              !   rc = -4  im is incompatible with file
2060                              !   rc = -5  jm is incompatible with file
2061                              !   rc = -8  lm is incompatible with file
2062                              !   rc = -9  nvars is incompatible with file
2063                              !   rc = -14  error in getdate
2064                              !   rc = -20  vname strings too short
2065                              !
2066                              !  NetCDF Errors
2067                              !  -------------
2068                              !  rc = -41  error from ncdid or ncdinq (lat or lon)
2069                              !  rc = -42  error from ncdid or ncdinq (lev)
2070                              !  rc = -43  error from ncvid (time variable)
2071                              !  rc = -47  error from ncdid or ncdinq (time)
2072                              !  rc = -48  error from ncinq
2073                              !  rc = -50  error from ncagtc (level attribute)
2074                              !  rc = -51  error from ncagtc/ncagt (global attribute)
2075                              !  rc = -52  error from ncvinq
2076                              !  rc = -53  error from ncagtc/ncagt
2077     
2078     ! !FUTURE ENHANCEMENT:
2079     !                   Next release should include a flag for precision.
2080     !
2081     ! !REVISION HISTORY: 
2082     !
2083     !  1998.07.02   Lucchesi   Initial interface design.
2084     !  1998.07.17   Lucchesi   Initial coding.
2085     !  1998.10.09   Lucchesi   Restructured return codes.
2086     !  1998.12.24   Lucchesi   Modified to read non-GFIO files.
2087     !  1999.01.04   Lucchesi   Changed variable initialization
2088     !  1999.07.13   Lucchesi   Changes for REAL or INT time dimension
2089     !  1999.11.02   da Silva   Made LATS4D compatible.
2090     !  2000.10.23   Lucchesi   Updated calculation of time increment after
2091     !                          fixing bugs in GetBegDateTime.
2092     !  2001.04.23   da Silva   Fixed timInc bug for RUC
2093     !  2002.12.24   Takacs/RT  Bug fix in calc of timInc (was dividing by 0)
2094     !  2008.12.05   Kokron     Changed ncvid of a dimension to ncdid to make NetCDF4 happy
2095     !  2009.04.07   Lucchesi   Removed assumption that dimension vars are at the top of the file.
2096     !
2097     !
2098     !EOP
2099     !-------------------------------------------------------------------------
2100     
2101     ! Local Variables
2102     
2103           integer vid(nvars)
2104           integer timeType, dimType
2105           integer timeId, latId, lonId, levId, dimId, incSecs, incTime, varId
2106           integer nDims, recdim, ngatts, seconds
2107           integer varType, nvDims, vDims(MAXVDIMS), nvAtts
2108           integer yyyymmdd_beg, hhmmss_beg, hour, min, sec
2109           integer start1D, minutes(lm)
2110           character*8 strBuf
2111           character*(MAXCHR) dimName
2112           character*(MAXCHR) dimUnits
2113           character*(MAXCHR) vnameTemp
2114           integer IdentifyDim, index
2115           integer dimSize
2116           integer i
2117           logical surfaceOnly
2118           logical noTimeInfo
2119           integer attType, attLen
2120           integer fV                 ! found variables - excludes dimension vars
2121           integer allVars            ! all variables - includes dimension vars
2122     
2123           ! REAL*4 variables for 32 bit input from netCDF file.
2124     
2125           real*4 fminutes_32(lm)
2126           real*8 fminutes_64(lm)
2127           real*4 lon_32(im), lat_32(jm), levs_32(km)
2128           real*8 lon_64(im), lat_64(jm), levs_64(km)
2129           real*4 amiss_32
2130           real*4 pRange_32(2,nvars),vRange_32(2,nvars)
2131           integer err
2132           logical is_gfio
2133     
2134     ! Initialize variables
2135     
2136           fV = 0
2137           surfaceOnly = .FALSE.
2138           noTimeInfo = .FALSE.
2139           is_gfio = .true.       ! start assuming file was written by GFIO
2140     
2141     ! Make NetCDF errors non-fatal, and DO NOT issue warning messages.
2142     
2143           call ncpopt(2) ! Give error messages, but don't die
2144     
2145     ! Check length of vname string
2146     
2147           if (LEN(vname(1)) .lt. MAXNCNAM) then
2148             print *,'GFIO_Inquire: length of vname array must be at least ',
2149          .            MAXNCNAM,' bytes.'
2150             rc = -20
2151             return
2152           endif
2153     
2154     ! Check to make sure max string lengths are large enough.  NetCDF defines
2155     ! MAXNCNAM, but it can't be used in a character*MAXNCNAM statement.
2156     ! MAXCHR is a CPP define in the gfio.h file.
2157     
2158           if (MAXCHR .LT. MAXNCNAM) then
2159             print *, 'GFIO_Inquire warning: MAXNCNAM is larger than ',
2160          .           'dimName array size.'
2161           endif
2162     
2163     ! Get basic information from the file
2164     
2165           call ncinq (fid,nDims,allVars,ngatts,recdim,rc)
2166           if (err("Inqure: ncinq failed",rc,-48) .NE. 0) return
2167     
2168           if (nDims .EQ. 3) then
2169             surfaceOnly = .TRUE.
2170           endif
2171     
2172     ! Extract dimension information and check against inputs
2173     
2174           do i=1,allVars
2175             call ncvinq (fid,i,vnameTemp,varType,nvDims,vDims,nvAtts,rc)
2176             if (err("GFIO_Inquire: variable inquire error",rc,-52) .NE. 0)
2177          .      return
2178             if (nvDims .EQ. 1) then
2179                dimId = ncdid (fid, vnameTemp, rc)
2180                if (err("Inquire: ncdid failed",rc,-40) .NE. 0) return
2181                call ncdinq (fid, dimId, dimName, dimSize, rc)
2182                if (err("Inqure: can't get dim info",rc,-41) .NE. 0) return
2183     !          call ncagtc (fid, dimId, 'units', dimUnits, MAXCHR, rc)
2184                call ncagtc (fid, i, 'units', dimUnits, MAXCHR, rc)
2185                if (err("Inqure: could not get units for dimension",rc,-53)
2186          .         .NE. 0) return
2187                index = IdentifyDim (dimName, dimUnits)
2188                if ( index .EQ. 0 ) then
2189                   if (dimSize .ne. im) then
2190                     rc = -4
2191                     im = dimSize
2192                     return
2193                   else 
2194                     lonId = dimId
2195                     lonId = i
2196                   endif
2197                else if ( index .EQ. 1 ) then
2198                  if (dimSize .ne. jm) then
2199                    rc = -5
2200                    jm = dimSize
2201                    return
2202                  else
2203                    latId = dimId
2204                    latId = i
2205                  endif
2206                else if ( index .EQ. 2 ) then
2207                  if (km .ne. dimSize) then
2208                    rc = -3
2209                    km = dimSize
2210                    return
2211                  else
2212                    levId = dimId
2213                    levId = i
2214                  endif
2215                else if ( index .EQ. 3 ) then
2216                   if (lm .ne. dimSize) then
2217                    rc = -8
2218                    lm = dimSize
2219                    return
2220                  else
2221                    timeId = dimId
2222                    timeId = i
2223                  endif
2224                else
2225                  print *, 'GFIO_Inquire: Coordinate variable ',
2226          .                TRIM(dimName),' with units of ',TRIM(dimUnits),
2227          .                ' is not understood.'
2228                  rc = -19
2229                  return
2230                endif
2231             endif
2232           enddo
2233     
2234     
2235           start1D=1
2236     
2237     ! Get dimension values (coordinates)
2238     
2239     !     Dimension values in a native GFIO file are 32 bit.
2240     !     However, LATS4d uses double for coordinate variables.
2241     
2242           call ncvinq (fid,lonId,dimName,dimType,nvDims,vDims,nvAtts,rc)
2243           if ( dimType .eq. NCFLOAT ) then
2244              call ncvgt (fid,lonId,start1D,im,lon_32,rc)
2245              if (err("Inquire: error reading 32-bit lons",rc,-49) .LT. 0) return
2246              do i=1,im
2247                 lon(i)=lon_32(i)
2248              enddo
2249           else if ( dimType .eq. NCDOUBLE ) then
2250              is_gfio = .false.  ! this is not a GFIO file, probably LATS4D
2251              call ncvgt (fid,lonId,start1D,im,lon_64,rc)
2252              if (err("Inquire: error reading 64-bit lons",rc,-49) .LT. 0) return
2253              do i=1,im
2254                 lon(i)=lon_64(i)
2255              enddo
2256           else
2257              if (err("Inquire: unsupported lon type",-1,-49) .LT. 0) return
2258           endif
2259     
2260           call ncvinq (fid,latId,dimName,dimType,nvDims,vDims,nvAtts,rc)
2261           if ( dimType .eq. NCFLOAT ) then
2262              call ncvgt (fid,latId,start1D,jm,lat_32,rc)
2263              if (err("Inquire: error reading 32-bit lats",rc,-49) .LT. 0) return
2264              do i=1,jm
2265                 lat(i)=lat_32(i)
2266              enddo
2267           else  if ( dimType .eq. NCDOUBLE ) then
2268              call ncvgt (fid,latId,start1D,jm,lat_64,rc)
2269              if (err("Inquire: error reading 32-bit lats",rc,-49) .LT. 0) return
2270              do i=1,jm
2271                 lat(i)=lat_64(i)
2272              enddo
2273           else
2274              if (err("Inquire: unsupported lat type",-1,-49) .LT. 0) return
2275           endif
2276     
2277     
2278           if (.NOT. surfaceOnly) then
2279              call ncvinq (fid,levId,dimName,dimType,nvDims,vDims,nvAtts,rc)
2280              if ( dimType .eq. NCFLOAT ) then
2281                 call ncvgt (fid,levId,start1D,km,levs_32,rc)
2282                 if (err("Inquire: error reading 32-bit levs",rc,-49) .LT. 0) return
2283                 do i=1,km
2284                    levs(i)=levs_32(i)
2285                 enddo
2286              else  if ( dimType .eq. NCDOUBLE ) then
2287                 call ncvgt (fid,levId,start1D,km,levs_64,rc)
2288                 if (err("Inquire: error reading 32-bit levs",rc,-49) .LT. 0) return
2289                 do i=1,km
2290                    levs(i)=levs_64(i)
2291                 enddo
2292              else
2293                 if (err("Inquire: unsupported lev type",-1,-49) .LT. 0) return
2294              endif
2295           end if
2296     
2297           ! Depending on the version of GFIO used to write the file, the Time 
2298           ! dimension variable can either be floating point or integer.
2299           ! Note: LATS4d uses double for coordinate variables.
2300     
2301           call ncvinq (fid,timeId,dimName,timeType,nvDims,vDims,nvAtts,rc)
2302           if (timeType .EQ. NCFLOAT) then
2303             call ncvgt (fid,timeId,start1D,lm,fminutes_32,rc) 
2304             do i=1,lm
2305               minutes(i) = INT (fminutes_32(i))
2306             enddo
2307           else if (timeType .EQ. NCDOUBLE) then
2308             call ncvgt (fid,timeId,start1D,lm,fminutes_64,rc) 
2309             do i=1,lm
2310               minutes(i) = INT (fminutes_64(i))
2311             enddo
2312           else if (timeType .EQ. NCLONG) then
2313             call ncvgt (fid,timeId,start1D,lm,minutes,rc) 
2314           endif
2315           if (err("Inquire: error reading times",rc,-49) .LT. 0) return
2316     
2317     
2318     ! Get dimension attributes.
2319     
2320           if (.NOT. surfaceOnly) then
2321             call ncagtc (fid,levid,'units',levunits,LEN(levunits),rc)
2322             if (err("Inquire: error reading lev units",rc,-50) .LT. 0) 
2323          .      return
2324           endif
2325     
2326     
2327           noTimeInfo = .FALSE.
2328     !ams      call ncagt (fid,timeid,'time_increment',timinc,rc)
2329     !ams      if (rc .NE. 0) then
2330     !ams         print *, 'GFIO_Inquire: Warning. Time increment not found.'
2331     !ams      endif
2332           
2333     !ams      call ncagt (fid,timeid,'begin_date',yyyymmdd_beg,rc)
2334     !ams      if (rc .NE. 0) then
2335     !ams         print *, 'GFIO_Inquire: Warning. begin_date not found.',
2336     !ams     .            ' No time/date information will be returned.'
2337     !ams         noTimeInfo = .TRUE.
2338     !ams      endif
2339     
2340     !ams      call ncagt (fid,timeid,'begin_time',hhmmss_beg,rc)
2341     !ams      if (rc .NE. 0) then
2342     !ams         print *, 'GFIO_Inquire: Warning. begin_time not found.',
2343     !ams     .            ' No time/date information will be returned.'
2344     !ams         noTimeInfo = .TRUE.
2345     !ams      endif
2346     
2347               call GetBegDateTime ( fid, yyyymmdd_beg, hhmmss_beg, incSecs, rc )
2348               if ( rc .ne. 0 ) noTimeInfo = .TRUE.
2349     
2350     !ams          print *, '--- incSecs, begDate, begTime: ', incsecs, yyyymmdd_beg, hhmmss_beg
2351     
2352     ! Calculate and load YYYYMMDD and HHMMSS values.
2353     ! New algorithm for calculating increment time was added.  The new method takes advantage 
2354     ! of information returned by GetBegDateTime, which was added to GFIO by A. da Silva. (RL, Oct2000)
2355     
2356           if (.NOT. noTimeInfo) then
2357             if ( lm .ge. 1 ) then   !ams: changed lm.gt.1 to lm.ge.1
2358                hour = incSecs/3600
2359                if (hour == 0) hour=1
2360                min = mod(incSecs,3600*hour)/60
2361     !_RT       timInc = hour*10000 + min*100
2362                timInc = incSecs/3600*10000 + mod(incSecs,3600)/60*100 + mod(incSecs,60)
2363             end if
2364     !RL     hour = incTime/60
2365     !RL     min  = mod(incTime,60)
2366     !RL     timInc = hour*10000 + min*100
2367     
2368             do i=1,lm
2369     !ams           call GetDate (yyyymmdd_beg,hhmmss_beg,minutes(i)*60,
2370     !ams     .                   yyyymmdd(i),hhmmss(i),rc)
2371     !RL        seconds = (minutes(i) - minutes(1)) * incSecs / incTime
2372                seconds = incSecs * (i-1)
2373                call GetDate (yyyymmdd_beg,hhmmss_beg, seconds,
2374          .                   yyyymmdd(i),hhmmss(i),rc)
2375                if (rc .LT. 0) then
2376                  print *, "GFIO_Inquire: error in getdate"
2377                  rc = -14
2378                  return
2379                endif
2380     !ams           print *, '--- index,   yyyymmdd, hhmmss: ', i, yyyymmdd(i), hhmmss(i)
2381     
2382             enddo
2383           else
2384             timInc = 000100   ! default: 1 minute
2385           endif
2386     
2387     ! Get global attributes for native GFIO files only
2388     
2389           if ( is_gfio ) then
2390     
2391              call ncagtc (fid,NCGLOBAL,'Title',title,LEN(title),rc)
2392              if (rc .NE. 0) then
2393                 print *, 'GFIO_Inquire: Warning. Global attribute Title ',
2394          .           'not found.'
2395              endif
2396              call ncagtc (fid,NCGLOBAL,'Source',source,LEN(source),rc)
2397              if (rc .NE. 0) then
2398                 print *, 'GFIO_Inquire: Warning. Global attribute Title ',
2399          .           'not found.'
2400              endif
2401              call ncagtc (fid,NCGLOBAL,'Contact',contact,LEN(contact),rc)
2402              if (rc .NE. 0) then
2403                 print *, 'GFIO_Inquire: Warning. Global attribute Title ',
2404          .           'not found.'
2405              endif
2406     
2407           else
2408     
2409              Title =   'Unknown'
2410              Source =  'Unknown'
2411              Contact = 'Unknown'
2412     
2413           end if
2414     
2415     ! Get missing value.  GFIO assumes this to be the same for all variables.
2416     ! The check for "missing_value" if "fmissing_value" fails is for backward
2417     ! compatability with files created by the pre-release of GFIO.
2418     
2419           do i= 1, allVars
2420             call ncvinq (fid,i,vnameTemp,varType,nvDims,vDims,nvAtts,rc)
2421             if (err("Inquire: variable inquire error",rc,-52) .NE. 0) return
2422             if (nvDims .EQ. 1) then   ! coord variable
2423               cycle
2424             else                      ! noon-coord variable
2425                if ( is_gfio ) then
2426                   call ncagt (fid, i,'fmissing_value',amiss_32,rc)
2427                else
2428                   rc = -1
2429                end if
2430                if (rc .NE. 0) then
2431                    call ncainq (fid, i, 'missing_value', attType, attLen, rc)
2432                   if (rc.eq.0 .and. attType .EQ. NCFLOAT) then
2433                      call ncagt (fid, allVars, 'missing_value', amiss_32, rc)
2434                      if (rc .ne. 0) call ncagt (fid, 1, 'missing_value', amiss_32, rc)
2435                      if (err("Inquire: error getting missing value",rc,-53) 
2436          .                .NE. 0) return
2437                   else
2438                         print *, 
2439          .              'GFIO_Inquire: Cannot find missing value, assuming 1E+15'
2440                         amiss_32 = 1.0E+15
2441                   end if
2442                endif
2443                exit    ! just check first non-ccordinate variable
2444             endif
2445           end do
2446           amiss = amiss_32
2447     
2448     ! Get variable information.
2449     
2450           do i=1,allVars
2451             call ncvinq (fid,i,vnameTemp,varType,nvDims,vDims,nvAtts,rc)
2452             if (err("Inquire: variable inquire error",rc,-52) .NE. 0) return
2453             if (nvDims .EQ. 1) then
2454               cycle
2455             else
2456               fV = fV + 1
2457               vname(fV) = vnameTemp
2458             endif
2459             if (nvDims .EQ. 3) then
2460               kmvar(fV)=0
2461             else
2462               kmvar(fV)=km
2463             endif
2464             call ncagtc (fid,i,'long_name',vtitle(fV),LEN(vtitle(fV)), rc)
2465             if (err("Inquire: variable attribute error",rc,-53) .NE. 0) 
2466          .     return
2467             call ncagtc (fid,i,'units',vunits(fV),LEN(vunits(fV)),rc)
2468             if (err("Inquire: variable attribute error",rc,-53) .NE. 0) 
2469          .     return
2470             
2471             ! Get packing ranges and valid ranges.  Errors are not fatal 
2472             ! since these attributes are optional.
2473     
2474             call ncagt (fid, i, 'packmin', pRange_32(1,fV), rc)
2475             if (rc .NE. 0) then
2476               packing_range(1,fV) = amiss
2477             else
2478               packing_range(1,fV) = pRange_32(1,fV)
2479             endif
2480             call ncagt (fid, i, 'packmax', pRange_32(2,fV), rc)
2481             if (rc .NE. 0) then
2482               packing_range(2,fV) = amiss
2483             else
2484               packing_range(2,fV) = pRange_32(2,fV)
2485             endif
2486             call ncagt (fid, i, 'vmin', vRange_32(1,fV), rc)
2487             if (rc .NE. 0) then
2488               valid_range(1,fV) = amiss
2489             else
2490               valid_range(1,fV) = vRange_32(1,fV)
2491             endif
2492             call ncagt (fid, i, 'vmax', vRange_32(2,fV), rc)
2493             if (rc .NE. 0) then
2494               valid_range(2,fV) = amiss
2495             else
2496               valid_range(2,fV) = vRange_32(2,fV)
2497             endif
2498              
2499           enddo
2500     
2501           if (fV .NE. nvars) then
2502             rc = -9
2503             nvars = fV
2504             return
2505           endif
2506     
2507           rc=0
2508           call ncpopt(NCVERBOS)  ! back to chatty netcdf
2509     
2510           return
2511           end
2512     
2513     !-------------------------------------------------------------------------
2514     !         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
2515     !-------------------------------------------------------------------------
2516     !BOP
2517     !
2518     ! !ROUTINE:  GFIO_Close -- Closes file
2519     !
2520     ! !DESCRIPTION: This routine is used to close an open GFIO stream.
2521     
2522     ! !INTERFACE:
2523     !
2524           subroutine GFIO_Close ( fid, rc )
2525     !
2526     ! !USES:
2527     !
2528           Implicit NONE
2529           include "netcdf.inc"
2530           include "gfio.h"
2531     !
2532     ! !INPUT PARAMETERS:
2533     !
2534           integer        fid              ! File handle
2535     !
2536     ! !OUTPUT PARAMETERS:
2537     !
2538           integer     rc     ! Error return code:
2539     
2540                              !   rc = 0    all is well
2541                              !
2542                              !  NetCDF Errors
2543                              !  -------------
2544                              !   rc = -54  error from ncclos (file close)
2545     ! !REVISION HISTORY:
2546     !
2547     !  1997.10.13 da Silva/Lucchesi   Initial interface design.
2548     !  1998.03.30  Lucchesi           Documentation expanded.  Clean-up of code.
2549     !                                 Added rc.
2550     !
2551     !EOP
2552     !-------------------------------------------------------------------------
2553     
2554           integer i
2555           integer err
2556     
2557     ! Make NetCDF errors non-fatal, but issue warning messages.
2558     
2559           call ncpopt(NCVERBOS)
2560     
2561           call ncclos (fid, rc)
2562           if (err("Close: error closing file",rc,-54) .NE. 0) return
2563     
2564           rc = 0
2565           return
2566           end
2567     
2568     !-------------------------------------------------------------------------
2569     !         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
2570     !-------------------------------------------------------------------------
2571     !BOP
2572     !
2573     ! !ROUTINE:  GFIO_PutIntAtt -- Write a user-defined integer attribute
2574     !
2575     ! !DESCRIPTION: This routine allows the user to define an integer
2576     !               attribute in an open GFIO file.
2577     !
2578     ! !INTERFACE:
2579     !
2580           subroutine GFIO_PutIntAtt ( fid, name, count, buf, prec, rc )
2581     !
2582     ! !USES:
2583     !
2584           Implicit NONE
2585           include "netcdf.inc"
2586           include "gfio.h"
2587     !
2588     ! !INPUT PARAMETERS:
2589     !
2590           integer        fid        ! File handle
2591           character*(*)  name       ! Name of attribute
2592           integer        count      ! Number of integers to write
2593           integer        buf(count) ! Buffer with integer values
2594           integer        prec       ! Desired precision of attribute value:
2595                                     !   0 = 32 bit
2596                                     !   1 = 64 bit
2597     !
2598     ! !OUTPUT PARAMETERS:
2599     !
2600           integer     rc     ! Error return code:
2601                              !   rc = 0    all is well
2602                              !   rc = -12  error determining default precision
2603                              !
2604                              !  NetCDF Errors
2605                              !  -------------
2606                              !   rc = -36  error from ncaptc/ncapt (global attribute)
2607                              !   rc = -55  error from ncredf (enter define mode)
2608                              !   rc = -56  error from ncedf (exit define mode)
2609     
2610     ! !REVISION HISTORY:
2611     !
2612     !  1998.07.30  Lucchesi           Initial interface design.
2613     !  1998.07.30  Lucchesi           Initial coding.
2614     !  1998.09.24  Lucchesi           Changed error handling.
2615     !  1998.09.28  Lucchesi           Added support for multiple precisions
2616     !
2617     !EOP
2618     !-------------------------------------------------------------------------
2619     
2620           integer*4 dummy32
2621           integer*8 dummy64
2622           integer i
2623     
2624           integer*4, allocatable :: buf32(:)
2625           integer*8, allocatable :: buf64(:)
2626           integer err
2627     
2628           call ncredf ( fid, rc )
2629           if (err("PutIntAtt: could not enter define mode",rc,-55) .NE. 0)
2630          .    return
2631     
2632           if ( HUGE(dummy32) .EQ. HUGE(i) .AND. prec .EQ. 0 ) then     ! -i4
2633             call ncapt ( fid, NCGLOBAL, name, NCLONG, count, buf, rc ) ! 32-bit out
2634     
2635           else if ( HUGE(dummy32) .EQ. HUGE(i) .AND. prec .EQ. 1 ) then  ! -i4
2636             allocate ( buf64(count) )                                    ! 64-bit out
2637             do i=1,count
2638               buf64(i) = buf(i)
2639             enddo
2640             call ncapt ( fid, NCGLOBAL, name, NCDOUBLE, count, buf64, rc )
2641             deallocate (buf64)
2642     
2643           else if  (HUGE(dummy64) .EQ. HUGE(i) .AND. prec .EQ. 0 ) then  ! -i8
2644             allocate ( buf32(count) )                                    ! 32-bit out
2645             do i=1,count
2646               buf32(i) = buf(i)
2647             enddo
2648             call ncapt ( fid, NCGLOBAL, name, NCLONG, count, buf32, rc )
2649             deallocate (buf32)
2650     
2651           else if (HUGE(dummy64) .EQ. HUGE(i) .AND. prec .EQ. 1 ) then   ! -i8
2652             call ncapt ( fid, NCGLOBAL, name, NCDOUBLE, count, buf, rc ) ! 64-bit out
2653     
2654           else 
2655             rc = -12
2656             return
2657           endif
2658           if (err("PutIntAtt: error writing attribute",rc,-36) .NE. 0)
2659          .    return
2660     
2661           call ncendf ( fid, rc )
2662           if (err("PutIntAtt: could not exit define mode",rc,-56) .NE. 0)
2663          .    return
2664     
2665           rc = 0
2666           return
2667           end
2668     
2669     !-------------------------------------------------------------------------
2670     !         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
2671     !-------------------------------------------------------------------------
2672     !BOP
2673     !
2674     ! !ROUTINE:  GFIO_PutRealAtt -- Write a user-defined real attribute
2675     !
2676     ! !DESCRIPTION: This routine allows the user to define a real
2677     !               attribute in an open GFIO file.
2678     !
2679     ! !INTERFACE:
2680     !
2681           subroutine GFIO_PutRealAtt ( fid, name, count, buf, prec, rc )
2682     !
2683     ! !USES:
2684     !
2685           Implicit NONE
2686           include "netcdf.inc"
2687           include "gfio.h"
2688     !
2689     ! !INPUT PARAMETERS:
2690     !
2691           integer        fid        ! File handle
2692           character*(*)  name       ! Name of attribute
2693           integer        count      ! Number of integers to write
2694           real           buf(count) ! Buffer with real values
2695           integer        prec       ! Desired precision of attribute value:
2696                                     !   0 = 32 bit
2697                                     !   1 = 64 bit
2698     !
2699     ! !OUTPUT PARAMETERS:
2700     !
2701           integer     rc     ! Error return code:
2702                              !   rc = 0    all is well
2703                              !   rc = -12  error determining default precision
2704                              !
2705                              !  NetCDF Errors
2706                              !  -------------
2707                              !   rc = -36  error from ncaptc/ncapt (global attribute)
2708                              !   rc = -55  error from ncredf (enter define mode)
2709                              !   rc = -56  error from ncedf (exit define mode)
2710     
2711     ! !REVISION HISTORY:
2712     !
2713     !  1998.07.30  Lucchesi           Initial interface design.
2714     !  1998.07.30  Lucchesi           Initial coding.
2715     !  1998.09.24  Lucchesi           Changed error handling.
2716     !  1998.09.28  Lucchesi           Added support for multiple precisions
2717     !
2718     !EOP
2719     !-------------------------------------------------------------------------
2720     
2721           real*4 dummy32
2722           real*8 dummy64
2723           real r
2724           integer i
2725           real*4, allocatable :: buf32(:)
2726           real*8, allocatable :: buf64(:)
2727           integer err
2728     
2729           call ncredf ( fid, rc )
2730           if (err("PutRealAtt: could not enter define mode",rc,-55) .NE. 0)
2731          .    return
2732     
2733           if (HUGE(dummy32) .EQ. HUGE(r) .AND. prec .EQ. 0) then        ! -r4
2734             call ncapt ( fid, NCGLOBAL, name, NCFLOAT, count, buf, rc ) ! 32-bit out
2735     
2736           else if (HUGE(dummy32) .EQ. HUGE(r) .AND. prec .EQ. 1) then  ! -r4
2737             allocate (buf64(count))                                    ! 64-bit out
2738             do i=1,count
2739               buf64(i) = buf(i)
2740             enddo
2741             call ncapt ( fid, NCGLOBAL, name, NCDOUBLE, count, buf64, rc )
2742             deallocate (buf64)
2743     
2744           else if (HUGE(dummy64) .EQ. huge(r) .AND. prec .EQ. 0) then  ! -r8
2745             allocate (buf32(count))                                    ! 32-bit out
2746             do i=1,count
2747               buf32(i) = buf(i)
2748             enddo
2749             call ncapt ( fid, NCGLOBAL, name, NCFLOAT, count, buf32, rc )
2750             deallocate (buf32)
2751            
2752           else if (HUGE(dummy64) .EQ. huge(r) .AND. prec .EQ. 1) then    ! -r8
2753             call ncapt ( fid, NCGLOBAL, name, NCDOUBLE, count, buf, rc ) ! 64-bit out
2754      
2755           else
2756             rc = -12
2757             return
2758           endif
2759           if (err("PutRealAtt: error writing attribute",rc,-36) .NE. 0)
2760          .    return
2761     
2762           call ncendf ( fid, rc )
2763           if (err("PutRealAtt: could not exit define mode",rc,-56) .NE. 0)
2764          .    return
2765     
2766           rc = 0
2767           return
2768           end
2769     
2770     
2771     !-------------------------------------------------------------------------
2772     !         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
2773     !-------------------------------------------------------------------------
2774     !BOP
2775     !
2776     ! !ROUTINE:  GFIO_PutCharAtt -- Write a user-defined character attribute
2777     !
2778     ! !DESCRIPTION: This routine allows the user to define a character (string)
2779     !               attribute in an open GFIO file.
2780     !
2781     ! !INTERFACE:
2782     !
2783           subroutine GFIO_PutCharAtt ( fid, name, count, buf, rc )
2784     !
2785     ! !USES:
2786     !
2787           Implicit NONE
2788           include "netcdf.inc"
2789           include "gfio.h"
2790     !
2791     ! !INPUT PARAMETERS:
2792     !
2793           integer        fid        ! File handle
2794           character*(*)  name       ! Name of attribute
2795           integer        count      ! Number of characters to write
2796           character      buf(count) ! Buffer containing string
2797     !
2798     ! !OUTPUT PARAMETERS:
2799     !
2800           integer     rc     ! Error return code:
2801                              !   rc = 0    all is well
2802                              !
2803                              !  NetCDF Errors
2804                              !  -------------
2805                              !   rc = -36  error from ncaptc/ncapt (global attribute)
2806                              !   rc = -55  error from ncredf (enter define mode)
2807                              !   rc = -56  error from ncedf (exit define mode)
2808     ! !REVISION HISTORY:
2809     !
2810     !  1998.07.30  Lucchesi           Initial interface design.
2811     !  1998.07.30  Lucchesi           Initial coding.
2812     !  1998.09.24  Lucchesi           Changed error handling.
2813     !
2814     !EOP
2815     !-------------------------------------------------------------------------
2816     
2817           integer err
2818     
2819           call ncredf ( fid, rc )
2820           if (err("PutCharAtt: could not enter define mode",rc,-55) .NE. 0) 
2821          .    return
2822           call ncaptc ( fid, NCGLOBAL, name, NCCHAR, count, buf, rc )
2823           if (err("PutCharAtt: error writing attribute",rc,-36) .NE. 0) 
2824          .    return
2825           call ncendf ( fid, rc )
2826           if (err("PutCharAtt: could not exit define mode",rc,-56) .NE. 0) 
2827          .    return
2828     
2829           rc = 0
2830           return
2831           end
2832     
2833     !-------------------------------------------------------------------------
2834     !         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
2835     !-------------------------------------------------------------------------
2836     !BOP
2837     !
2838     ! !ROUTINE:  GFIO_GetAttNames -- Get global attribute names
2839     !
2840     ! !DESCRIPTION: This routine allows the user to get the names of
2841     !               global attributes.
2842     !
2843     ! !INTERFACE:
2844     !
2845           subroutine GFIO_GetAttNames ( fid, ngatts, aname, rc )
2846     !
2847     ! !USES:
2848     !
2849           Implicit NONE
2850           include "netcdf.inc"
2851           include "gfio.h"
2852     !
2853     ! !INPUT PARAMETERS:
2854     !
2855           integer        fid        ! File handle
2856     !
2857     ! !INPUT/OUTPUT PARAMETERS:
2858     !
2859           integer     ngatts        ! Expected number of attributes (input)
2860                                     ! Actual number of attributes (output if rc=-2)
2861     !
2862     ! !OUTPUT PARAMETERS:
2863     !
2864           character*(*)  aname(ngatts)  ! Array of attribute names
2865           integer   rc       ! Error return code:
2866                              !  rc =  0  all is well
2867                              !  rc = -10  ngatts is incompatible with file
2868                              !  rc = -11  character string not long enough
2869                              !
2870                              !  NetCDF Errors
2871                              !  -------------
2872                              !   rc = -48  error from ncinq
2873                              !   rc = -57  error from ncanam
2874     
2875     ! !REVISION HISTORY:
2876     !
2877     !  1998.08.05  Lucchesi           Initial interface design.
2878     !  1998.08.05  Lucchesi           Initial coding.
2879     !  1998.09.24  Lucchesi           Changed error handling.
2880     !
2881     !EOP
2882     !-------------------------------------------------------------------------
2883     
2884           integer ngattsFile, i
2885           integer nDims,dimSize,recDim 
2886           integer err
2887     
2888     ! Make NetCDF errors non-fatal, but issue warning messages.
2889     
2890           call ncpopt(NCVERBOS)
2891     
2892     ! Check number of attributes against file
2893     
2894           call ncinq (fid,nDims,dimSize,ngattsFile,recdim,rc)
2895           if (err("GetAttNames: ncinq failed",rc,-48) .NE. 0) return
2896           if (ngattsFile .NE. ngatts) then
2897             rc = -10
2898             ngatts = ngattsFile
2899             return
2900           endif
2901     
2902     ! Check length of aname string
2903     
2904           if (LEN(aname(1)) .lt. MAXNCNAM) then
2905             print *,'GFIO_GetAttNames: length of aname array must be at ',
2906          .          'least ',MAXNCNAM,' bytes.'
2907             rc = -11
2908             return
2909           endif
2910     
2911     ! Read global attribute names
2912     
2913           do i=1,ngatts
2914             call ncanam (fid, NCGLOBAL, i, aname(i), rc)
2915             if (err("GetAttNames: error reading attribute name",rc,-57) 
2916          .      .NE. 0) return
2917           enddo
2918     
2919           rc = 0
2920           return
2921           end
2922     
2923     !-------------------------------------------------------------------------
2924     !         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
2925     !-------------------------------------------------------------------------
2926     !BOP
2927     !
2928     ! !ROUTINE:  GFIO_AttInquire -- Get information about an attribute
2929     !
2930     ! !DESCRIPTION: This routine allows the user to get information about
2931     !               a global attribute of an open GFIO file.  This is most
2932     !               useful for determining the number of values stored in an
2933     !               attribute.
2934     !
2935     ! !INTERFACE:
2936     !
2937           subroutine GFIO_AttInquire ( fid, name, type, count, rc )
2938     !
2939     ! !USES:
2940     !
2941           Implicit NONE
2942           include "netcdf.inc"
2943           include "gfio.h"
2944     !
2945     ! !INPUT PARAMETERS:
2946     !
2947           integer        fid        ! File handle
2948           character*(*)  name       ! Name of attribute
2949     !
2950     ! !OUTPUT PARAMETERS:
2951     !
2952           integer type       ! Code for attribute type
2953                              !   0 = integer
2954                              !   1 = real
2955                              !   2 = character
2956                              !   3 = 64-bit real
2957                              !   4 = 64-bit integer
2958                              !  -1 = other
2959           integer count      ! Number of items (length of array)
2960           integer rc         ! Error return code:
2961                              !   rc = 0    all is well
2962                              !
2963                              !  NetCDF Errors
2964                              !  -------------
2965                              !   rc = -58  error from ncainq
2966     
2967     !
2968     ! !NOTES:  The returned integer "type" for 64-bit integer is not supported
2969     !          in the current implementation of netCDF/HDF.  When a user writes a
2970     !          64-bit integer attribute using PutIntAtt, it is actually saved as
2971     !          a 64-bit real by the HDF library.  Thus, upon reading the attribute, 
2972     !          there is no way for HDF/GFIO to distinguish it from a REAL number.  
2973     !          The user must realize this variable is really an integer and call 
2974     !          GetIntAtt to read it.  Even for a 64-bit integer, type=4 will never
2975     !          be returned unless there are changed to HDF/netCDF.
2976     !
2977     !
2978     ! !REVISION HISTORY:
2979     !
2980     !  1998.07.30  Lucchesi           Initial interface design.
2981     !  1998.07.30  Lucchesi           Initial coding.
2982     !  1998.09.24  Lucchesi           Changed error codes, added type assignment.
2983     !
2984     !EOP
2985     !-------------------------------------------------------------------------
2986     
2987           integer nctype
2988           integer err
2989     
2990           call ncainq (fid, NCGLOBAL, name, nctype, count, rc)
2991           if (err("AttInquire: error reading attribute info",rc,-58)
2992          .      .NE. 0) return
2993           if (nctype .EQ. NCLONG) then
2994             type = 0
2995           elseif (nctype .EQ. NCFLOAT) then
2996             type = 1
2997           elseif (nctype .EQ. NCCHAR) then
2998             type = 2
2999           elseif (nctype .EQ. NCDOUBLE) then
3000             type = 3
3001           else
3002             type = -1
3003           endif
3004     
3005           rc = 0
3006           return
3007           end
3008     
3009     !-------------------------------------------------------------------------
3010     !         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
3011     !-------------------------------------------------------------------------
3012     !BOP
3013     !
3014     ! !ROUTINE:  GFIO_GetIntAtt -- Read a user-defined integer attribute
3015     !
3016     ! !DESCRIPTION: This routine allows the user to read an integer 
3017     !               attribute from an open GFIO file.
3018     !
3019     ! !INTERFACE:
3020     !
3021           subroutine GFIO_GetIntAtt ( fid, name, count, buf, rc )
3022     !
3023     ! !USES:
3024     !
3025           Implicit NONE
3026           include "netcdf.inc"
3027           include "gfio.h"
3028     !
3029     ! !INPUT PARAMETERS:
3030     !
3031           integer        fid        ! File handle
3032           character*(*)  name       ! Name of attribute
3033     !
3034     ! !INPUT/OUTPUT PARAMETERS:
3035     !
3036           integer        count      ! On input: Number of items in attribute
3037                                     ! On output: If rc = -1, count will contain
3038                                     !        the correct count of this attribute
3039     !
3040     ! !OUTPUT PARAMETERS:
3041     !
3042           integer   buf(count) ! Buffer with integer values
3043           integer   rc         ! Error return code:
3044                                !   rc = 0    all is well
3045                                !   rc = -1   invalid count
3046                                !   rc = -2   type mismatch
3047                                !   rc = -12  error determining default precision
3048                                !
3049                                !  NetCDF Errors
3050                                !  -------------
3051                                !   rc = -36  error from ncaptc/ncapt (global attribute)
3052                                !   rc = -51  error from ncagtc/ncagt (global attribute)
3053     
3054     ! !REVISION HISTORY:
3055     !
3056     !  1998.07.30  Lucchesi           Initial interface design.
3057     !  1998.07.30  Lucchesi           Initial coding.
3058     !  1998.09.29  Lucchesi           Changed error handling.  Added 64-bit support.
3059     !
3060     !EOP
3061     !-------------------------------------------------------------------------
3062     
3063           integer length, type
3064           integer err, i
3065           integer*4 dummy32
3066           integer*8 dummy64
3067           integer*4, allocatable :: buf32(:)
3068           integer*8, allocatable :: buf64(:)
3069     
3070           call ncainq (fid, NCGLOBAL, name, type, length, rc)
3071           if (err("GetIntAtt: error reading attribute info",rc,-58)
3072          .      .NE. 0) return
3073     
3074           if ( count .NE. length ) then
3075             rc = -1
3076             count = length
3077             return
3078           endif
3079     
3080           if ( type .NE. NCLONG .AND. type .NE. NCDOUBLE) then
3081             rc = -2
3082             return
3083           endif
3084           if ( HUGE(dummy32) .EQ. HUGE(i)) then
3085             if ( type .EQ. NCLONG ) then          ! -i4 32bit
3086               call ncagt ( fid, NCGLOBAL, name, buf, rc )
3087             else            ! type .EQ. NCDOUBLE
3088               allocate (buf64(count))             ! -i4 64bit
3089               call ncagt ( fid, NCGLOBAL, name, buf64, rc )
3090               do i=1,count
3091                 buf(i) = buf64(i)
3092               enddo
3093               deallocate (buf64)
3094             endif
3095           else if (HUGE(dummy64) .EQ. HUGE(i)) then
3096             if ( type .EQ. NCLONG ) then
3097               allocate (buf32(count))             ! -i8 32bit
3098               call ncagt ( fid, NCGLOBAL, name, buf32, rc )
3099               do i=1,count
3100                 buf(i) = buf32(i)
3101               enddo
3102               deallocate (buf32)
3103             else            ! type .EQ. NCDOUBLE
3104               call ncagt ( fid, NCGLOBAL, name, buf, rc )  ! -i8 64bit
3105             endif
3106           else
3107             rc = -12
3108             return
3109           endif
3110           if (err("GetIntAtt: error reading attribute value",rc,-51)
3111          .      .NE. 0) return
3112     
3113           rc = 0
3114           return
3115           end
3116     
3117     !-------------------------------------------------------------------------
3118     !         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
3119     !-------------------------------------------------------------------------
3120     !BOP
3121     !
3122     ! !ROUTINE:  GFIO_GetRealAtt -- Read a user-defined real attribute
3123     !
3124     ! !DESCRIPTION: This routine allows the user to read a real
3125     !               attribute from an open GFIO file.
3126     !
3127     ! !INTERFACE:
3128     !
3129           subroutine GFIO_GetRealAtt ( fid, name, count, buf, rc )
3130     !
3131     ! !USES:
3132     !
3133           Implicit NONE
3134           include "netcdf.inc"
3135           include "gfio.h"
3136     !
3137     ! !INPUT PARAMETERS:
3138     !
3139           integer        fid        ! File handle
3140           character*(*)  name       ! Name of attribute
3141     !
3142     ! !INPUT/OUTPUT PARAMETERS:
3143     !
3144           integer        count      ! On input: Number of items in attribute
3145                                     ! On output: If rc = -1, count will contain
3146                                     !        the correct number of attributes
3147     !
3148     ! !OUTPUT PARAMETERS:
3149     !
3150           real     buf(count)  ! Buffer with real values
3151           integer  rc          ! Error return code:
3152                                !   rc = 0    all is well
3153                                !   rc = -1   invalid count
3154                                !   rc = -2   type mismatch
3155                                !   rc = -12  error determining default precision
3156                                !
3157                                !  NetCDF Errors
3158                                !  -------------
3159                                !   rc = -36  error from ncaptc/ncapt (global attribute)
3160                                !   rc = -51  error from ncagtc/ncagt (global attribute)
3161     
3162     ! !REVISION HISTORY:
3163     !
3164     !  1998.07.30  Lucchesi           Initial interface design.
3165     !  1998.07.30  Lucchesi           Initial coding.
3166     !  1998.09.29  Lucchesi           Changed error handling.  Added 64-bit support.
3167     !  1999.08.23  Lucchesi           Changed .OR. to .AND.
3168     !
3169     !EOP
3170     !-------------------------------------------------------------------------
3171     
3172           integer length, type
3173           integer err
3174           real r
3175           integer i
3176           real*4 dummy32
3177           real*8 dummy64
3178           real*4, allocatable :: buf32(:)
3179           real*8, allocatable :: buf64(:)
3180     
3181           call ncainq (fid, NCGLOBAL, name, type, length, rc)
3182           if (err("GetRealAtt: error reading attribute info",rc,-58)
3183          .      .NE. 0) return
3184     
3185           if ( count .NE. length ) then
3186             rc = -1
3187             count = length
3188             return
3189           endif
3190           if ( type .NE. NCFLOAT .AND. type .NE. NCDOUBLE) then
3191             rc = -2
3192             return
3193           endif
3194     
3195           if ( HUGE(dummy32) .EQ. HUGE(r)) then
3196             if ( type .EQ. NCFLOAT ) then         ! -r4 32bit
3197               call ncagt ( fid, NCGLOBAL, name, buf, rc )
3198             else            ! type .EQ. NCDOUBLE
3199               allocate (buf64(count))             ! -r4 64bit
3200               call ncagt ( fid, NCGLOBAL, name, buf64, rc )
3201               do i=1,count
3202                 buf(i) = buf64(i)
3203               enddo
3204               deallocate (buf64)
3205             endif
3206           else if (HUGE(dummy64) .EQ. HUGE(r)) then
3207             if ( type .EQ. NCFLOAT ) then
3208               allocate (buf32(count))             ! -r8 32bit
3209               call ncagt ( fid, NCGLOBAL, name, buf32, rc )
3210               do i=1,count
3211                 buf(i) = buf32(i)
3212               enddo
3213               deallocate (buf32)
3214             else            ! type .EQ. NCDOUBLE
3215               call ncagt ( fid, NCGLOBAL, name, buf, rc )  ! -r8 64bit
3216             endif
3217           else
3218             rc = -12
3219             return
3220           endif
3221           if (err("GetRealAtt: error reading attribute value",rc,-51)
3222          .      .NE. 0) return
3223     
3224           rc = 0
3225           return
3226           end
3227     
3228     !-------------------------------------------------------------------------
3229     !         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
3230     !-------------------------------------------------------------------------
3231     !BOP
3232     !
3233     ! !ROUTINE:  GFIO_GetCharAtt -- Read a user-defined character attribute
3234     !
3235     ! !DESCRIPTION: This routine allows the user to read a character
3236     !               attribute from an open GFIO file.
3237     !
3238     ! !INTERFACE:
3239     !
3240           subroutine GFIO_GetCharAtt ( fid, name, count, buf, rc )
3241     !
3242     ! !USES:
3243     !
3244           Implicit NONE
3245           include "netcdf.inc"
3246           include "gfio.h"
3247     !
3248     ! !INPUT PARAMETERS:
3249     !
3250           integer        fid        ! File handle
3251           character*(*)  name       ! Name of attribute
3252     !
3253     ! !INPUT/OUTPUT PARAMETERS:
3254     !
3255           integer        count      ! On input: Number of items in attribute
3256                                     ! On output: If rc = -1, count will contain
3257                                     !        the correct number of attributes
3258     !
3259     ! !OUTPUT PARAMETERS:
3260     !
3261           character buf(count) ! Buffer with character values
3262           integer   rc         ! Error return code:
3263                                !   rc = 0    all is well
3264                                !   rc = -1   invalid count
3265                                !   rc = -2   type mismatch
3266                                !
3267                                !  NetCDF Errors
3268                                !  -------------
3269                                !   rc = -36  error from ncaptc/ncapt (global attribute)
3270                                !   rc = -51  error from ncagtc/ncagt (global attribute)
3271     ! !REVISION HISTORY:
3272     !
3273     !  1998.07.30  Lucchesi           Initial interface design.
3274     !  1998.07.30  Lucchesi           Initial coding.
3275     !  1998.09.29  Lucchesi           Changed error handling.
3276     !
3277     !EOP
3278     !-------------------------------------------------------------------------
3279     
3280           integer length, type
3281           integer err
3282     
3283           call ncainq (fid, NCGLOBAL, name, type, length, rc)
3284           if (err("GetCharAtt: error reading attribute info",rc,-58)
3285          .      .NE. 0) return
3286           if ( count .NE. length ) then
3287             rc = -1
3288             count = length
3289             return
3290           endif
3291           if ( type .NE. NCCHAR) then
3292             rc = -2
3293             return
3294           endif
3295     
3296           call ncagtc ( fid, NCGLOBAL, name, buf, count, rc )
3297           if (err("GetCharAtt: error reading attribute value",rc,-51)
3298          .      .NE. 0) return
3299     
3300           rc = 0
3301           return
3302           end
3303