File: C:\NOAA\NEMS_11731\src\chem\gocart\src\GMAO_Shared\MAPL_cfio\ESMF_CFIOSdfMod.F90

1     !==============================================================================
2     !BOP
3     ! !MODULE: ESMF_CFIOSdfMod.F90 - Source file for CFIO
4     
5            module ESMF_CFIOSdfMod
6     !
7     ! !DESCRIPTION:
8     !
9     ! The code in this file provides data type definitions and interface 
10     ! specifications
11     !
12     ! This module provides all the necessary subroutines for users to write/read
13     ! HDF format output using CF convention.
14     !
15     ! !REVISION HISTORY:
16     !
17     !  Feb2007  Baoyu Yin  Modified from ESMF_CFIOSdfMod.F90. This is the SDF
18     !                      module for CFIO.
19     !------------------------------------------------------------------------------
20     ! !USES:
21           use ESMF_CFIOUtilMod
22           use ESMF_CFIOGridMod
23           use ESMF_CFIOVarInfoMod
24           use ESMF_CFIOFileMod
25           use ESMF_CFIOwGrADSMod, only : CFIO_wGrADS
26           use ESMF_CFIOrGrADSMod, only : CFIO_rGrADS
27           implicit none
28     !------------------------------------------------------------------------------
29     ! !PRIVATE TYPES:
30           private
31     !------------------------------------------------------------------------------
32     ! !PUBLIC MEMBER FUNCTIONS:
33     
34           public :: ESMF_CFIOSdfFileCreate      ! Create a CFIO file for writing 
35           public :: ESMF_CFIOSdfFileOpen        ! Open a CFIO file 
36           public :: ESMF_CFIOSdfVarWrite        ! Write a variable to a file 
37           public :: ESMF_CFIOSdfVarRead         ! Read a variable from a file
38           public :: ESMF_CFIOSdfVarReadT        ! Read a variable from two files 
39                                              ! with time interpolation
40           public :: ESMF_CFIOSdfFileClose       ! Close an existing CFIO file. 
41     
42           interface ESMF_CFIOSdfVarWrite; module procedure   &
43             ESMF_CFIOSdfVarWrite3D_,  &
44             ESMF_CFIOSdfVarWrite2D_,  &
45             ESMF_CFIOSdfVarWrite1D_
46           end interface
47                                                                                                      
48           interface ESMF_CFIOSdfVarRead; module procedure   &
49             ESMF_CFIOSdfVarRead3D_,  &
50             ESMF_CFIOSdfVarRead2D_,  &
51             ESMF_CFIOSdfVarRead1D_
52           end interface
53     
54           interface ESMF_CFIOSdfVarReadT; module procedure   &
55             ESMF_CFIOSdfVarReadT3D_,  &
56             ESMF_CFIOSdfVarReadT2D_,  &
57             ESMF_CFIOSdfVarReadT3D__, &
58             ESMF_CFIOSdfVarReadT2D__
59           end interface
60     
61     !
62     !EOP
63     !------------------------------------------------------------------------------
64     
65           contains
66     
67     !------------------------------------------------------------------------------
68     !BOP
69     ! !ROUTINE: ESMF_CFIOSdfFileCreate -- Create a CFIO output file with meta data
70     
71     ! !INTERFACE:
72           subroutine ESMF_CFIOSdfFileCreate (cfio, rc, expid)
73     !
74     ! !ARGUMENTS:
75     !
76     ! !INPUT PARAMETERS:
77     !
78           type(ESMF_CFIO), intent(inout) :: cfio       ! a CFIO object
79           character(len=*), intent(in), OPTIONAL  :: expid    ! Experiment ID
80     !
81     ! !OUTPUT PARAMETERS:
82     !
83           integer, intent(out), OPTIONAL :: rc      ! Error return code:
84                           ! 0   all is well
85                           ! -1 Time increment is 0
86                           ! -2  allocate memory error
87                           ! -3  Num of int/char/real elements and Cnt don't match
88                           ! -12  error determining default precision
89                           ! -18 incorrect time increment
90                           ! -30 can't open file
91                           ! -31 error from ncddef
92                           ! -32 error from ncvdef (dimension variable)
93                           ! -33 error from ncapt(c) (dimension attribute)
94                           ! -34 error from ncvdef (variable)
95                           ! -35  error from ncapt(c) (variable attribute)
96                           ! -36  error from ncaptc/ncapt (global attribute)
97                           ! -37  error from ncendf
98                           ! -38  error from ncvpt (dimension variable)
99                           ! -39 Num of real var elements and Cnt differ
100                           ! -55  error from ncredf (enter define mode)
101                           ! -56  error from ncedf (exit define mode)
102     !
103     ! !DESCRIPTION:
104     !     Create a CFIO output file with meta data
105     !EOP
106     !------------------------------------------------------------------------------
107            integer :: i, n, rtcode
108            integer :: maxLen
109            character(len=MLEN) :: fNameTmp     ! file name 
110            integer :: date, begTime
111            character(len=MLEN) :: fName
112     
113            call ESMF_CFIOGet(cfio, date=date, begTime=begTime, fName=fName, rc=rtcode)
114            if (rtcode .ne. 0) print *, "Problems in ESMF_CFIOGet"
115     !      checking file name template
116            if (present(expid)) then 
117               call ESMF_CFIOSet(cfio, expid=expid)
118               call strTemplate_(fNameTmp,fName,xid=expid,nymd=date, &
119                                 nhms=begTime, stat=rtcode)
120            else
121               call strTemplate_(fNameTmp,fName,nymd=date, nhms=begTime, stat=rtcode)
122            end if
123     
124            if (trim(fNameTmp) .ne. trim(fName)) then
125               call ESMF_CFIOSet(cfio, fNameTmplt=fName, fName=fNameTmp)
126            end if
127     
128            call CFIO_Create_(cfio, rtcode)
129            if (err("Error form CFIO_Create_",rtcode,rtcode) .lt. 0) then  
130               if ( present(rc) ) rc = rtcode
131               return
132            end if
133     
134     !      put global attributes
135            call CFIO_PutCharAtt(cfio%fid, 'History', len(trim(cfio%history)),    &
136                                  cfio%history, rtcode )
137            if (err("can't write History",rtcode,rtcode) .lt. 0) then  
138               if ( present(rc) ) rc = rtcode
139               return
140            end if
141     
142            call CFIO_PutCharAtt(cfio%fid, 'Source', len(trim(cfio%source)),      &
143                                  cfio%source, rtcode )
144            if (err("can't write Source",rtcode,rtcode) .lt. 0) then  
145               if ( present(rc) ) rc = rtcode
146               return
147            end if
148     
149            call CFIO_PutCharAtt(cfio%fid, 'Title', len(trim(cfio%title)),        &
150                                  cfio%title, rtcode )
151            if (err("can't write Title",rtcode,rtcode) .lt. 0) then  
152               if ( present(rc) ) rc = rtcode
153               return
154            end if
155     
156            call CFIO_PutCharAtt(cfio%fid, 'Contact', len(trim(cfio%contact)),    &
157                                  cfio%contact, rtcode )
158            if (err("can't write Contact",rtcode,rtcode) .lt. 0) then  
159               if ( present(rc) ) rc = rtcode
160               return
161            end if
162     
163            call CFIO_PutCharAtt(cfio%fid,'Conventions',len(trim(cfio%convention))&
164                                  ,cfio%convention, rtcode )
165            if (err("can't write Conventions",rtcode,rtcode) .lt. 0) then  
166               if ( present(rc) ) rc = rtcode
167               return
168            end if
169     
170            call CFIO_PutCharAtt(cfio%fid,'Institution',                          &
171                                 len(trim(cfio%institution)),                     &
172                                 cfio%institution, rtcode )
173            if (err("can't write Institution",rtcode,rtcode) .lt. 0) then  
174               if ( present(rc) ) rc = rtcode
175               return
176            end if
177     
178            call CFIO_PutCharAtt(cfio%fid,'References',len(trim(cfio%references)),&
179                                  cfio%references, rtcode )
180            if (err("can't write References",rtcode,rtcode) .lt. 0) then  
181               if ( present(rc) ) rc = rtcode
182               return
183            end if
184     
185            call CFIO_PutCharAtt(cfio%fid,'Comment',len(trim(cfio%comment)),      &
186                                  cfio%comment, rtcode )
187            if (err("can't write Comment",rtcode,rtcode) .lt. 0) then  
188               if ( present(rc) ) rc = rtcode
189               return
190            end if
191     
192     
193     !      get integer attributes from iList
194            if ( associated(cfio%iList) ) then
195               call getMaxLenCnt(maxLen, cfio%nAttInt, iList=cfio%iList)
196               allocate(cfio%attIntNames(cfio%nAttInt),                           &
197                        cfio%attIntCnts(cfio%nAttInt),                            &
198                        cfio%attInts(cfio%nAttInt,maxLen), stat=rtcode)
199               if (err("can't allocate mem: attIntCnts",rtcode,-2) .lt. 0) then  
200                  if ( present(rc) ) rc = rtcode
201                  return
202               end if
203     
204               call getList(iList=cfio%iList, intAttNames=cfio%attIntNames,       &
205                            intAttCnts=cfio%attIntCnts, intAtts=cfio%attInts )
206            end if
207     
208     !      write user defined integer attributes
209            if ( cfio%nAttInt .gt. 0 ) then
210               do i = 1, cfio%nAttInt
211                  if ( cfio%attIntCnts(i) .gt. size(cfio%attInts(i,:)) )  then
212                     rtcode=err("FileCreate: Num of int elements and Cnt differ"  &
213                                 ,-3,-3)
214                     if ( present(rc) ) rc = rtcode
215                     return
216                  end if
217     
218                  call CFIO_PutIntAtt(cfio%fid, cfio%attIntNames(i),              &
219                                      cfio%attIntCnts(i), cfio%attInts(i,:),      &
220                                      cfio%prec, rtcode )
221                  if (err("error in CFIO_PutIntAtt",rtcode,rtcode) .lt. 0) then
222                     if ( present(rc) ) rc = rtcode
223                     return
224                  end if
225     
226               end do
227            end if
228     
229     !      get real attributes from rList
230            if ( associated(cfio%rList) ) then
231               call getMaxLenCnt(maxLen, cfio%nAttReal, rList=cfio%rList)
232               allocate(cfio%attRealNames(cfio%nAttReal),                       &
233                        cfio%attRealCnts(cfio%nAttReal),                        &
234                        cfio%attReals(cfio%nAttReal,maxLen), stat=rtcode)
235               if (err("can't allocate mem: attRealNames",rtcode,-2) .lt. 0) then  
236                  if ( present(rc) ) rc = rtcode
237                  return
238               end if
239     
240               call getList(rList=cfio%rList, realAttNames=cfio%attRealNames,   &
241                            realAttCnts=cfio%attRealCnts, realAtts=cfio%attReals )
242               do i = 1, cfio%nAttReal
243               end do
244            end if
245     
246     !      write user defined real attributes
247            if ( cfio%nAttReal .gt. 0 ) then
248               do i = 1, cfio%nAttReal
249                  if ( cfio%attRealCnts(i) .gt. size(cfio%attReals(i,:)) )  then
250                     rtcode=err("FileCreate: Num of real elements and Cnt differ" &
251                                 ,-3,-3)
252                     if ( present(rc) ) rc = rtcode
253                     return
254                  end if
255                  call CFIO_PutRealAtt(cfio%fid, cfio%attRealNames(i),            &
256                                      cfio%attRealCnts(i),                        &
257                                      cfio%attReals(i,1:cfio%attRealCnts(i)),     &
258                                      cfio%prec, rtcode )
259                  if (err("error in CFIO_PutRealAtt",rtcode,rtcode) .lt. 0) then
260                     if ( present(rc) ) rc = rtcode
261                     return
262                  end if
263               end do
264            end if
265     
266     !      get char attributes from cList
267            if ( associated(cfio%cList) ) then
268               call getMaxLenCnt(maxLen, cfio%nAttChar, cList=cfio%cList)
269               allocate(cfio%attCharNames(cfio%nAttChar),                      &
270                        cfio%attCharCnts(cfio%nAttChar),                       &
271                        cfio%attChars(cfio%nAttChar), stat=rtcode)
272               if (err("can't allocate mem: attCharNames",rtcode,-2) .lt. 0) then  
273                  if ( present(rc) ) rc = rtcode
274                  return
275               end if
276               call getList(cList=cfio%cList, charAttNames=cfio%attCharNames,  &
277                            charAttCnts=cfio%attCharCnts, charAtts=cfio%attChars )
278            end if
279     
280     !      write user defined char attributes
281            if ( cfio%nAttChar .gt. 0 ) then
282               do i = 1, cfio%nAttChar
283                  call CFIO_PutCharAtt(cfio%fid, cfio%attCharNames(i),       &
284                                      cfio%attCharCnts(i), cfio%attChars(i), &
285                                      rtcode )
286                  if (err("error in CFIO_PutCharAtt",rtcode,rtcode) .lt. 0) then
287                     if ( present(rc) ) rc = rtcode
288                     return
289                  end if
290               end do
291            end if
292     
293            cfio%isOpen = .true.
294      
295            rtcode = 0
296            if ( present(rc) ) rc = rtcode
297     
298           end subroutine ESMF_CFIOSdfFileCreate
299     
300     !------------------------------------------------------------------------------
301     !BOP
302     ! !ROUTINE: ESMF_CFIOSdfFileOpen -- open a CFIO file, and get CFIO meta data
303     !                                into a cfio Object.
304     
305     ! !INTERFACE:
306           subroutine ESMF_CFIOSdfFileOpen (cfio, fmode, rc, expid, cyclic)
307     
308     !
309     ! !ARGUMENTS:
310     !
311     ! !INPUT PARAMETERS:
312     !
313           integer, intent(in) :: fmode              ! 0 for READ-WRITE
314                                                     ! non-zero for READ-ONLY
315           character(len=*), intent(in), OPTIONAL :: expid   ! Experiment ID
316           logical, intent(in), OPTIONAL :: cyclic           ! cyclic input file
317     !
318     ! !OUTPUT PARAMETERS:
319     !
320           integer, intent(out), OPTIONAL :: rc      ! Error return code:
321                                                     ! 0   all is well
322                              ! -1   invalid count
323                              ! -2   type mismatch
324                              ! -12  error determining default precision
325                              ! -10  ngatts is incompatible with file
326                              ! -11  character string not long enough
327                              ! -19  unable to identify coordinate variable
328                              ! -36  error from ncaptc/ncapt (global attribute)
329                              ! -39  error from ncopn (file open)
330                              ! -40  error from ncvid
331                              ! -41  error from ncdid or ncdinq (lat or lon)
332                              ! -42  error from ncdid or ncdinq (lev)
333                              ! -43  error from ncvid (time variable)
334                              ! -47  error from ncdid or ncdinq (time)
335                              ! -48  error from ncinq
336                              ! -51  error from ncagtc/ncagt (global attribute)
337                              ! -52  error from ncvinq
338                              ! -53  error from ncagtc/ncagt
339                              ! -57  error from ncanam
340                              ! -58  error from ncainq
341     
342     !
343     ! !INPUT/OUTPUT PARAMETERS:
344     !
345           type(ESMF_CFIO), intent(inout) :: cfio    ! a CFIO object
346     !
347     ! !DESCRIPTION:
348     !     open a CFIO file, and get CFIO meta data into a cfio Object.
349     !EOP
350     !------------------------------------------------------------------------------
351           integer :: ngatts, lm, i, ii, iv
352           integer :: fileNameLen
353           real*4 :: amiss
354           real*4 :: vRange32(2)
355           real*4, pointer :: lon(:), lat(:), lev(:)
356           real*8, pointer :: lon_64(:), lat_64(:), lev_64(:)
357           integer :: coXType = NCFLOAT
358           integer :: coYType = NCFLOAT
359           integer :: coZType = NCFLOAT
360           character(len=MVARLEN) :: levunits
361           character(len=MVARLEN) :: vAttName
362           character(len=MVARLEN), pointer :: vname(:) 
363           character(len=MLEN), pointer :: vtitle(:) 
364           character(len=MVARLEN), pointer :: vunits(:) 
365           integer, pointer :: kmvar(:)
366           real, pointer :: valid_range(:,:), packing_range(:,:) 
367           integer, pointer :: yyyymmdd(:), hhmmss(:)
368           character(len=MLEN), pointer :: attNames(:)
369           integer :: iCnt, rCnt, cCnt
370           integer :: iMaxLen, rMaxLen, cMaxLen
371           integer :: type, count, rtcode
372           integer :: dimId
373           integer :: varId
374           integer :: datatype         ! variable type
375           integer :: vtype            ! variable type
376           integer :: nvDims           ! number of dimensions
377           integer :: vDims(MAXVDIMS)  ! variable shape
378           integer :: nvatts           ! number of attributes
379           real*4, pointer :: rtmp(:)
380           integer, pointer :: itmp(:)
381           character(len=MVARLEN), pointer :: ctmp(:)
382           logical :: esmf_file = .false.
383           logical :: tmpLog
384           logical :: new_grid
385           integer :: nDims, allVars, recdim
386           integer :: im, jm, km
387           integer :: hour, min 
388           integer :: fid, nVars, dimSize(4), myIndex
389           character(len=MVARLEN) :: dimName(4), dimUnits(4), vnameTemp
390           character(len=MVARLEN) :: nameAk, nameBk, namePtop
391           integer :: loc1, loc2
392           integer :: akid, bkid, ptopid
393           integer :: icount
394           real*4, pointer :: ak(:), bk(:)
395           real*4 :: ptop
396           real*4 :: scale, offset
397           character, pointer ::  globalAtt(:)
398           character(len=MLEN) :: fNameTmp     ! file name
399           character(len=MVARLEN),dimension(:),pointer :: grads_vars
400       
401           call ncpopt(0)
402     
403           fNameTmp = ''                                                                                   
404     !     checking file name template
405           if (present(expid)) cfio%expid = expid
406           if (present(cyclic)) cfio%isCyclic = cyclic
407           if (present(expid) .and. cfio%date .gt. 0 .and. cfio%begTime .ge. 0) then
408              call strTemplate_(fNameTmp,cfio%fName,xid=expid,nymd=cfio%date, &
409                                nhms=cfio%begTime, stat=rtcode)
410           else
411              if (cfio%date .gt. 0 .and. cfio%begTime .ge. 0) then
412                 call strTemplate_(fNameTmp,cfio%fName,nymd=cfio%date, &
413                                   nhms=cfio%begTime, stat=rtcode)
414              else   
415                 if (present(expid)) then
416                    call strTemplate_(fNameTmp,cfio%fName,xid=expid, stat=rtcode)
417                 end if
418              end if
419           end if
420           if (trim(fNameTmp) .ne. trim(cfio%fName) .and. len(trim(fNameTmp)) .gt. 0) then
421              cfio%fNameTmplt = cfio%fName
422              cfio%fName = fNameTmp
423           end if
424     
425     !     open a cfio file
426           call CFIO_Open ( cfio%fName, fmode, cfio%fid, rtcode )
427           if (err("problem in CFIO_Open",rtcode,rtcode) .lt. 0 ) then
428              if ( present(rc) ) rc = rtcode
429              return
430           end if
431           cfio%isOpen = .true.
432           if (fmode == 0) then
433              rc = 0
434              return
435           endif
436           fid =cfio%fid
437     
438     !     get grid information and global meta data
439                                                                                               
440           call CFIO_DimInquire (cfio%fid, im, jm, km, lm, &
441                                 cfio%mVars, ngatts, rtcode)
442           if (err("CFIO_DimInquire failed",rtcode,rtcode) .lt. 0) then  
443              if ( present(rc) ) rc = rtcode
444              return
445           end if
446           cfio%tSteps = lm
447     
448           call ncinq (cfio%fid,nDims,allVars,ngatts,recdim,rtcode)
449           if (err("FileOpen: ncinq failed",rtcode,-48) .NE. 0) then  
450              if ( present(rc) ) rc = rtcode
451              return
452           end if
453     
454           allocate(cfio%varObjs(cfio%mVars))
455           nVars = 0
456           cfio%mGrids = 0
457           do i=1,allVars
458             call ncvinq (fid,i,vnameTemp,vtype,nvDims,vDims,nvAtts,rtcode)
459             if (err("Inquire: variable inquire error",rtcode,-52) .NE. 0) then  
460                if ( present(rc) ) rc = rtcode
461                return
462             end if
463             if (nvDims .EQ. 1 .and. (index(vnameTemp, 'lon') .gt. 0 .or.  &
464                 index(vnameTemp, 'XDim:EOSGRID') .gt. 0) ) then
465                coXType = vtype
466                cfio%mGrids = cfio%mGrids + 1
467             end if
468             if (nvDims .EQ. 1 .and. (index(vnameTemp, 'lat') .gt. 0 .or.  &
469                 index(vnameTemp, 'YDim:EOSGRID') .gt. 0) ) then
470                coYType = vtype
471             end if
472             if (nvDims .EQ. 1 .and. (index(vnameTemp, 'lev') .gt. 0 .or.  &
473                 index(vnameTemp, 'Height:EOSGRID') .gt. 0) ) then
474                coZType = vtype
475             end if
476     
477             cfio%varObjs(nVars+1)%timAve = .false.
478             if (trim(vnameTemp) .eq. 'time_bnds') then 
479                cfio%varObjs(nVars)%timAve = .true.
480                cycle
481             end if
482             if (nvDims .EQ. 1) cycle
483             nVars = nVars + 1
484             cfio%varObjs(nVars)%vName = trim(vnameTemp)
485             cfio%varObjs(nVars)%grid%km = 0
486     !        cfio%varObjs(nVars)%grid%km = 1
487             cfio%varObjs(nVars)%grid%stnGrid = .false.
488             do iv = 1, nvDims
489                call ncdinq(fid, vDims(iv), dimName(iv), dimSize(iv), rtcode)
490                if (err("problem in ncdinq",rtcode,-41) .NE. 0) then  
491                   if ( present(rc) ) rc = rtcode
492                   return
493                end if
494                if (index(dimName(iv),'station') .gt. 0) then
495                   cfio%varObjs(nVars)%grid%im = dimSize(iv)
496                   cfio%varObjs(nVars)%grid%jm = dimSize(iv)
497                   cfio%varObjs(nVars)%grid%stnGrid = .true.
498                   cycle
499                end if
500                varId = ncvid (fid, dimName(iv), rtcode)
501                dimUnits(iv) = ' '
502                call ncagtc(fid,varId,'units',dimUnits(iv),MAXCHR,rtcode)
503                if (err("problem in ncagtc",rtcode,-53) .NE. 0) then  
504                   if ( present(rc) ) rc = rtcode
505                   return
506                end if
507                myIndex = IdentifyDim (dimName(iv), dimUnits(iv))
508                if (myIndex .EQ. 0) then
509                   cfio%varObjs(nVars)%grid%im = dimSize(iv)
510                   allocate(cfio%varObjs(nVars)%grid%lon(dimSize(iv)), &
511                            lon(dimSize(iv)))
512     !              call ncvgt (fid, vDims(iv), 1, dimSize(iv), lon, rtcode)
513                   if ( coXType .eq. NCFLOAT ) then
514                      call ncvgt (fid, varId, 1, dimSize(iv), lon, rtcode)
515                   else
516                      allocate(lon_64(dimSize(iv)))
517                      call ncvgt (fid, varId, 1, dimSize(iv), lon_64, rtcode)
518                      lon =lon_64
519                      deallocate(lon_64)
520                   end if
521                   if (err("problem in ncvgt",rtcode,-53) .NE. 0) then  
522                      if ( present(rc) ) rc = rtcode
523                      return
524                   end if
525                   cfio%varObjs(nVars)%grid%lon = lon
526                   deallocate(lon)
527                end if
528                if (myIndex .EQ. 1) then
529                   cfio%varObjs(nVars)%grid%jm = dimSize(iv)
530                   allocate(cfio%varObjs(nVars)%grid%lat(dimSize(iv)), &
531                            lat(dimSize(iv)))
532                   if ( coYType .eq. NCFLOAT ) then
533                      call ncvgt (fid, varId, 1, dimSize(iv), lat, rtcode)
534                   else
535                      allocate(lat_64(dimSize(iv)))
536                      call ncvgt (fid, varId, 1, dimSize(iv), lat_64, rtcode)
537                      lat = lat_64
538                      deallocate(lat_64)
539                   end if
540     !              call ncvgt (fid, vDims(iv), 1, dimSize(iv), lat, rtcode)
541     !print *, "vDims(iv) varId: ", vDims(iv), varId
542     !print *, "dimName dimUnits: ", trim(dimName(iv)), trim(dimUnits(iv))
543                   if (err("problem in ncvgt",rtcode,-51) .NE. 0) then  
544                      if ( present(rc) ) rc = rtcode
545                      return
546                   end if
547                   cfio%varObjs(nVars)%grid%lat = lat
548                   deallocate(lat)
549                end if
550                if (myIndex .EQ. 2) then
551                   cfio%varObjs(nVars)%grid%km = dimSize(iv)
552                   call ncpopt(0)
553                   call ncagtc(fid,varId,'standard_name',                   &
554                               cfio%varObjs(nVars)%grid%standardName,           &
555                               MAXCHR, rtcode)
556                   if (rtcode /= 0) cfio%varObjs(nVars)%grid%standardName="pressure"
557                   if ( index(cfio%varObjs(nVars)%grid%standardName,        &
558                        'atmosphere_sigma_coordinate') .gt. 0  .or.         &
559                        index(cfio%varObjs(nVars)%grid%standardName,        &
560                        'atmosphere_hybrid_sigma_pressure_coordinate' )     &
561                        .gt.  0 ) then
562     
563                      call ncagtc(fid,varId,'formula_term',                 &
564                               cfio%varObjs(nVars)%grid%formulaTerm,            &
565                               MAXCHR, rtcode)
566                      if ( index(cfio%varObjs(nVars)%grid%standardName,     &
567                        'atmosphere_sigma_coordinate') .gt. 0 ) then
568                         loc1 = index(cfio%varObjs(nVars)%grid%formulaTerm,'ptop:')
569                         icount = loc1  + 5
570                         do icount = loc1+5, len(cfio%varObjs(nVars)%grid%formulaTerm)
571                           if (cfio%varObjs(nVars)%grid%formulaTerm(icount:icount) &
572                                .ne. ' ') exit
573                         end do
574                         namePtop=trim(cfio%varObjs(nVars)%grid%formulaTerm    &
575                              (icount:len(cfio%varObjs(nVars)%grid%formulaTerm)))
576                         ptopid = ncvid(cfio%fid, trim(namePtop), rtcode)
577                         if (rtcode .ne. 0) print *, "problem in getting ptopid in ncvid"
578                         if (rtcode .eq. 0) call ncvgt(cfio%fid,ptopid,1, 1, ptop, rtcode)
579                         if (rtcode .eq. 0) cfio%varObjs(nVars)%grid%ptop = ptop
580                      end if
581                   end if
582                   if (index(cfio%varObjs(nVars)%grid%standardName,             &
583                             'atmosphere_hybrid_sigma_pressure_coordinate')     &
584                             .gt. 0)  then
585                      loc1 = index(cfio%varObjs(nVars)%grid%formulaTerm,'a:')
586                      loc2 = index(cfio%varObjs(nVars)%grid%formulaTerm,'b:')
587                      icount = 0
588                      do icount = loc1+2, loc2
589                        if (cfio%varObjs(nVars)%grid%formulaTerm(icount:icount) &
590                             .ne. ' ') exit
591                      end do
592                      nameAk=trim(cfio%varObjs(nVars)%grid%formulaTerm          &
593                                  (icount:loc2-1))
594                      loc1 = index(cfio%varObjs(nVars)%grid%formulaTerm,'b:')
595                      loc2 = index(cfio%varObjs(nVars)%grid%formulaTerm,'ps:')
596                      do icount = loc1+2, loc2
597                        if (cfio%varObjs(nVars)%grid%formulaTerm(icount:icount) &
598                             .ne. ' ') exit
599                      end do
600                      nameBk=trim(cfio%varObjs(nVars)%grid%formulaTerm          &
601                                  (icount:loc2-1))
602                      loc1 = index(cfio%varObjs(nVars)%grid%formulaTerm,'p0:')
603                      icount = loc1  + 4
604                      namePtop=trim(cfio%varObjs(nVars)%grid%formulaTerm        &
605                              (icount:len(cfio%varObjs(nVars)%grid%formulaTerm)))
606     
607                      akid = ncvid(cfio%fid, trim(nameAk), rtcode)
608                      if (rtcode .ne. 0) print *, "problem in getting akid in ncvid"
609     
610                      allocate(cfio%varObjs(nVars)%grid%ak                      &
611                               (cfio%varObjs(nVars)%grid%km+1),                 &
612                               ak(cfio%varObjs(nVars)%grid%km+1))
613                      call ncvgt(cfio%fid,akid,1,cfio%varObjs(nVars)%grid%km+1, &
614                                 ak, rtcode)
615                      if (rtcode .ne. 0) print *, "problem in getting ak in ncvgt"
616                      cfio%varObjs(nVars)%grid%ak = ak
617                      deallocate(ak)
618                      bkid = ncvid(cfio%fid, trim(nameBk), rtcode)
619                      if (rtcode .ne. 0) print *, "problem in getting bkid in ncvid"
620                      allocate(cfio%varObjs(nVars)%grid%bk                      &
621                               (cfio%varObjs(nVars)%grid%km+1),                 &
622                               bk(cfio%varObjs(nVars)%grid%km+1))
623                      call ncvgt(cfio%fid,bkid,1,cfio%varObjs(nVars)%grid%km+1, &
624                                 bk, rtcode)
625                      if (rtcode .ne. 0) print *, "problem in getting bk in ncvgt"
626                      cfio%varObjs(nVars)%grid%bk = bk
627                      deallocate(bk)
628     
629                      ptopid = ncvid(cfio%fid, trim(namePtop), rtcode)
630                      if (rtcode .ne. 0) print *, "problem in getting ptopid in ncvid"
631                      call ncvgt(cfio%fid,ptopid,1, 1, ptop, rtcode)
632                      if (rtcode .ne. 0) print *, "problem in getting ptop in ncvgt"
633                      cfio%varObjs(nVars)%grid%ptop = ptop
634                  end if
635                   call ncpopt(0)
636                   call ncagtc(fid,varId,'coordinate',                      &
637                               cfio%varObjs(nVars)%grid%coordinate,             &
638                               MAXCHR, rtcode)
639                   if (rtcode .ne. 0) cfio%varObjs(nVars)%grid%coordinate = "pressure"  
640                   cfio%varObjs(nVars)%grid%levUnits = trim(dimUnits(iv))
641     
642                   allocate(cfio%varObjs(nVars)%grid%lev(dimSize(iv)), &
643                            lev(dimSize(iv)))
644                   call ncpopt(0)
645                   if ( coZType .eq. NCFLOAT ) then
646                      call ncvgt (fid, varId, 1, dimSize(iv), lev, rtcode) 
647     !print *, "Lev from CFIO SDFFileOpen: ", lev
648                   else
649                      allocate(lev_64(dimSize(iv)))
650                      call ncvgt (fid, varId, 1, dimSize(iv), lev_64, rtcode) 
651                      lev =lev_64
652                      deallocate(lev_64)
653                   end if
654                   cfio%varObjs(nVars)%grid%lev = 0.0
655                   cfio%varObjs(nVars)%grid%lev = lev
656     !print *, "cfio%varObjs(nVars)%grid%lev from CFIO SDFFileOpen: ", cfio%varObjs(nVars)%grid%lev
657                   deallocate(lev)
658                end if
659             end do
660             varId = ncvid (cfio%fid, cfio%varObjs(nVars)%vName, rtcode)
661             if (rtcode .ne. 0) then 
662                print *, "problem in getting varId in ncvid"
663                if ( present(rc) ) rc = -40    
664                return
665             end if
666             call ncagtc(fid,varId,'units',cfio%varObjs(nVars)%vunits,            &
667                         MAXCHR,rtcode)
668             if (rtcode .ne. 0) then
669                print *, "ncagtc failed for units"
670                if ( present(rc) ) rc = -53   
671                return
672             end if
673             cfio%varObjs(nVars)%vtitle = ' '
674             call ncpopt(0)
675             call ncagtc(fid,varId,'long_name',cfio%varObjs(nVars)%vtitle,        &
676                         MLEN,rtcode)
677             call ncagtc(fid,varId,'standard_name',cfio%varObjs(nVars)%standardName,        &
678                         MLEN,rtcode)
679             if ( cfio%varObjs(nVars)%grid%km .gt. 0 ) then
680                 cfio%varObjs(nVars)%twoDimVar = .false.
681             else
682                 cfio%varObjs(nVars)%twoDimVar = .true.
683             end if
684             call ncagt (fid, varId, '_FillValue', amiss, rtcode)
685             if (rtcode .NE. 0) then
686                call ncagt (fid, varId, 'missing_value', amiss, rtcode)
687             end if
688             cfio%varObjs(nVars)%amiss = amiss
689             call ncpopt(0)
690             call ncagt (fid, varId, 'scale_factor', scale, rtcode)
691             if (rtcode .NE. 0) then
692                cfio%varObjs(nVars)%scaleFactor = 1.0
693             else
694                cfio%varObjs(nVars)%scaleFactor = scale
695             end if
696             call ncpopt(0)
697             call ncagt (fid, varId, 'add_offset', offset, rtcode)
698             if (rtcode .NE. 0) then
699                cfio%varObjs(nVars)%addOffset = 0.0
700             else
701                cfio%varObjs(nVars)%addOffset = offset
702             end if
703             call ncagt (fid, varId, 'vmin', vRange32(1), rtcode)
704             if (rtcode .NE. 0) then
705               cfio%varObjs(nVars)%validRange(1) = cfio%varObjs(nVars)%amiss
706             else
707               cfio%varObjs(nVars)%validRange(1) = vRange32(1)
708             endif
709             call ncagt (fid, varId, 'vmax', vRange32(2), rtcode)
710             if (rtcode .NE. 0) then
711               cfio%varObjs(nVars)%validRange(2) = cfio%varObjs(nVars)%amiss
712             else
713               cfio%varObjs(nVars)%validRange(2) = vRange32(2)
714             endif
715             
716           end do
717          
718           call GetBegDateTime(fid,cfio%date,cfio%begTime,cfio%timeInc,rtcode)
719           if (rtcode .ne. 0) then
720              print *, "GetBegDateTime failed to get data/time/timeInc"
721              if ( present(rc) ) rc = rtcode
722              return
723           end if
724     
725           hour = cfio%timeInc/3600
726           min = mod(cfio%timeInc,max(3600*hour,1))/60
727           cfio%timeInc = hour*10000 + min*100
728     
729           allocate(attNames(ngatts))
730           call CFIO_GetAttNames ( cfio%fid, ngatts, attNames, rtcode )
731           if (err("CFIO_GetAttNames failed",rtcode,rtcode) .lt. 0) then  
732              if ( present(rc) ) rc = rtcode
733              return
734           end if
735      
736           iCnt = 0
737           rCnt = 0
738           cCnt = 0
739           iMaxLen = 0
740           rMaxLen = 0
741           cMaxLen = 0
742     
743     !     get how many int/real/char attributes in attNames
744           do i =1, ngatts
745              call CFIO_AttInquire (cfio%fid, attNames(i), type, count, rtcode)
746              if (err("CFIO_AttInquire failed",rtcode,rtcode) .lt. 0) then
747                 if ( present(rc) ) rc = rtcode
748                 return
749              end if
750              select case  (type)
751                 case ( 0 )
752                    iCnt = iCnt + 1
753                    if ( count .gt. iMaxLen ) iMaxLen = count
754                 case ( 1 )
755                    rCnt = rCnt + 1
756                    if ( count .gt. rMaxLen ) rMaxLen = count
757                 case ( 2 )
758                    cCnt = cCnt + 1
759                    if ( count .gt. cMaxLen ) cMaxLen = count
760                 case ( 3 )
761                    rCnt = rCnt + 1
762                    if ( count .gt. rMaxLen ) rMaxLen = count
763                 case ( 4 )
764                    iCnt = iCnt + 1
765                    if ( count .gt. iMaxLen ) iMaxLen = count
766              end select
767           end do
768     
769           cfio%nAttChar = cCnt
770           cfio%nAttReal = rCnt
771           cfio%nAttInt = iCnt
772     
773           allocate(cfio%attCharCnts(cCnt), cfio%attRealCnts(rCnt), &
774                    cfio%attIntCnts(iCnt))
775           allocate(cfio%attCharNames(cCnt), cfio%attRealNames(rCnt), &
776                    cfio%attIntNames(iCnt))
777     
778           iCnt = 0
779           rCnt = 0
780           cCnt = 0
781     !     get attNames and count, then put them into a cfio obj
782           do i =1, ngatts
783              call CFIO_AttInquire (cfio%fid, attNames(i), type, count, rtcode)
784              if (err("CFIO_AttInquire failed",rtcode,rtcode) .lt. 0) then  
785                 if ( present(rc) ) rc = rtcode
786                 return
787              end if
788              select case  (type)
789                 case ( 0 )
790                    iCnt = iCnt + 1
791                    cfio%attIntNames(iCnt) = attNames(i)         
792                    cfio%attIntCnts(iCnt) = count
793                 case ( 1 )
794                    rCnt = rCnt + 1
795                    cfio%attRealNames(rCnt) = attNames(i)
796                    cfio%attRealCnts(rCnt) = count
797                 case ( 2 )
798                    cCnt = cCnt + 1
799                    cfio%attCharNames(cCnt) = attNames(i)
800                    cfio%attCharCnts(cCnt) = count
801                 case ( 3 )
802                    rCnt = rCnt + 1
803                    cfio%attRealNames(rCnt) = attNames(i)
804                    cfio%attRealCnts(rCnt) = count
805                 case ( 4 )
806                    iCnt = iCnt + 1
807                    cfio%attIntNames(iCnt) = attNames(i)
808                    cfio%attIntCnts(iCnt) = count
809              end select
810           end do
811     
812           deallocate(attNames)
813     
814           allocate(cfio%attReals(rCnt, rMaxLen), cfio%attInts(iCnt, iMaxLen),    &
815                    cfio%attChars(cCnt))
816     !     get global integer attributes
817           do i = 1, iCnt
818              call CFIO_GetIntAtt(cfio%fid,cfio%attIntNames(i),cfio%attIntCnts(i) &
819                                 , cfio%attInts(i,:), rtcode)
820              if (err("CFIO_GetIntAtt failed",rtcode,rtcode) .lt. 0) then
821                 if ( present(rc) ) rc = rtcode
822                 return
823              end if
824           end do
825     
826     !     get global real attributes
827           do i = 1, rCnt
828              call CFIO_GetRealAtt(cfio%fid,cfio%attRealNames(i),               &
829                                   cfio%attRealCnts(i),                         &
830                                   cfio%attReals(i,:), rtcode)
831              if (err("CFIO_GetRealAtt",rtcode,rtcode) .lt. 0) then  
832                 if ( present(rc) ) rc = rtcode
833                 return
834              end if
835           end do
836          
837     !     get global char attributes
838           do i = 1, cCnt
839              allocate(globalAtt(cfio%attCharCnts(i)))
840              call CFIO_GetCharAtt(cfio%fid,cfio%attCharNames(i),   &
841                                   cfio%attCharCnts(i),             &
842                                   globalAtt, rtcode)
843              if (err("GetCharAtt",rtcode,rtcode) .lt. 0) then  
844                 if ( present(rc) ) rc = rtcode
845                 return
846              end if
847     !        cfio%attChars(i) can only hold MLEN characters.
848              do ii = 1, cfio%attCharCnts(i)
849                 cfio%attChars(i)(ii:ii) = globalAtt(ii)
850                 if (ii .ge. MLEN) then
851                    print *,"global attribute ",trim(cfio%attCharNames(i)), &
852                            " is longer than MLEN"
853                    exit
854                 end if
855              end do
856              cfio%attChars(i)(cfio%attCharCnts(i)+1:MLEN) = ' '
857              if (index(cfio%attCharNames(i),'Conventions') .gt. 0 .and.  &
858                  index(cfio%attChars(i), 'ESMF') .gt. 0) esmf_file=.true.
859     
860              if (index(cfio%attCharNames(i),'History') .gt. 0)  &
861                 cfio%History=cfio%attChars(i)
862              if (index(cfio%attCharNames(i),'Source') .gt. 0)  &
863                 cfio%source=cfio%attChars(i)
864              if (index(cfio%attCharNames(i),'Title') .gt. 0)  &
865                 cfio%title=cfio%attChars(i)
866              if (index(cfio%attCharNames(i),'Contact') .gt. 0)  &
867                 cfio%contact=cfio%attChars(i)
868              if (index(cfio%attCharNames(i),'Conventions') .gt. 0)  &
869                 cfio%convention=cfio%attChars(i)
870              if (index(cfio%attCharNames(i),'Institution') .gt. 0)  &
871                 cfio%institution=cfio%attChars(i)
872              if (index(cfio%attCharNames(i),'References') .gt. 0)  &
873                 cfio%references=cfio%attChars(i)
874              if (index(cfio%attCharNames(i),'Comment') .gt. 0)  &
875                 cfio%comment=cfio%attChars(i)
876           end do
877     
878     
879     !     get variable meta data
880           do i = 1, cfio%mVars
881              varId = ncvid (cfio%fid, cfio%varObjs(i)%vName, rtcode)
882              if (err("ncvid failed for vName",rtcode,rtcode) .lt. 0) then   
883                 if ( present(rc) ) rc = -40
884                 return
885              end if
886              call ncvinq(cfio%fid, varId, cfio%varObjs(i)%vName, datatype, &
887                          nvdims, vdims, nvatts, rtcode)
888              if (err("ncvinq failed for vName",rtcode,rtcode) .lt. 0) then  
889                 if ( present(rc) ) rc = -52
890                 return
891              end if
892              iCnt = 0
893              rCnt = 0
894              cCnt = 0
895              iMaxLen = 0
896              rMaxLen = 0
897              cMaxLen = 0
898     
899     !        get variable int/real/char attribute count
900              do iv =1, nvatts
901                 call ncanam (cfio%fid, varId, iv, vAttName, rtcode)
902                 if (err("ncanam failed for vName",rtcode,rtcode) .lt. 0) then  
903                    if ( present(rc) ) rc = -57   
904                    return
905                 end if
906                 call ncainq (cfio%fid,varId,vAttName,vtype,count,rtcode)
907                 if (err("ncainq failed for vName",rtcode,rtcode) .lt. 0) then
908                    if ( present(rc) ) rc = -58   
909                    return
910                 end if
911                 select case  (vtype)
912                    case ( NCSHORT )
913                       iCnt = iCnt + 1
914                       if ( count .gt. iMaxLen ) iMaxLen = count
915                    case ( NCFLOAT )
916                       rCnt = rCnt + 1
917                       if ( count .gt. rMaxLen ) rMaxLen = count
918                    case ( NCCHAR )
919                       cCnt = cCnt + 1
920                       if ( count .gt. cMaxLen ) cMaxLen = count
921                    case ( NCDOUBLE )
922                       rCnt = rCnt + 1
923                       if ( count .gt. rMaxLen ) rMaxLen = count
924                    case ( NCLONG )
925                       iCnt = iCnt + 1
926                       if ( count .gt. iMaxLen ) iMaxLen = count
927                 end select
928              end do
929                                                                                                 
930              cfio%varObjs(i)%nVarAttChar = cCnt
931              cfio%varObjs(i)%nVarAttReal = rCnt
932              cfio%varObjs(i)%nVarAttInt = iCnt
933                                                                                                 
934              allocate(cfio%varObjs(i)%attCharCnts(cCnt),  &
935                       cfio%varObjs(i)%attRealCnts(rCnt),  &
936                       cfio%varObjs(i)%attIntCnts(iCnt))     
937              allocate(cfio%varObjs(i)%attCharNames(cCnt), &
938                       cfio%varObjs(i)%attRealNames(rCnt),&
939                       cfio%varObjs(i)%attIntNames(iCnt))
940     
941              iCnt = 0
942              rCnt = 0
943              cCnt = 0
944     !        get variable int/real/char attribute names and counts
945              do iv =1, nvatts
946                 call ncanam (cfio%fid, varId, iv, vAttName, rtcode)
947                 if (err("ncanam failed for vName",rtcode,rtcode) .lt. 0) then  
948                    if ( present(rc) ) rc = -57
949                    return
950                 end if
951                 call ncainq (cfio%fid,varId,vAttName,vtype,count,rtcode)
952                 if (err("ncainq failed for vName",rtcode,rtcode) .lt. 0) then   
953                    if ( present(rc) ) rc = -58
954                    return
955                 end if
956                 select case  (vtype)
957                    case ( NCSHORT )
958                       iCnt = iCnt + 1
959                       cfio%varObjs(i)%attIntNames(iCnt) = vAttName
960                       cfio%varObjs(i)%attIntCnts(iCnt) = count   
961                    case ( NCFLOAT )
962                       rCnt = rCnt + 1
963                       cfio%varObjs(i)%attRealNames(rCnt) = vAttName
964                       cfio%varObjs(i)%attRealCnts(rCnt) = count   
965                    case ( NCCHAR )
966                       cCnt = cCnt + 1
967                       cfio%varObjs(i)%attCharNames(cCnt) = vAttName
968                       cfio%varObjs(i)%attCharCnts(cCnt) = count   
969                    case ( NCDOUBLE )
970                       rCnt = rCnt + 1
971                       cfio%varObjs(i)%attRealNames(rCnt) = vAttName
972                       cfio%varObjs(i)%attRealCnts(rCnt) = count   
973                    case ( NCLONG )
974                       iCnt = iCnt + 1
975                       cfio%varObjs(i)%attIntNames(iCnt) = vAttName
976                       cfio%varObjs(i)%attIntCnts(iCnt) = count   
977                 end select
978              end do
979        
980              allocate(cfio%varObjs(i)%varAttReals(rCnt, rMaxLen), &
981                       cfio%varObjs(i)%varAttInts(iCnt, iMaxLen),  &
982                       cfio%varObjs(i)%varAttChars(cCnt))
983     
984     !        get int variable attributes
985              do ii = 1, iCnt
986                 allocate(itmp(cfio%varObjs(i)%attIntCnts(ii)))
987                 call ncagt(cfio%fid,varId,cfio%varObjs(i)%attIntNames(ii),&
988                            itmp, rtcode)
989                 if (err("ncagt failed for attIntNames",rtcode,rtcode) .lt. 0) then
990                    if ( present(rc) ) rc = -53   
991                    return
992                 end if
993                 cfio%varObjs(i)%varAttInts(ii,1:cfio%varObjs(i)%attIntCnts(ii))&
994                            = itmp
995                 deallocate(itmp)
996              end do
997     
998     !        get real variable attributes
999              do ii = 1, rCnt
1000                 allocate(rtmp(cfio%varObjs(i)%attRealCnts(ii)))
1001                 call ncagt(cfio%fid,varId,cfio%varObjs(i)%attRealNames(ii),      &
1002                            rtmp, rtcode)
1003                 if (err("ncagt failed for attRealNames",rtcode,rtcode) .lt. 0) then
1004                    if ( present(rc) ) rc = -53
1005                    return
1006                 end if
1007                 cfio%varObjs(i)%varAttReals(ii,1:cfio%varObjs(i)%attRealCnts(ii))&
1008                            = rtmp
1009                 deallocate(rtmp)
1010              end do
1011     
1012     !        get char variable attributes
1013              do ii = 1, cCnt
1014                 call ncagtc(cfio%fid,varId,cfio%varObjs(i)%attCharNames(ii),     &
1015                            cfio%varObjs(i)%varAttChars(ii),                      &
1016                            cfio%varObjs(i)%attCharCnts(ii), rtcode)
1017                 if (err("ncagt failed for attCharNames",rtcode,rtcode) .lt. 0) then
1018                    if ( present(rc) ) rc = -53   
1019                    return
1020                 end if
1021                 cfio%varObjs(i)%varAttChars(ii)  &
1022                      (cfio%varObjs(i)%attCharCnts(ii)+1:MLEN) = ' '             
1023              end do
1024     
1025           end do
1026     
1027     !     set grids objects in a CFIO object
1028           allocate( cfio%grids(cfio%mGrids), stat = rtcode)
1029           cfio%grids(1) = cfio%varObjs(1)%grid
1030           if ( cfio%mGrids .eq. 1 .and. cfio%varObjs(1)%grid%km .eq. 0) &
1031              cfio%grids(1)%km = km
1032           
1033           if ( cfio%mGrids .gt. 1 ) then
1034             do i = 2, cfio%mGrids
1035                iCnt = 1
1036                do iv = 2, cfio%mVars
1037                   new_grid = .true.
1038                   iCnt = iCnt + 1
1039                   do ii = 2, i
1040                     if (cfio%varObjs(iv)%grid%im .eq. cfio%grids(ii-1)%im .and.  &
1041                       cfio%varObjs(iv)%grid%jm .eq. cfio%grids(ii-1)%jm .and.  &
1042                       cfio%varObjs(iv)%grid%km .eq. cfio%grids(ii-1)%km ) then 
1043                       new_grid = .false.
1044                     end if
1045                   end do
1046                   if ( new_grid ) exit
1047                end do
1048                cfio%grids(i) = cfio%varObjs(iCnt)%grid
1049             end do
1050           end if 
1051     
1052           rtcode = 0
1053           if ( present(rc) ) rc = rtcode
1054     
1055           end subroutine ESMF_CFIOSdfFileOpen
1056     
1057     !------------------------------------------------------------------------------
1058     !BOP
1059     ! !ROUTINE: ESMF_CFIOSdfVarWrite3D_ -- Write a variable to a output file
1060     
1061     ! !INTERFACE:
1062           subroutine ESMF_CFIOSdfVarWrite3D_(cfio, vName, field, date, curTime, &
1063                                           kbeg, kount, timeString, rc)
1064     !
1065     ! !ARGUMENTS:
1066     !
1067     ! !INPUT PARAMETERS:
1068     !
1069           type(ESMF_CFIO), intent(inOut) :: cfio      ! a CFIO obj  
1070           character(len=*), intent(in) :: vName       ! Variable name  
1071           real, intent(in) :: field(:,:,:)            ! array contains data
1072           integer, intent(in), OPTIONAL :: date       ! yyyymmdd
1073           integer, intent(in), OPTIONAL :: curTime    ! hhmmss
1074           integer, intent(in), OPTIONAL :: kbeg       ! first level to write
1075           integer, intent(in), OPTIONAL :: kount      ! number of levels to write
1076           character(len=*), intent(in), OPTIONAL :: timeString
1077                                       ! string expression for date and time
1078     
1079     
1080     !
1081     ! !OUTPUT PARAMETERS:
1082     !
1083           integer, intent(out), OPTIONAL :: rc      ! Error return code:
1084                                                     ! 0   all is well
1085                              !  rc = -2  time is inconsistent with increment
1086                              !  rc = -3  number of levels is incompatible with file
1087                              !  rc = -4  im is incompatible with file
1088                              !  rc = -5  jm is incompatible with file
1089                              !  rc = -6  time must fall on a minute boundary
1090                              !  rc = -7  error in diffdate
1091                              !  rc = -12  error determining default precision
1092                              !  rc = -13  error determining variable type
1093                              !  rc = -15  data outside of valid range
1094                              !  rc = -16  data outside of packing range
1095                              !  rc = -17  data outside of pack and valid range
1096                              !  rc = -38  error from ncvpt (dimension variable)
1097                              !  rc = -40  error from ncvid
1098                              !  rc = -41  error from ncdid or ncdinq (lat or lon)
1099                              !  rc = -42  error from ncdid or ncdinq (lev)
1100                              !  rc = -43  error from ncvid (time variable)
1101                              !  rc = -44  error from ncagt (time attribute)
1102                              !  rc = -45  error from ncvpt
1103                              !  rc = -46  error from ncvgt
1104                              !  rc = -52  error from ncvinq
1105                              !  rc = -53  error from ncagtc/ncagt
1106     
1107     !
1108     ! !DESCRIPTION:
1109     !     Write a variable to file
1110     !EOP
1111     !------------------------------------------------------------------------------
1112           integer :: i, rtcode
1113           integer :: myKbeg, myKount
1114           integer :: myDate, myCurTime
1115           character(len=MLEN) :: fNameTmp     ! file name 
1116                                                                                              
1117           fNameTmp = ''
1118           if ( present(date) ) myDate = date
1119           if ( present(curTime) ) myCurTime = curTime
1120           if ( present(timeString) ) call strToInt(timeString,myDate,myCurTime)
1121     
1122           if (len(trim(cfio%fNameTmplt)) .gt. 1) then
1123              call strTemplate_(fNameTmp,cfio%fNameTmplt,xid=cfio%expid,nymd=myDate, &
1124                                nhms=myCurTime, stat=rtcode)
1125              if (trim(fNameTmp) .ne. trim(cfio%fName)) then
1126                 call ESMF_CFIOSdfFileClose(cfio)
1127                 cfio%fName = fNameTmp
1128                 call ESMF_CFIOSet(cfio, fName=cfio%fName)
1129                 call ESMF_CFIOSet(cfio, date=myDate, begTime=myCurTime)
1130                 if (len(trim(cfio%expid)) .gt. 0) then
1131                    call ESMF_CFIOSdfFileCreate(cfio, expid=cfio%expid)
1132                 else
1133                    call ESMF_CFIOSdfFileCreate(cfio)
1134                 end if
1135              end if
1136           end if
1137               
1138     !
1139     !     make sure user provides the right variable name
1140           do i = 1, cfio%mVars
1141              if ( trim(vName) .eq. trim(cfio%varObjs(i)%vName) ) exit
1142           end do
1143     
1144     !     write 2D variable
1145           if ( cfio%varObjs(i)%twoDimVar ) then 
1146              call CFIO_PutVar (cfio%fid, vName, myDate, myCurTime,             &
1147                             cfio%varObjs(i)%grid%im, cfio%varObjs(i)%grid%jm,  &
1148                             0, 1, field, rtcode )
1149              if (err("CFIO_PutVar failed",rtcode,rtcode) .lt. 0) then
1150                 if ( present(rc) ) rc = rtcode
1151                 return
1152              end if
1153     !     write 3D variable
1154           else
1155              myKbeg = 1
1156              myKount = cfio%varObjs(i)%grid%km
1157     
1158              if ( present(kbeg) ) myKbeg = kbeg 
1159              if ( present(kount) ) myKount = kount
1160     
1161              call CFIO_PutVar (cfio%fid, vName, myDate, myCurTime,             &
1162                             cfio%varObjs(i)%grid%im, cfio%varObjs(i)%grid%jm,  &
1163                             myKbeg, myKount, field, rtcode )
1164              if (err("CFIO_PutVar failed",rtcode,rtcode) .lt. 0) then
1165                 if ( present(rc) ) rc = rtcode
1166                 return
1167              end if
1168           end if
1169     
1170           if ( cfio%varObjs(i)%timAve ) then
1171              call writeBnds(cfio, vName, myDate, myCurTime, rtcode)
1172           end if
1173     
1174           if ( present(rc) ) rc = rtcode
1175     
1176           end subroutine ESMF_CFIOSdfVarWrite3D_
1177     
1178     !------------------------------------------------------------------------------
1179     !BOP
1180     ! !ROUTINE: ESMF_CFIOSdfVarWrite1D_ -- Write a variable to a output file
1181                                                                                     
1182     ! !INTERFACE:
1183           subroutine ESMF_CFIOSdfVarWrite1D_(cfio, vName, field, date, curTime,  &
1184                                           timeString, rc)
1185     !
1186     ! !ARGUMENTS:
1187     !
1188     ! !INPUT PARAMETERS:
1189     !
1190           type(ESMF_CFIO), intent(inOut) :: cfio      ! a CFIO obj
1191           character(len=*), intent(in) :: vName       ! Variable name
1192           real, intent(in) :: field(:)            ! array contains data
1193           integer, intent(in), OPTIONAL :: date       ! yyyymmdd
1194           integer, intent(in), OPTIONAL :: curTime    ! hhmmss
1195           character(len=*), intent(in), OPTIONAL :: timeString
1196                                       ! string expression for date and time
1197                                                                                     
1198     !
1199     ! !OUTPUT PARAMETERS:
1200     !
1201           integer, intent(out), OPTIONAL :: rc      ! Error return code:
1202                                                     ! 0   all is well
1203     !
1204     ! !DESCRIPTION:
1205     !     Write a variable to file
1206     !EOP
1207     !------------------------------------------------------------------------------
1208           integer :: i, rtcode
1209           integer :: myDate, myCurTime
1210           character(len=MLEN) :: fNameTmp     ! file name
1211                                                                                              
1212           fNameTmp = ''
1213           if ( present(date) ) myDate = date
1214           if ( present(curTime) ) myCurTime = curTime
1215           if ( present(timeString) ) call strToInt(timeString,myDate,myCurTime)
1216                                                                                              
1217           if (len(trim(cfio%fNameTmplt)) .gt. 1) then
1218              call strTemplate_(fNameTmp,cfio%fNameTmplt,xid=cfio%expid,nymd=myDate, &
1219                                nhms=myCurTime, stat=rtcode)
1220              if (trim(fNameTmp) .ne. trim(cfio%fName)) then
1221                 call ESMF_CFIOSdfFileClose(cfio)
1222                 cfio%fName = fNameTmp
1223                 call ESMF_CFIOSet(cfio, fName=cfio%fName)
1224                 call ESMF_CFIOSet(cfio, date=myDate, begTime=myCurTime)
1225                 if (len(trim(cfio%expid)) .gt. 0) then
1226                    call ESMF_CFIOSdfFileCreate(cfio, expid=cfio%expid)
1227                 else
1228                    call ESMF_CFIOSdfFileCreate(cfio)
1229                 end if
1230              end if
1231           end if
1232     !
1233     !     make sure user provides the right variable name
1234           do i = 1, cfio%mVars
1235              if ( trim(vName) .eq. trim(cfio%varObjs(i)%vName) ) exit
1236           end do
1237                                                                                     
1238     !     NEED WORK HERE
1239           if (index(cfio%varObjs(i)%grid%gName,'station') .gt. 0) then
1240              call CFIO_SPutVar (cfio%fid, vName, myDate, myCurTime,      &
1241                       cfio%varObjs(i)%grid%im, cfio%varObjs(i)%grid%jm,  &
1242                       0, 1, field, rtcode )
1243              if (err("CFIO_SPutVar failed",rtcode,rtcode) .lt. 0) then
1244                 if ( present(rc) ) rc = rtcode
1245                 return
1246              end if
1247           else
1248              if (err("It isn't 1D station grid",rtcode,-1) .lt. 0 ) return
1249           end if
1250     
1251           if ( cfio%varObjs(i)%timAve ) then
1252              call writeBnds(cfio, vName, myDate, myCurTime, rtcode)
1253           end if
1254     
1255           if ( present(rc) ) rc = rtcode
1256                                                                                     
1257           end subroutine ESMF_CFIOSdfVarWrite1D_
1258                                                                                     
1259                                                                                     
1260     !------------------------------------------------------------------------------
1261     !BOP
1262     ! !ROUTINE: ESMF_CFIOSdfVarWrite2D_ -- Write a variable to a output file
1263                                                                                     
1264     ! !INTERFACE:
1265           subroutine ESMF_CFIOSdfVarWrite2D_(cfio, vName, field, date, curTime, &
1266                                           kbeg, kount, timeString, rc)
1267     !
1268     ! !ARGUMENTS:
1269     !
1270     ! !INPUT PARAMETERS:
1271     !
1272           type(ESMF_CFIO), intent(inOut) :: cfio    ! a CFIO obj
1273           character(len=*), intent(in) :: vName     ! Variable name
1274           real, intent(in) :: field(:,:)            ! array contains data
1275           integer, intent(in), OPTIONAL :: date     ! yyyymmdd
1276           integer, intent(in), OPTIONAL :: curTime  ! hhmmss
1277           integer, intent(in), OPTIONAL :: kbeg     ! first level to write
1278           integer, intent(in), OPTIONAL :: kount    ! number of levels to write
1279           character(len=*), intent(in), OPTIONAL :: timeString
1280                                       ! string expression for date and time
1281                                                                                     
1282     !
1283     ! !OUTPUT PARAMETERS:
1284     !
1285           integer, intent(out), OPTIONAL :: rc      ! Error return code:
1286                                                     ! 0   all is well
1287     !
1288     ! !DESCRIPTION:
1289     !     Write a variable to file
1290     !EOP
1291     !------------------------------------------------------------------------------
1292           integer :: i, rtcode
1293           integer :: myKbeg, myKount
1294           integer :: myDate, myCurTime
1295           character(len=MLEN) :: fNameTmp     ! file name
1296                                                                                              
1297           fNameTmp = ''
1298           if ( present(date) ) myDate = date
1299           if ( present(curTime) ) myCurTime = curTime
1300           if ( present(timeString) ) call strToInt(timeString,myDate,myCurTime)
1301                                                                                              
1302           if (len(trim(cfio%fNameTmplt)) .gt. 1) then
1303              call strTemplate_(fNameTmp,cfio%fNameTmplt,xid=cfio%expid,nymd=myDate, &
1304                                nhms=myCurTime, stat=rtcode)
1305              if (trim(fNameTmp) .ne. trim(cfio%fName)) then
1306                 call ESMF_CFIOSdfFileClose(cfio)
1307                 cfio%fName = fNameTmp
1308                 call ESMF_CFIOSet(cfio, fName=cfio%fName)
1309                 call ESMF_CFIOSet(cfio, date=myDate, begTime=myCurTime)
1310                 if (len(trim(cfio%expid)) .gt. 0) then
1311                    call ESMF_CFIOSdfFileCreate(cfio, expid=cfio%expid)
1312                 else
1313                    call ESMF_CFIOSdfFileCreate(cfio)
1314                 end if
1315              end if
1316           end if
1317     
1318     !
1319     !     make sure user provides the right variable name
1320           do i = 1, cfio%mVars
1321              if ( trim(vName) .eq. trim(cfio%varObjs(i)%vName) ) exit
1322           end do
1323                                                                                     
1324     !     write 2D variable
1325           if (index(cfio%varObjs(i)%grid%gName,'station') .gt. 0) then
1326              if ( cfio%varObjs(i)%twoDimVar ) then
1327                 call CFIO_SPutVar (cfio%fid, vName, myDate, myCurTime,      &
1328                          cfio%varObjs(i)%grid%im, cfio%varObjs(i)%grid%jm,  &
1329                          0, 1, field, rtcode )
1330                 if (err("CFIO_SPutVar failed",rtcode,rtcode) .lt. 0) then
1331                    if ( present(rc) ) rc = rtcode
1332                    return
1333                 end if
1334              else
1335                 myKbeg = 1
1336                 myKount = cfio%varObjs(i)%grid%km
1337                 if ( present(kbeg) ) myKbeg = kbeg
1338                 if ( present(kount) ) myKount = kount
1339     
1340                 call CFIO_SPutVar (cfio%fid, vName, myDate, myCurTime,          &
1341                          cfio%varObjs(i)%grid%im, cfio%varObjs(i)%grid%jm,  &
1342                          myKbeg, myKount, field, rtcode )
1343                 if (err("CFIO_SPutVar failed",rtcode,rtcode) .lt. 0) then
1344                    if ( present(rc) ) rc = rtcode
1345                    return
1346                 end if
1347              end if
1348           else
1349              call CFIO_PutVar (cfio%fid, vName, myDate, myCurTime,              &
1350                          cfio%varObjs(i)%grid%im, cfio%varObjs(i)%grid%jm,  &
1351                          0, 1, field, rtcode )
1352              if (err("CFIO_PutVar failed",rtcode,rtcode) .lt. 0) then
1353                 if ( present(rc) ) rc = rtcode
1354                 return
1355              end if
1356     
1357           end if
1358                                                              
1359           if ( cfio%varObjs(i)%timAve ) then
1360              call writeBnds(cfio, vName, myDate, myCurTime, rtcode)
1361           end if
1362     
1363           if ( present(rc) ) rc = rtcode
1364                                                                                     
1365           end subroutine ESMF_CFIOSdfVarWrite2D_
1366                                                                                     
1367     
1368     !------------------------------------------------------------------------------
1369     !BOP
1370     ! !ROUTINE: ESMF_CFIOSdfVarRead3D_ -- Read a variable from an existing file
1371     
1372     ! !INTERFACE:
1373           subroutine ESMF_CFIOSdfVarRead3D_(cfio, vName, field, date, curTime, &
1374                                          kBeg, kount, xBeg, xCount, yBeg,   &
1375                                          yCount, timeString, rc)
1376     !
1377     ! !ARGUMENTS:
1378     !
1379     ! !INPUT PARAMETERS:
1380     !
1381           type(ESMF_CFIO), intent(inOut) :: cfio      ! a CFIO obj
1382           character(len=*), intent(in) :: vName       ! variable name
1383           integer, intent(in), OPTIONAL :: date       ! yyyymmdd
1384           integer, intent(in), OPTIONAL :: curTime    ! hhmmss
1385           integer, intent(in), OPTIONAL :: kbeg       ! first level to write
1386           integer, intent(in), OPTIONAL :: kount      ! number of levels to write
1387           integer, intent(in), OPTIONAL :: xBeg       ! first point for lon 
1388           integer, intent(in), OPTIONAL :: xCount     ! number of points to read
1389           integer, intent(in), OPTIONAL :: yBeg       ! first point for lat 
1390           integer, intent(in), OPTIONAL :: yCount     ! number of points to read
1391           character(len=*), intent(in), OPTIONAL :: timeString
1392                                       ! string expression for date and time
1393                                                                                            
1394     !
1395     ! !OUTPUT PARAMETERS:
1396     !
1397           real, pointer :: field(:,:,:)             ! array contains data
1398           integer, intent(out), OPTIONAL :: rc      ! Error return code:
1399                                                     ! 0   all is well
1400                              !  rc = -2  time is inconsistent with increment
1401                              !  rc = -3  number of levels is incompatible with file
1402                              !  rc = -4  im is incompatible with file
1403                              !  rc = -5  jm is incompatible with file
1404                              !  rc = -6  time must fall on a minute boundary
1405                              !  rc = -7  error in diffdate
1406                              !  rc = -8  vname miss-match
1407                              !  rc = -12  error determining default precision
1408                              !  rc = -13  error determining variable type
1409                              !  rc = -19  unable to identify coordinate variable
1410                              !  rc = -38  error from ncvpt (dimension variable)
1411                              !  rc = -40  error from ncvid
1412                              !  rc = -41  error from ncdid or ncdinq (lat or lon)
1413                              !  rc = -42  error from ncdid or ncdinq (lev)
1414                              !  rc = -43  error from ncvid (time variable)
1415                              !  rc = -44  error from ncagt (time attribute)
1416                              !  rc = -46  error from ncvgt
1417                              !  rc = -48  error from ncinq
1418                              !  rc = -52  error from ncvinq
1419     !
1420     ! !DESCRIPTION:
1421     !     Read a variable from an existing file
1422     !EOP
1423     !------------------------------------------------------------------------------
1424           integer :: i, j, k, rtcode, curStep
1425           integer :: myKbeg, myKount
1426           integer :: myXbeg, myXount
1427           integer :: myYbeg, myYount
1428           integer :: myDate, myCurTime
1429           real, pointer :: tmp(:,:,:)          ! array contains data
1430           character(len=MLEN) :: fNameTmp     ! file name
1431                                                                                              
1432           fNameTmp = ''
1433                                                                                              
1434           if ( present(date) ) myDate = date
1435           if ( present(curTime) ) myCurTime = curTime
1436           if ( present(timeString) ) call strToInt(timeString,myDate,myCurTime)
1437     
1438           if (len(trim(cfio%fNameTmplt)) .gt. 1) then
1439              call strTemplate_(fNameTmp,cfio%fNameTmplt,xid=cfio%expid,nymd=MYdate, &
1440                                nhms=MYcurTime, stat=rtcode)
1441              if (trim(fNameTmp) .ne. trim(cfio%fName)) then
1442                 call ESMF_CFIOSdfFileClose(cfio)
1443                 cfio%fName = fNameTmp
1444                 if (len(trim(cfio%expid)) .gt. 0) then
1445                    call ESMF_CFIOSdfFileOpen(cfio, 1, expid=cfio%expid, cyclic=cfio%isCyclic)
1446                 else
1447                    call ESMF_CFIOSdfFileOpen(cfio, 1, cyclic=cfio%isCyclic)
1448                 end if
1449              end if
1450           end if
1451     
1452     !     make sure user provides the right variable name
1453           do i = 1, cfio%mVars
1454              if ( trim(vName) .eq. trim(cfio%varObjs(i)%vName) ) exit
1455           end do
1456     
1457     !     make sure we match something
1458           if ( i > cfio%mVars ) then
1459              if (trim(vName) .ne. trim(cfio%varObjs(i-1)%vName) ) then
1460                 print*,'ESMF_CFIOSdfVarRead3D: Variable name mismatch for ',trim(vName), ' in file ',trim(cfio%fName)
1461                 rc = -8
1462                 return
1463              endif
1464           endif
1465     
1466           myKbeg = 1
1467           myKount = 1
1468     
1469     !     read 3D variable
1470           if ( cfio%varObjs(i)%grid%km .gt. 1 .and.                          &
1471                (.not. cfio%varObjs(i)%twoDimVar) ) then
1472     
1473              myKbeg = 1
1474              myKount = cfio%varObjs(i)%grid%km
1475              if ( present(kbeg) ) myKbeg = kbeg
1476              if ( present(kount) ) myKount = kount
1477     
1478              allocate(tmp(cfio%varObjs(i)%grid%im,cfio%varObjs(i)%grid%jm,   &
1479                    myKount), stat=rtcode)
1480              if (rtcode /= 0) print *, "cannot allocate tmp in ESMF_CFIOSdfVarRead3D"
1481     
1482              call CFIO_GetVar(cfio%fid,vName,mydate,mycurTime,                   &
1483                            cfio%varObjs(i)%grid%im,                          &
1484                            cfio%varObjs(i)%grid%jm,myKbeg,myKount,           &
1485                            cfio%tSteps, tmp, cfio%isCyclic, rtcode )
1486              if (rtcode .ne. 0) then
1487                 if ( present(rc) ) rc = rtcode
1488                 return
1489              end if
1490     !     read 2D variable
1491           else
1492              allocate(tmp(cfio%varObjs(i)%grid%im,cfio%varObjs(i)%grid%jm,1),&
1493                       stat=rtcode)
1494              if (rtcode /= 0) print *, "cannot allocate tmp in ESMF_CFIOSdfVarRead3D"
1495              
1496              call CFIO_GetVar(cfio%fid,vName,mydate,MYcurTime,                   &
1497                            cfio%varObjs(i)%grid%im,                          &
1498                            cfio%varObjs(i)%grid%jm, 0, 1, cfio%tSteps, tmp,  &
1499                            cfio%isCyclic, rtcode )
1500              if (rtcode .ne. 0) then
1501                 if ( present(rc) ) rc = rtcode
1502                 return
1503              end if
1504           end if
1505     
1506           myXbeg = 1
1507           myXount = cfio%varObjs(i)%grid%im
1508           myYbeg = 1
1509           myYount = cfio%varObjs(i)%grid%jm
1510           if ( present(xBeg) ) myXbeg=xBeg
1511           if ( present(yBeg) ) myYbeg=yBeg
1512           if ( present(xCount) ) myXount = xCount
1513           if ( present(yCount) ) myYount = yCount
1514     
1515           if (.not. associated(field) ) then
1516              allocate(field(myXount,myYount,myKount),stat=rtcode)
1517           else
1518              deallocate(field,stat=rtcode)
1519              if (rtcode /= 0) print *, "Couldn't deallocate Field in VarRead3D"
1520              allocate(field(myXount,myYount,myKount),stat=rtcode)
1521           end if
1522     !      allocate(field(myXount,myYount,myKount), stat=rtcode)
1523           if (rtcode /= 0) print *, "cannot allocate field in ESMF_CFIOSdfVarRead3D_"
1524           do k = 1, myKount
1525              do j = 1, myYount
1526                do i = 1, myXount
1527                   field(i,j,k) = tmp(myXbeg+i-1,myYbeg+j-1,k)
1528                end do
1529              end do
1530           end do
1531     
1532           deallocate(tmp)
1533           if ( present(rc) ) rc = rtcode
1534     
1535           end subroutine ESMF_CFIOSdfVarRead3D_ 
1536     
1537     !------------------------------------------------------------------------------
1538     !BOP
1539     ! !ROUTINE: ESMF_CFIOSdfVarRead2D_ -- Read a variable from an existing file
1540                                                                                     
1541     ! !INTERFACE:
1542           subroutine ESMF_CFIOSdfVarRead2D_(cfio, vName, field, date, curTime, &
1543                                          kbeg, kount, xBeg, xCount, yBeg,   &
1544                                          yCount, timeString, rc)
1545     !
1546     ! !ARGUMENTS:
1547     !
1548     ! !INPUT PARAMETERS:
1549     !
1550           type(ESMF_CFIO), intent(inout) :: cfio         ! a CFIO obj
1551           character(len=*), intent(in) :: vName       ! variable name
1552           integer, intent(in), OPTIONAL :: date       ! yyyymmdd
1553           integer, intent(in), OPTIONAL :: curTime    ! hhmmss
1554           integer, intent(in), OPTIONAL :: kbeg       ! first level to write
1555           integer, intent(in), OPTIONAL :: kount      ! number of levels to write
1556           integer, intent(in), OPTIONAL :: xBeg       ! first point for lon
1557           integer, intent(in), OPTIONAL :: xCount     ! number of points to read
1558           integer, intent(in), OPTIONAL :: yBeg       ! first point for lat
1559           integer, intent(in), OPTIONAL :: yCount     ! number of points to read
1560           character(len=*), intent(in), OPTIONAL :: timeString
1561                                       ! string expression for date and time
1562     
1563     !
1564     ! !OUTPUT PARAMETERS:
1565     !
1566           real, pointer :: field(:,:)             ! array contains data
1567           integer, intent(out), OPTIONAL :: rc      ! Error return code:
1568                                                     ! 0   all is well
1569                              !  rc = -2  time is inconsistent with increment
1570                              !  rc = -3  number of levels is incompatible with file
1571                              !  rc = -4  im is incompatible with file
1572                              !  rc = -5  jm is incompatible with file
1573                              !  rc = -6  time must fall on a minute boundary
1574                              !  rc = -7  error in diffdate
1575                              !  rc = -8  vname miss-match
1576                              !  rc = -12  error determining default precision
1577                              !  rc = -13  error determining variable type
1578                              !  rc = -19  unable to identify coordinate variable
1579                              !  rc = -38  error from ncvpt (dimension variable)
1580                              !  rc = -40  error from ncvid
1581                              !  rc = -41  error from ncdid or ncdinq (lat or lon)
1582                              !  rc = -42  error from ncdid or ncdinq (lev)
1583                              !  rc = -43  error from ncvid (time variable)
1584                              !  rc = -44  error from ncagt (time attribute)
1585                              !  rc = -46  error from ncvgt
1586                              !  rc = -48  error from ncinq
1587                              !  rc = -52  error from ncvinq
1588     
1589     !
1590     ! !DESCRIPTION:
1591     !     Read a variable from an existing file
1592     !EOP
1593     !------------------------------------------------------------------------------
1594           integer :: i, j, k, rtcode, curStep
1595           integer :: myKbeg, myKount
1596           integer :: myXbeg, myXount
1597           integer :: myYbeg, myYount
1598           integer :: myDate, myCurTime
1599           real, pointer :: tmp(:,:)          ! array contains data
1600           character(len=MLEN) :: fNameTmp     ! file name
1601                                                                                                   
1602           fNameTmp = ''
1603     
1604           if ( present(date) ) myDate = date
1605           if ( present(curTime) ) myCurTime = curTime
1606           if ( present(timeString) ) call strToInt(timeString,myDate,myCurTime)
1607                                                                                                   
1608           if (len(trim(cfio%fNameTmplt)) .gt. 1) then
1609              call strTemplate_(fNameTmp,cfio%fNameTmplt,xid=cfio%expid,nymd=MYdate, &
1610                                nhms=MYcurTime, stat=rtcode)
1611              if (trim(fNameTmp) .ne. trim(cfio%fName)) then
1612                 call ESMF_CFIOSdfFileClose(cfio)
1613                 cfio%fName = fNameTmp
1614     !            call ESMF_CFIOSet(cfio, fName=cfio%fName)
1615                 if (len(trim(cfio%expid)) .gt. 0) then
1616                    call ESMF_CFIOSdfFileOpen(cfio, 1, expid=cfio%expid, cyclic=cfio%isCyclic)
1617                 else
1618                    call ESMF_CFIOSdfFileOpen(cfio, 1, cyclic=cfio%isCyclic)
1619                 end if
1620              end if
1621           end if
1622                                                                                     
1623     !     make sure user provides the right variable name
1624           do i = 1, cfio%mVars
1625              if ( trim(vName) .eq. trim(cfio%varObjs(i)%vName) ) exit
1626           end do
1627     
1628     !     make sure we match something
1629           if ( i > cfio%mVars ) then
1630              if (trim(vName) .ne. trim(cfio%varObjs(i-1)%vName) ) then
1631                 print*,'ESMF_CFIOSdfVarRead2D: Variable name mismatch for ',trim(vName), ' in file ',trim(cfio%fName)
1632                 rc = -8
1633                 return
1634              endif
1635           endif
1636                                                                                     
1637           myXbeg = 1
1638           myXount = cfio%varObjs(i)%grid%im
1639           myYbeg = 1
1640           myYount = cfio%varObjs(i)%grid%jm
1641           myKbeg = 1
1642           myKount = cfio%varObjs(i)%grid%km
1643           if ( present(xBeg) ) myXbeg=xBeg
1644           if ( present(yBeg) ) myYbeg=yBeg
1645           if ( present(kbeg) ) myKbeg = kbeg
1646           if ( present(kount) ) myKount = kount
1647           if ( present(xCount) ) myXount = xCount
1648           if ( present(yCount) ) myYount = yCount
1649     
1650     !     read 2D variable
1651           if ( cfio%varObjs(i)%twoDimVar .and.                              &
1652                   .not. cfio%varObjs(i)%grid%stnGrid) then
1653             allocate(tmp(cfio%varObjs(i)%grid%im,cfio%varObjs(i)%grid%jm),  &
1654                    stat=rtcode)
1655             call CFIO_GetVar(cfio%fid,vName,MYdate,MYcurTime,                   &
1656                         cfio%varObjs(i)%grid%im,                            &
1657                         cfio%varObjs(i)%grid%jm, 0, 1, cfio%tSteps, tmp,    &
1658                         cfio%isCyclic, rtcode )
1659             if (err("CFIO_GetVar failed",rtcode,rtcode) .lt. 0) then  
1660                if ( present(rc) ) rc = rtcode
1661                return
1662             end if
1663      
1664             allocate(field(myXount,myYount))
1665             do j = 1, myYount
1666                do i = 1, myXount
1667                   field(i,j) = tmp(myXbeg+i-1,myYbeg+j-1)
1668                end do
1669             end do
1670     
1671           else
1672             if (cfio%varObjs(i)%twoDimVar ) then
1673                allocate(tmp(cfio%varObjs(i)%grid%im,1), stat=rtcode)
1674                call CFIO_SGetVar(cfio%fid,vName,MYdate,MYcurTime,               &
1675                         cfio%varObjs(i)%grid%im, cfio%varObjs(i)%grid%jm,   &
1676                         0,1, cfio%tSteps, tmp, cfio%isCyclic, rtcode )
1677                if (err("CFIO_SGetVar failed",rtcode,rtcode) .lt. 0) then  
1678                   if ( present(rc) ) rc = rtcode
1679                   return
1680                end if
1681                allocate(field(myXount,1))
1682                do i = 1, myXount
1683                   field(i,1) = tmp(myXbeg+i-1,1)
1684                end do
1685     
1686             else
1687                allocate(tmp(cfio%varObjs(i)%grid%im,myKount),stat=rtcode)
1688                call CFIO_SGetVar(cfio%fid,vName,MYdate,MYcurTime,               &
1689                         cfio%varObjs(i)%grid%im, cfio%varObjs(i)%grid%jm,   &
1690                         myKbeg, myKount, cfio%tSteps, tmp, cfio%isCyclic, rtcode )
1691                if (err("CFIO_GetVar failed",rtcode,rtcode) .lt. 0) then  
1692                   if ( present(rc) ) rc = rtcode
1693                   return
1694                end if
1695                allocate(field(myXount,myKount))
1696                do k = 1, myKount
1697                  do i = 1, myXount
1698                     field(i,k) = tmp(myXbeg+i-1,k)
1699                  end do
1700                end do
1701     
1702             end if
1703           end if
1704      
1705           deallocate(tmp)
1706                                                                                     
1707           if ( present(rc) ) rc = rtcode
1708                                                                                     
1709           end subroutine ESMF_CFIOSdfVarRead2D_
1710                                                                                     
1711     !------------------------------------------------------------------------------
1712     !BOP
1713     ! !ROUTINE: ESMF_CFIOSdfVarRead1D_ -- Read a variable from an existing file
1714                                                                                     
1715     ! !INTERFACE:
1716           subroutine ESMF_CFIOSdfVarRead1D_(cfio, vName, field, date, curTime, &
1717                                          xBeg, xCount, timestring, rc)
1718     !
1719     ! !ARGUMENTS:
1720     !
1721     ! !INPUT PARAMETERS:
1722     !
1723           type(ESMF_CFIO), intent(inOut) :: cfio         ! a CFIO obj
1724           character(len=*), intent(in) :: vName       ! variable name
1725           integer, intent(in), OPTIONAL :: date       ! yyyymmdd
1726           integer, intent(in), OPTIONAL :: curTime    ! hhmmss
1727           integer, intent(in), OPTIONAL :: xBeg       ! first point for lon
1728           integer, intent(in), OPTIONAL :: xCount     ! number of points to read
1729           character(len=*), intent(in), OPTIONAL :: timeString
1730                                       ! string expression for date and time
1731     !
1732     ! !OUTPUT PARAMETERS:
1733     !
1734           real, pointer :: field(:)             ! array contains data
1735           integer, intent(out), OPTIONAL :: rc      ! Error return code:
1736                                                     ! 0   all is well
1737     !
1738     ! !DESCRIPTION:
1739     !     Read a variable from an existing file
1740     !EOP
1741     !------------------------------------------------------------------------------
1742     
1743           integer :: i, j, rtcode
1744           integer :: myXbeg, myXount      
1745           integer :: myDate, myCurTime
1746           real, pointer :: tmp(:)          ! array contains data
1747           character(len=MLEN) :: fNameTmp     ! file name
1748                                                                                                   
1749           fNameTmp = ''
1750           if ( present(date) ) myDate = date
1751           if ( present(curTime) ) myCurTime = curTime
1752           if ( present(timeString) ) call strToInt(timeString,myDate,myCurTime)
1753                                                                                                   
1754           if (len(trim(cfio%fNameTmplt)) .gt. 1) then
1755              call strTemplate_(fNameTmp,cfio%fNameTmplt,xid=cfio%expid,nymd=MYdate, &
1756                                nhms=MYcurTime, stat=rtcode)
1757              if (trim(fNameTmp) .ne. trim(cfio%fName)) then
1758                 call ESMF_CFIOSdfFileClose(cfio)
1759                 cfio%fName = fNameTmp
1760     !            call ESMF_CFIOSet(cfio, fName=cfio%fName)
1761                 if (len(trim(cfio%expid)) .gt. 0) then
1762                    call ESMF_CFIOSdfFileOpen(cfio, 1, expid=cfio%expid, cyclic=cfio%isCyclic)
1763                 else
1764                    call ESMF_CFIOSdfFileOpen(cfio, 1, cyclic=cfio%isCyclic)
1765                 end if
1766              end if
1767           end if
1768     
1769                                                                                     
1770     !     make sure user provides the right variable name
1771           do i = 1, cfio%mVars
1772              if ( trim(vName) .eq. trim(cfio%varObjs(i)%vName) ) exit
1773           end do
1774                                                                                     
1775           myXbeg = 1
1776           myXount = cfio%varObjs(i)%grid%im
1777     
1778           if (present(xBeg)) myXbeg = xBeg
1779           if (present(xCount)) myXount = xCount
1780     
1781     !     read 1D variable
1782           allocate(tmp(cfio%varObjs(i)%grid%im), stat=rtcode)
1783           call CFIO_SGetVar(cfio%fid,vName,MYdate,MYcurTime,               &
1784                    cfio%varObjs(i)%grid%im, cfio%varObjs(i)%grid%jm,   &
1785                    0,1, cfio%tSteps, tmp, cfio%isCyclic, rtcode )
1786     
1787           do i = 1, myXount
1788              field(i) = tmp(myXbeg+i-1)
1789           end do
1790     
1791           deallocate(tmp)
1792                                                                                     
1793           if ( present(rc) ) rc = rtcode
1794                                                                                     
1795           end subroutine ESMF_CFIOSdfVarRead1D_
1796                                                                                     
1797     
1798     !------------------------------------------------------------------------------
1799     !BOP
1800     ! !ROUTINE: ESMF_CFIOSdfFileClose -- close an open CFIO stream
1801     
1802     ! !INTERFACE:
1803           subroutine ESMF_CFIOSdfFileClose (cfio, rc)
1804     !
1805     ! !ARGUMENTS:
1806     !
1807     ! !OUTPUT PARAMETERS:
1808     !
1809           integer, intent(out), OPTIONAL :: rc      ! Error return code:
1810                                            ! 0   all is well
1811                                            ! -54  error from ncclos (file close)
1812     !
1813     ! !INPUT/OUTPUT PARAMETERS:
1814     !
1815           type(ESMF_CFIO), intent(inout) :: cfio       ! CFIO object
1816     
1817     
1818     !
1819     ! !DESCRIPTION:
1820     !     close an open CFIO stream
1821     !EOP
1822     !------------------------------------------------------------------------------
1823            integer :: rtcode
1824     
1825            if ( cfio%isOpen ) then 
1826               call CFIO_Close(cfio%fid, rtcode)
1827               if (rtcode .ne. 0) then 
1828                  print *, "CFIO_Close failed"
1829               else
1830                  cfio%isOpen = .false.
1831               end if
1832            else
1833               rtcode = 0
1834            end if
1835     
1836            if ( present(rc) ) rc = rtcode
1837     
1838           end subroutine ESMF_CFIOSdfFileClose
1839     
1840     
1841     !------------------------------------------------------------------------------
1842     
1843     !-------------------------------------------------------------------------
1844     !         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
1845     !-------------------------------------------------------------------------
1846     !BOP
1847     !
1848     ! !ROUTINE:  CFIO_Create_ -- Creates a DAO gridded file for writing
1849     ! 
1850     ! !DESCRIPTION: This routine is used to open a new file for a CFIO stream.
1851     !
1852     !, im, jm, km !INTERFACE:
1853     !
1854           subroutine CFIO_Create_ ( cfio, rc )
1855     !
1856     ! !USES:
1857     !
1858           Implicit NONE  
1859     !
1860     ! !INPUT PARAMETERS: 
1861     !
1862     !
1863     ! !OUTPUT PARAMETERS:
1864     !
1865           integer        fid     ! File handle
1866           integer        rc      ! Error return code:
1867                                  ! 0  All is well
1868                                  ! -1 Time increment is 0
1869                                  ! -18 incorrect time increment
1870                                  ! -30 can't open file
1871                                  ! -31 error from ncddef
1872                                  ! -32 error from ncvdef (dimension variable)
1873                                  ! -33 error from ncapt(c) (dimension attribute)
1874                                  ! -34 error from ncvdef (variable)
1875                                  ! -35  error from ncapt(c) (variable attribute)
1876                                  ! -36  error from ncaptc/ncapt (global attribute)
1877                                  ! -37  error from ncendf
1878                                  ! -38  error from ncvpt (dimension variable)
1879                                  ! -39 Num of real var elements and Cnt differ
1880                                  ! -40 error setting deflate compression routine
1881                                  ! -41 error setting fletcher checksum routine
1882     
1883     !
1884     ! !INPUT/OUTPUT PARAMETERS:
1885     !
1886          type(ESMF_CFIO), intent(inout) :: cfio 
1887     !
1888     ! !REVISION HISTORY: 
1889     !
1890     !EOP
1891     !-------------------------------------------------------------------------
1892     
1893           ! REAL*4 variables for 32-bit output to netCDF file.
1894     
1895           integer :: im, jm, km, nst
1896           real*8, pointer :: lon_64(:), lat_64(:), levs_64(:)
1897           character(len=MVARLEN) :: levunits
1898           integer :: yyyymmdd_beg, hhmmss_beg, timinc
1899           real :: missing_val
1900           integer :: nvars
1901           character(len=MLEN), pointer :: vname(:)
1902           character(len=MVARLEN), pointer :: vtitle(:)
1903           character(len=MVARLEN), pointer :: vunits(:)
1904           integer, pointer :: kmvar(:), station(:)
1905           real, pointer :: valid_range(:,:), packing_range(:,:)
1906           integer, pointer :: akid(:), bkid(:), ptopid(:)
1907           integer :: prec
1908           integer, pointer ::  vid(:)
1909     
1910           real*4 amiss_32
1911           real*4 scale_32, offset_32
1912           real*4 high_32,low_32
1913           real*4, pointer :: ak_32(:), bk_32(:), layer(:)
1914           real*4 :: ptop_32(1)
1915           integer i, j
1916           integer timeid, timedim
1917           integer, pointer :: latid(:), lonid(:), stationid(:)
1918           integer, pointer :: levid(:), layerid(:)
1919           integer, pointer :: latdim(:), londim(:), stationdim(:)
1920           integer, pointer :: levdim(:), layerdim(:)
1921           integer, pointer :: gDims3D(:,:), gDims2D(:,:)
1922           integer dims3D(4), dims2D(3), dims1D(1), ptopdim
1923           integer corner(1), edges(1)
1924     !      integer corner(4), edges(4)
1925           character*80 timeUnits 
1926           logical surfaceOnly
1927           character*8 strBuf
1928           character*14 dateString
1929           integer year,mon,day,hour,min,sec
1930           integer count
1931           integer maxLen
1932           integer rtcode
1933           logical :: aveFile = .false.
1934           character cellMthd
1935     !      real*4 bndsdata(2)
1936           integer bndsid, dimsbnd(2), bndsdim
1937           integer ig
1938           integer ndim
1939           character cig
1940     
1941     ! Variables for packing
1942     
1943           integer*2 amiss_16
1944           real*4, pointer ::  pRange_32(:,:),vRange_32(:,:)
1945           logical packflag
1946     
1947     ! Set metadata strings.  These metadata values are specified in the 
1948     ! COARDS conventions
1949     
1950           character (len=50) :: lonName = "longitude"
1951           character (len=50) :: lonUnits = "degrees_east"
1952           character (len=50) :: latName = "latitude"
1953           character (len=50) :: latUnits = "degrees_north"
1954           character (len=50) :: levName = "vertical level"
1955     !                           levUnits: specified by user in argument list
1956           character (len=50) :: layerName = "edges"
1957           character (len=50) :: layerUnits = "layer"
1958           character (len=50) :: timeName = "time"
1959     !                           timeUnits: string is built below
1960           integer :: iCnt
1961           real*4, pointer :: realVarAtt(:)
1962           integer, pointer :: intVarAtt(:)
1963           real*4 :: scale_factor, add_offset
1964           character (len=50) :: nameLat, nameLon, nameLev, nameEdge
1965           character (len=50) :: nameAk, nameBk, namePtop, nameStation 
1966             
1967           nvars = cfio%mVars
1968           yyyymmdd_beg = cfio%date
1969           hhmmss_beg = cfio%begTime
1970           timinc = cfio%timeInc
1971           missing_val = cfio%varObjs(1)%amiss
1972           allocate(vname(nvars), vtitle(nvars), vunits(nvars), kmvar(nvars), &
1973                 valid_range(2,nvars), packing_range(2,nvars), vid(nvars),    &
1974                 vRange_32(2,nvars), pRange_32(2,nvars), stat = rtcode)
1975     
1976           allocate(latid(cfio%mGrids), lonid(cfio%mGrids),                   &
1977                    levid(cfio%mGrids), layerid(cfio%mGrids),                 &
1978                    latdim(cfio%mGrids), londim(cfio%mGrids),                 &
1979                    levdim(cfio%mGrids), layerdim(cfio%mGrids),               &
1980                    akid(cfio%mGrids),bkid(cfio%mGrids),ptopid(cfio%mGrids),  &
1981                    gDims3D(4,cfio%mGrids), gDims2D(3,cfio%mGrids),           &
1982                    stationdim(cfio%mGrids), stationid(cfio%mGrids) )
1983     
1984           do i=1,nvars
1985              vname(i) = cfio%varObjs(i)%vName
1986              vtitle(i) = cfio%varObjs(i)%vTitle
1987              vunits(i) = cfio%varObjs(i)%vUnits
1988              kmvar(i) = cfio%varObjs(i)%grid%km
1989              if ( cfio%varObjs(i)%twoDimVar ) kmvar(i) = 0
1990              valid_range(1, i) = cfio%varObjs(i)%validRange(1)
1991              valid_range(2, i) = cfio%varObjs(i)%validRange(2)
1992              packing_range(1, i) = cfio%varObjs(i)%packingRange(1)
1993              packing_range(2, i) = cfio%varObjs(i)%packingRange(2)
1994              if ( cfio%varObjs(i)%timAve ) then
1995                 aveFile = .true.
1996                 cellMthd = cfio%varObjs(i)%aveMethod
1997              end if
1998           enddo
1999     
2000           do j=1,nvars
2001             do i=1,2
2002                vRange_32(i,j) = valid_range(i,j)
2003                pRange_32(i,j) = packing_range(i,j)
2004             enddo
2005           enddo
2006     
2007           amiss_32 = cfio%varObjs(1)%amiss
2008           amiss_16 = PACK_FILL
2009     
2010     ! Variable initialization
2011     
2012           surfaceOnly = .TRUE.
2013     
2014     ! Basic error-checking.
2015     
2016           if (timinc .eq. 0) then
2017             rc=-1
2018             return
2019           endif
2020     
2021     ! Check to see if there is only surface data in this file definition
2022     
2023           do i=1,nvars
2024             if (kmvar(i) .NE. 0) then
2025               surfaceOnly = .FALSE.
2026               exit
2027             endif
2028           enddo
2029     
2030     ! Make NetCDF errors non-fatal, and do not warning messages.
2031     
2032           call ncpopt(0)
2033     
2034     ! Create the new NetCDF file. [ Enter define mode. ]
2035     
2036     #if defined(HAS_NETCDF4)
2037           rc = nf_create (trim(cfio%fName), IOR(NF_CLOBBER,NF_NETCDF4), fid)
2038     #else
2039           fid = nccre (trim(cfio%fName), NCCLOB, rc)
2040     #endif
2041     
2042           if (err("Create: can't create file",rc,-30) .LT. 0) return
2043     
2044     ! Convert double-precision output variables to single-precision
2045        do ig = 1, cfio%mGrids
2046           im = cfio%grids(ig)%im
2047           jm = cfio%grids(ig)%jm
2048           km = cfio%grids(ig)%km
2049           if ( index(cfio%grids(ig)%gName, 'station') .gt. &
2050                0 ) then
2051              if (im .ne. jm) rtcode = err("It isn't station grid",-1,-1)
2052              nst = im
2053           end if
2054     
2055           levunits = trim(cfio%grids(ig)%levUnits)
2056     
2057           allocate(station(im))
2058           do i=1,im
2059              station(i) = i
2060           enddo
2061     
2062     ! Define dimensions.
2063     
2064           if ( ig .eq. 1 ) then
2065              if (cfio%mGrids .eq. 1) then
2066                 nameLon = 'lon'
2067                 nameLat = 'lat'
2068                 nameLev = 'lev'
2069                 nameEdge = 'edges'
2070                 nameStation = 'station'
2071              else
2072                 nameLon = 'lon0'
2073                 nameLat = 'lat0'
2074                 nameLev = 'lev0'
2075                 nameEdge = 'edges0'
2076                 nameStation = 'station0'
2077              end if
2078           else
2079             write (cig,"(I1)") ig-1
2080             nameLon = 'lon'//cig
2081             nameLat = 'lat'//cig
2082             nameLev = 'lev'//cig
2083             nameEdge = 'edges'//cig
2084             nameStation = 'station'//cig
2085           end if
2086     
2087           if (index(cfio%grids(ig)%gName,'station') .gt. 0) then
2088              stationdim(ig) = ncddef (fid, nameStation, im, rc)
2089              if (err("Create: error defining station",rc,-31) .LT. 0) return
2090     !         londim(ig) = ncddef (fid, nameLon, im, rc)
2091     !         if (err("Create: error defining lon",rc,-31) .LT. 0) return
2092     !         latdim(ig) = ncddef (fid, nameLat, jm, rc)
2093     !         if (err("Create: error defining lat",rc,-31) .LT. 0) return
2094           else
2095              londim(ig) = ncddef (fid, nameLon, im, rc)
2096              if (err("Create: error defining lon",rc,-31) .LT. 0) return
2097              latdim(ig) = ncddef (fid, nameLat, jm, rc)
2098              if (err("Create: error defining lat",rc,-31) .LT. 0) return
2099           end if
2100     
2101           if (.NOT. surfaceOnly) then
2102             levdim(ig) = ncddef (fid, nameLev, km, rc)
2103             if (err("Create: error defining lev",rc,-31) .LT. 0) return
2104           endif
2105           if ( trim(cfio%grids(ig)%standardName) .eq. &
2106                'atmosphere_hybrid_sigma_pressure_coordinate' ) then
2107              layerdim(ig) = ncddef (fid, nameEdge, km+1, rc)
2108              if (err("Create: error defining edges",rc,-31) .LT. 0) return
2109           endif
2110     
2111           call ncendf (fid, rc)
2112           call ncredf (fid, rc)
2113     
2114     ! Define dimension variables.
2115     
2116           if (index(cfio%grids(ig)%gName,'station') .gt. 0) then
2117     !         stationid(ig) = ncvdef (fid, nameStation, NCDOUBLE, 1,       &
2118     !                                 stationdim(ig), rc)
2119     !         if (err("Create: error defining station",rc,-32) .LT. 0) return
2120              lonid(ig) = ncvdef (fid, nameLon, NCDOUBLE, 1, stationdim(ig), rc)
2121              if (err("Create: error creating lon",rc,-32) .LT. 0) return
2122              latid(ig) = ncvdef (fid, nameLat, NCDOUBLE, 1, stationdim(ig), rc)
2123              if (err("Create: error creating lat",rc,-32) .LT. 0) return
2124           else
2125              lonid(ig) = ncvdef (fid, nameLon, NCDOUBLE, 1, londim(ig), rc)
2126              if (err("Create: error creating lon",rc,-32) .LT. 0) return
2127              latid(ig) = ncvdef (fid, nameLat, NCDOUBLE, 1, latdim(ig), rc)
2128              if (err("Create: error creating lat",rc,-32) .LT. 0) return
2129           end if
2130     
2131           if (.NOT. surfaceOnly) then
2132             levid(ig) = ncvdef (fid, nameLev, NCDOUBLE, 1, levdim(ig), rc)
2133             if (err("Create: error creating lev",rc,-32) .LT. 0) return
2134           endif
2135           if ( trim(cfio%grids(ig)%standardName) .eq. &
2136                'atmosphere_hybrid_sigma_pressure_coordinate' ) then
2137              layerid(ig) = ncvdef (fid, nameEdge, NCDOUBLE, 1, layerdim(ig), rc)
2138              if (err("Create: error creating edges",rc,-32) .LT. 0) return
2139           endif
2140     
2141     ! Set attributes for dimensions.
2142     
2143           call ncaptc (fid,lonid(ig),'long_name',NCCHAR,LEN_TRIM(lonName), &
2144                       lonName,rc)
2145           if (err("Create: error creating lon attribute",rc,-33) .LT. 0) &
2146             return
2147           call ncaptc (fid,lonid(ig),'units',NCCHAR,LEN_TRIM(lonUnits), &
2148                       lonUnits,rc)
2149           if (err("Create: error creating lon attribute",rc,-33) .LT. 0)  &
2150             return
2151     
2152           call ncaptc (fid,latid(ig),'long_name',NCCHAR,LEN_TRIM(latName),&
2153                       latName,rc)
2154           if (err("Create: error creating lat attribute",rc,-33) .LT. 0) &
2155             return
2156           call ncaptc (fid,latid(ig),'units',NCCHAR,LEN_TRIM(latUnits),&
2157                       latUnits,rc)
2158           if (err("Create: error creating lat attribute",rc,-33) .LT. 0) &
2159             return
2160     
2161           if ( trim(cfio%grids(ig)%standardName) .eq. &
2162                'atmosphere_hybrid_sigma_pressure_coordinate' ) then
2163              call ncaptc (fid,layerid(ig),'long_name',NCCHAR,LEN_TRIM(layerName),&
2164                         layerName,rc)
2165              if (err("Create: error creating layer attribute",rc,-33) .LT. 0)&
2166                 return
2167              call ncaptc (fid,layerid(ig),'units',NCCHAR,LEN_TRIM(layerUnits),&
2168                           layerUnits, rc)
2169              if (err("Create: error creating layer attribute",rc,-33) .LT. 0)&
2170                return
2171           endif
2172           if (.NOT. surfaceOnly) then
2173             call ncaptc (fid,levid(ig),'long_name',NCCHAR,LEN_TRIM(levName),&
2174                         levName,rc)
2175             if (err("Create: error creating lev attribute",rc,-33) .LT. 0)&
2176                return
2177             call ncaptc (fid,levid(ig),'units',NCCHAR,LEN_TRIM(levunits),&
2178                         levunits,rc)
2179             if (err("Create: error creating lev attribute",rc,-33) .LT. 0)&
2180                return
2181             call ncaptc (fid,levid(ig),'positive',NCCHAR,LEN_TRIM('down'),&
2182                         'down',rc)
2183             if (err("Create: error creating lev attribute",rc,-33) .LT. 0)&
2184                return
2185             call ncaptc (fid,levid(ig),'coordinate',NCCHAR,LEN_TRIM(  & 
2186                          cfio%grids(ig)%coordinate), cfio%grids(ig)%coordinate &
2187                          , rc)
2188             if (err("Create: error creating lev attribute",rc,-33) .LT. 0)&
2189                return
2190             call ncaptc (fid,levid(ig),'standard_name',NCCHAR,LEN_TRIM(  & 
2191                          cfio%grids(ig)%standardName),cfio%grids(ig)%standardName&
2192                          , rc)
2193             if (err("Create: error creating lev attribute",rc,-33) .LT. 0)&
2194                return
2195             if ( len(cfio%grids(ig)%formulaTerm) .gt. 0 .and. &
2196                  trim(cfio%grids(ig)%formulaTerm) .ne. 'unknown') then
2197                call ncaptc (fid,levid(ig),'formula_term',NCCHAR,LEN_TRIM(  & 
2198                          cfio%grids(ig)%formulaTerm), cfio%grids(ig)%formulaTerm &
2199                          , rc)
2200                if (err("Create: error creating lev attribute",rc,-33) .LT. 0)&
2201                return
2202             end if
2203           endif
2204     ! end of mGrid loop
2205       end do
2206     
2207           timedim = ncddef(fid, 'time', NCUNLIM, rc)
2208           if (err("Create: error defining time",rc,-31) .LT. 0) return
2209           if ( aveFile ) then
2210              bndsdim = ncddef(fid, 'nv', 2, rc)
2211              if (err("Create: error defining time bounds",rc,-31) .LT. 0)&
2212                   return
2213           end if
2214           do ig =1, cfio%mGrids
2215             if ( trim(cfio%grids(ig)%standardName) .eq.           &
2216                'atmosphere_hybrid_sigma_pressure_coordinate' .or. &
2217                  trim(cfio%grids(ig)%standardName) .eq.           &
2218                'atmosphere_sigma_coordinate' ) then
2219                 if (ig .eq. 1) then
2220                   if (cfio%mGrids .eq. 1) then
2221                      ptopdim = ncddef (fid, "ptop", 1, rc)
2222                   else
2223                      ptopdim = ncddef (fid, "ptop0", 1, rc)
2224                   end if
2225                 end if
2226             endif
2227           end do
2228     
2229           timeid = ncvdef (fid, 'time', NCLONG, 1, timedim, rc)
2230           if (err("Create: error creating time",rc,-32) .LT. 0) return
2231           call ncaptc (fid, timeid, 'long_name', NCCHAR, LEN_TRIM(timeName),&
2232                       timeName, rc)
2233           if (err("Create: error creating time attribute",rc,-33) .LT. 0)&
2234             return
2235     
2236     !ams       write (dateString,200) yyyymmdd_beg, hhmmss_beg
2237     !ams 200   format (I8,I6)
2238     !ams       read (dateString,201) year,mon,day,hour,min,sec
2239     !ams 201   format (I4,5I2)
2240     
2241           call CFIO_parseIntTime ( yyyymmdd_beg, year, mon, day )
2242           call CFIO_parseIntTime ( hhmmss_beg, hour,min,sec )
2243     
2244           write (timeUnits,202) year,mon,day,hour,min,sec
2245     202   format ('minutes since ',I4.4,'-',I2.2,'-',I2.2,' ',I2.2,':', &
2246                   I2.2,':',I2.2)
2247           call ncaptc (fid, timeid, 'units', NCCHAR, LEN_TRIM(timeUnits),  &
2248                       timeUnits, rc)
2249           if (err("Create: error creating time attribute",rc,-33) .LT. 0) &
2250             return
2251           
2252     !ams       write (strBuf,203) timinc
2253     !ams 203   format (I6)
2254     !ams       read (strBuf,204) hour, min, sec
2255     !ams 204   format (3I2)
2256     
2257           call CFIO_parseIntTime ( timinc, hour, min, sec ) 
2258     
2259           if ( sec .NE. 0) then
2260             print *, 'CFIO_Create: Time increments not on minute', &
2261                     ' boundaries are not currently allowed.'
2262             rc = -18
2263             return
2264           endif
2265           call ncapt (fid, timeid, 'time_increment', NCLONG, 1, timInc, rc)
2266           if (err("Create: error creating time attribute",rc,-33) .LT. 0) &
2267             return
2268           call ncapt (fid,timeid,'begin_date',NCLONG,1,yyyymmdd_beg,rc)
2269           if (err("Create: error creating time attribute",rc,-33) .LT. 0) &
2270             return
2271           call ncapt (fid,timeid,'begin_time',NCLONG,1,hhmmss_beg,rc)
2272           if (err("Create: error creating time attribute",rc,-33) .LT. 0) &
2273             return
2274     
2275           if ( aveFile ) then
2276              call ncapt (fid,timeid,'bounds',NCCHAR,9,'time_bnds',rc)
2277              if (err("Create: error creating time attribute",rc,-33) .LT. 0) &
2278                  return
2279           end if
2280     
2281       do ig = 1, cfio%mGrids
2282           im = cfio%grids(ig)%im
2283           jm = cfio%grids(ig)%jm
2284           km = cfio%grids(ig)%km
2285           if ( index(cfio%grids(ig)%gName, 'station') .gt. &
2286                0 ) then
2287              if (im .ne. jm) rtcode = err("It isn't station grid",-1,-1)
2288              nst = im
2289           end if
2290     
2291           gDims3D(4,ig) = timedim
2292           gDims3D(3,ig) = levdim(ig)
2293           gDims3D(2,ig) = latdim(ig)
2294           gDims3D(1,ig) = londim(ig)
2295           
2296           gDims2D(3,ig) = timedim
2297           gDims2D(2,ig) = latdim(ig)
2298           gDims2D(1,ig) = londim(ig)
2299     
2300           if (index(cfio%grids(ig)%gName,'station') .gt. 0) then
2301              gDims3D(4,ig) = 0
2302              gDims3D(3,ig) = timedim
2303              gDims3D(2,ig) = levdim(ig)
2304              gDims3D(1,ig) = stationdim(ig)
2305           
2306              gDims2D(3,ig) = 0
2307              gDims2D(2,ig) = timedim
2308              gDims2D(1,ig) = stationdim(ig)
2309           end if
2310     
2311           if ( ig .eq. 1 ) then
2312              if (cfio%mGrids .eq. 1) then
2313                nameAk = 'ak'
2314                nameBk = 'bk'
2315                namePtop = 'ptop'
2316              else
2317                nameAk = 'ak0'
2318                nameBk = 'bk0'
2319                namePtop = 'ptop0'
2320              end if
2321           else
2322             write (cig,"(I1)") ig-1
2323             nameAk = 'ak'//cig
2324             nameBk = 'bk'//cig
2325             namePtop = 'ptop'//cig
2326           end if
2327     
2328           if ( trim(cfio%grids(ig)%standardName) .eq. &
2329                'atmosphere_hybrid_sigma_pressure_coordinate' ) then
2330     
2331              dims1D = layerdim(ig)
2332     
2333              akid(ig) = ncvdef (fid, nameAk, NCFLOAT, 1, dims1D, rc)
2334              call ncaptc (fid,akid(ig),'long_name',NCCHAR,34,&
2335                          'ak component of hybrid coordinate',rc)
2336              if (err("Create: error creating ak attribute",rc,-33) .LT. 0)&
2337                 return
2338              call ncaptc (fid,akid(ig),'units',NCCHAR,14,&
2339                          'dimensionless',rc)
2340              if (err("Create: error creating ak attribute",rc,-33) .LT. 0)&
2341                 return
2342     
2343              bkid(ig) = ncvdef (fid, nameBk, NCFLOAT, 1, dims1D, rc)
2344              call ncaptc (fid,bkid(ig),'long_name',NCCHAR,34,&
2345                          'bk component of hybrid coordinate',rc)
2346              if (err("Create: error creating bk attribute",rc,-33) .LT. 0)&
2347                 return
2348              call ncaptc (fid,bkid(ig),'units',NCCHAR,14,&
2349                          'dimensionless',rc)
2350              if (err("Create: error creating bk attribute",rc,-33) .LT. 0)&
2351                 return
2352     
2353              ptopid(ig) = ncvdef (fid, namePtop, NCFLOAT, 1, ptopdim, rc)
2354              if (err("Create: error define ptopid",rc,-34) .LT. 0) return
2355              call ncaptc (fid,ptopid(ig),'long_name',NCCHAR,36,&
2356                          'ptop component of hybrid coordinate',rc)
2357              if (err("Create: error creating ptop attribute",rc,-33) .LT. 0)&
2358                 return
2359              call ncaptc (fid,ptopid(ig),'units',NCCHAR,       &
2360                           len(trim(cfio%grids(ig)%ptopUnit)), &
2361                          trim(cfio%grids(ig)%ptopUnit),rc)
2362              if (err("Create: error creating ptop attribute",rc,-33) .LT. 0)&
2363                 return
2364           end if
2365     
2366           if ( trim(cfio%grids(ig)%standardName) .eq. &
2367                'atmosphere_sigma_coordinate' ) then
2368              ptopid(ig) = ncvdef (fid, namePtop, NCFLOAT, 1, ptopdim, rc)
2369              if (err("Create: error define ptopid",rc,-34) .LT. 0) return
2370              call ncaptc (fid,ptopid(ig),'long_name',NCCHAR,36,&
2371                          'ptop component of sigma coordinate',rc)
2372              if (err("Create: error creating ptop attribute",rc,-33) .LT. 0)&
2373                 return
2374              call ncaptc (fid,ptopid(ig),'units',NCCHAR,      &
2375                          len(trim(cfio%grids(ig)%ptopUnit)), &
2376                          trim(cfio%grids(ig)%ptopUnit),rc)
2377              if (err("Create: error creating ptop attribute",rc,-33) .LT. 0)&
2378                 return
2379           end if
2380     
2381     ! end of mGrids loop
2382       end do
2383     
2384           scale_32 = 1.0     ! No packing for now.
2385           offset_32 = 0.0    ! No packing for now.
2386     
2387     ! Set up packing attributes for each variable.  
2388     ! Define physical variables.  Set attributes for physical variables.
2389     
2390           do i=1,nvars
2391             scale_32 = 1.0                        ! default to no packing.
2392             offset_32 = 0.0
2393             if (pRange_32(1,i) .NE. amiss_32 .OR. pRange_32(2,i) .NE.  &
2394            amiss_32) then
2395               if (pRange_32(1,i) .GT. pRange_32(2,i)) then
2396                 high_32 = pRange_32(1,i)
2397                 low_32  = pRange_32(2,i)
2398               else
2399                 high_32 = pRange_32(2,i)
2400                 low_32  = pRange_32(1,i)
2401               endif
2402               scale_32 = (high_32 - low_32)/PACK_BITS*2
2403               offset_32 = high_32 - scale_32*PACK_BITS
2404               if (scale_32 .EQ. 0.0) then              ! If packing range is 0,
2405                  scale_32 = 1.0                        ! no packing.
2406                  offset_32 = 0.0
2407                  packflag = .FALSE.
2408               else
2409                  packflag = .TRUE.
2410               endif
2411             else
2412               packflag = .FALSE.
2413             endif
2414             do ig = 1, cfio%mGrids
2415                if (trim(cfio%varObjs(i)%grid%gName) .eq.              &
2416                    trim(cfio%grids(ig)%gName)) then
2417                   dims3D = gDims3D(:,ig)
2418                   dims2D = gDims2D(:,ig)
2419                end if
2420             end do
2421             if ( kmvar(i) .eq. 0 ) then
2422               ndim = 3
2423               if (index(cfio%varObjs(i)%grid%gName,'station') .gt. 0) ndim = 2
2424               if (packflag) then
2425                 vid(i) = ncvdef (fid, vname(i), NCSHORT, ndim, dims2D, rc)
2426               else if (cfio%prec .EQ. 1) then
2427                 vid(i) = ncvdef (fid, vname(i), NCDOUBLE, ndim, dims2D, rc)
2428               else
2429                 vid(i) = ncvdef (fid, vname(i), NCFLOAT, ndim, dims2D, rc)
2430               endif
2431             else
2432               ndim = 4
2433               if (index(cfio%varObjs(i)%grid%gName,'station') .gt. 0) ndim = 3
2434               if (packflag) then
2435                 vid(i) = ncvdef (fid, vname(i), NCSHORT, ndim, dims3D, rc)
2436               else if (cfio%prec .EQ. 1) then
2437                 vid(i) = ncvdef (fid, vname(i), NCDOUBLE, ndim, dims3D, rc)
2438               else
2439                 vid(i) = ncvdef (fid, vname(i), NCFLOAT, ndim, dims3D, rc)
2440               endif
2441             endif
2442             if (err("Create: error defining variable",rc,-34) .LT. 0)  &
2443              return
2444     #if defined(HAS_NETCDF4)
2445             if (cfio%deflate > 0 .and. cfio%deflate <= 9) then
2446                rc = nf_def_var_deflate(fid, vid(i), 1, 1, cfio%deflate)
2447                if (err("Create: error setting deflate filter",rc,-40) .LT. 0) return
2448             end if
2449     ! enable error checking
2450     !        rc = nf_def_var_fletcher32(fid, vid(i), 1)
2451     !        if (err("Create: error setting fletcher",rc,-41) .LT. 0) return
2452     #endif
2453     
2454             call ncaptc (fid, vid(i), 'long_name', NCCHAR,  &
2455                         LEN_TRIM(vtitle(i)),vtitle(i), rc)
2456             if (err("Create: error defining long_name attribute",rc,-35) &
2457               .LT. 0) return
2458             call ncaptc (fid, vid(i), 'units', NCCHAR,  &
2459                         LEN_TRIM(vunits(i)),vunits(i), rc)
2460             if (err("Create: error defining units attribute",rc,-35) &
2461               .LT. 0) return
2462     
2463             if (packflag) then
2464               call ncapt (fid,vid(i),'_FillValue',NCFLOAT,1,amiss_32,rc)
2465               if (err("Create: error defining FillValue attribute",rc,-35) &
2466               .LT. 0) return
2467               if ( scale_32 .ne. 1.0 .or. offset_32 .ne. 0.0 ) then
2468               call ncapt (fid,vid(i),'scale_factor',NCFLOAT,1,scale_32,rc)
2469               if (err("Create: error defining scale_factor attribute",rc,-35) &
2470                   .LT. 0) return
2471               call ncapt (fid,vid(i),'add_offset',NCFLOAT,1,offset_32,rc)
2472               if (err("Create: error defining add_offset attribute",rc,-35) &
2473                   .LT. 0) return
2474               call ncapt (fid,vid(i),'packmin',NCFLOAT,1,low_32,rc)
2475               if (err("Create: error defining packmin attribute",rc,-35)  &
2476                  .LT. 0) return
2477               call ncapt (fid,vid(i),'packmax',NCFLOAT,1,high_32,rc)
2478               if (err("Create: error defining packmax attribute",rc,-35) &
2479                  .LT. 0) return
2480               end if
2481               call ncapt (fid,vid(i),'missing_value',NCSHORT,1,amiss_16,rc)
2482               if (err("Create: error defining missing_value attribute",rc,-35) &
2483               .LT. 0) return
2484               call ncapt (fid,vid(i),'fmissing_value',NCFLOAT,1,amiss_32,rc)
2485               if (err("Create: error defining fmissing_value attribute",rc,-35) &
2486               .LT. 0) return
2487             else
2488               call ncapt (fid,vid(i),'_FillValue',NCFLOAT,1,amiss_32,rc)
2489               if (err("Create: error defining FillValue attribute",rc,-35) &
2490               .LT. 0) return
2491               if ( scale_32 .ne. 1.0 .or. offset_32 .ne. 0.0 ) then
2492               call ncapt (fid,vid(i),'scale_factor',NCFLOAT,1,scale_32,rc)
2493               if (err("Create: error defining scale_factor attribute",rc,-35) &
2494                   .LT. 0) return
2495               call ncapt (fid,vid(i),'add_offset',NCFLOAT,1,offset_32,rc)
2496               if (err("Create: error defining add_offset attribute",rc,-35) &
2497                   .LT. 0) return
2498               end if
2499               call ncapt (fid,vid(i),'missing_value',NCFLOAT,1,amiss_32,rc)
2500               if (err("Create: error defining missing_value attribute",rc,-35) &
2501               .LT. 0) return
2502               call ncapt (fid,vid(i),'fmissing_value',NCFLOAT,1,amiss_32,rc)
2503               if (err("Create: error defining fmissing_value attribute",rc,-35) &
2504               .LT. 0) return
2505     
2506     ! ADDED BY BYIN for more variable meta data
2507              cfio%fid = fid
2508     !        get real variable attributes from rList
2509              do iCnt = 1, cfio%mVars
2510                 if ( associated(cfio%varObjs(i)%rList) ) then
2511                    call getMaxLenCnt(maxLen, cfio%varObjs(i)%nVarAttReal, &
2512                                      rList=cfio%varObjs(i)%rList)
2513                    count = cfio%varObjs(i)%nVarAttReal
2514                    allocate(cfio%varObjs(i)%attRealNames(count),     &
2515                          cfio%varObjs(i)%attRealCnts(count),      &
2516                          cfio%varObjs(i)%varAttReals(count,maxLen), stat=rtcode)
2517                    call getList(rList=cfio%varObjs(i)%rList,    &
2518                            realAttNames=cfio%varObjs(i)%attRealNames, &
2519                            realAttCnts=cfio%varObjs(i)%attRealCnts,   &
2520                            realAtts=cfio%varObjs(i)%varAttReals)
2521                 end if
2522              end do
2523     
2524     !        write real variable attributes to output file
2525              do iCnt = 1, cfio%varObjs(i)%nVarAttReal
2526                 allocate(realVarAtt(size(cfio%varObjs(i)%varAttReals)/ &
2527                          cfio%varObjs(i)%nVarAttReal), stat=rc)
2528                 realVarAtt = cfio%varObjs(i)%varAttReals(iCnt,:)
2529                 if (cfio%varObjs(i)%attRealCnts(iCnt) .ne. size(realVarAtt)) then
2530                   rc=err("FileCreate: Num of real var elements and Cnt differ",-39,-39) 
2531                   return
2532                 end if
2533                 call ncapt (cfio%fid,vid(i),cfio%varObjs(i)%attRealNames(iCnt),&
2534                             NCFLOAT, cfio%varObjs(i)%attRealCnts(iCnt),        &
2535                             realVarAtt, rc)
2536                 if (err("FileCreate: error from ncapt for real att",rc,-35) &
2537                     .LT. 0) return
2538                 deallocate(realVarAtt)
2539              end do
2540     
2541     !        get integer variable attributes from iList
2542              do iCnt = 1, cfio%mVars
2543                 if ( associated(cfio%varObjs(i)%iList) ) then
2544                    call getMaxLenCnt(maxLen, cfio%varObjs(i)%nVarAttInt, &
2545                                      iList=cfio%varObjs(i)%iList)
2546                    count = cfio%varObjs(i)%nVarAttInt
2547                    allocate(cfio%varObjs(i)%attIntNames(count),     &
2548                          cfio%varObjs(i)%attIntCnts(count),      &
2549                          cfio%varObjs(i)%varAttInts(count,maxLen), stat=rtcode)
2550                    call getList(iList=cfio%varObjs(i)%iList,    &
2551                            intAttNames=cfio%varObjs(i)%attIntNames, &
2552                            intAttCnts=cfio%varObjs(i)%attIntCnts,   &
2553                            intAtts=cfio%varObjs(i)%varAttInts)
2554                 end if
2555              end do
2556     
2557     !        write int variable attributes to output file
2558              do iCnt = 1, cfio%varObjs(i)%nVarAttInt
2559                 allocate(intVarAtt(size(cfio%varObjs(i)%varAttInts)/ &
2560                          cfio%varObjs(i)%nVarAttInt), stat=rc)
2561                 intVarAtt = cfio%varObjs(i)%varAttInts(iCnt,:)
2562                 if (cfio%varObjs(i)%attIntCnts(iCnt) .gt. size(intVarAtt)) then
2563                   rc=err("FileCreate: Num of int var elements and Cnt differ",-39,-39) 
2564                   return
2565                 end if
2566                 call ncapt (cfio%fid,vid(i),cfio%varObjs(i)%attIntNames(iCnt),&
2567                             NCLONG, cfio%varObjs(i)%attIntCnts(iCnt),         &
2568                             intVarAtt, rc)
2569                 if (err("FileCreate: error from ncapt for int att",rc,-35) &
2570                     .LT. 0) return
2571                 deallocate(intVarAtt)
2572              end do
2573     
2574     !        get char variable attributes from cList
2575              do iCnt = 1, cfio%mVars
2576                 if ( associated(cfio%varObjs(i)%cList) ) then
2577                    call getMaxLenCnt(maxLen, cfio%varObjs(i)%nVarAttChar, &
2578                                      cList=cfio%varObjs(i)%cList)
2579                    count = cfio%varObjs(i)%nVarAttChar
2580                    allocate(cfio%varObjs(i)%attCharNames(count),     &
2581                          cfio%varObjs(i)%attCharCnts(count),      &
2582                          cfio%varObjs(i)%varAttChars(count), stat=rtcode)
2583                    call getList(cList=cfio%varObjs(i)%cList,    &
2584                            charAttNames=cfio%varObjs(i)%attCharNames, &
2585                            charAttCnts=cfio%varObjs(i)%attCharCnts,   &
2586                            charAtts=cfio%varObjs(i)%varAttChars)
2587                 end if
2588              end do
2589     
2590     !        write char variable attributes to output file
2591              do iCnt = 1, cfio%varObjs(i)%nVarAttChar
2592                 call ncapt (cfio%fid,vid(i),cfio%varObjs(i)%attCharNames(iCnt),&
2593                             NCCHAR, cfio%varObjs(i)%attCharCnts(iCnt),         &
2594                             cfio%varObjs(i)%varAttChars(iCnt), rc)
2595                 if (err("FileCreate: error from ncapt for char att",rc,-35) &
2596                     .LT. 0) return
2597              end do
2598     
2599     !         write scaleFactor, addOffSet, and standardName to output
2600     
2601     !         if ( cfio%varObjs(i)%scaleFactor /= 0 ) then
2602                 scale_factor = cfio%varObjs(i)%scaleFactor 
2603                 call ncapt (cfio%fid, vid(i), 'scale_factor', NCFLOAT,   &
2604                             1, scale_factor, rc)
2605                 if (err("FileCreate: error from ncapt for scale_factor",rc,-35) &
2606                     .LT. 0) return
2607     !         end if
2608     !         if ( cfio%varObjs(i)%addOffSet /= 0 ) then
2609                 add_offset = cfio%varObjs(i)%addOffSet   
2610                 call ncapt (cfio%fid, vid(i), 'add_offset', NCFLOAT,   &
2611                             1, add_offset, rc)
2612                 if (err("FileCreate: error from ncapt for add_offset",rc,-35) &
2613                     .LT. 0) return
2614     !           end if
2615                   
2616              if ( LEN_TRIM(cfio%varObjs(i)%standardName) .gt. 0 ) then
2617                 call ncaptc (cfio%fid, vid(i), 'standard_name', NCCHAR,   &
2618                             LEN_TRIM(cfio%varObjs(i)%standardName),       &
2619                             cfio%varObjs(i)%standardName, rc)
2620                 if (err("FileCreate: error from ncapt for standard_name",rc,-35) &
2621                     .LT. 0) return
2622              end if
2623             end if
2624     
2625             if (vRange_32(1,i) .NE. amiss_32 .OR. vRange_32(2,i) .NE.  &
2626                amiss_32) then
2627               if (vRange_32(1,i) .GT. vRange_32(2,i)) then
2628                 high_32 = vRange_32(1,i)
2629                 low_32  = vRange_32(2,i)
2630               else
2631                 high_32 = vRange_32(2,i)
2632                 low_32  = vRange_32(1,i)
2633               endif
2634               call ncapt (fid,vid(i),'vmin',NCFLOAT,1,low_32,rc)
2635               if (err("Create: error defining vmin attribute",rc,-35) &
2636                  .LT. 0) return
2637               call ncapt (fid,vid(i),'vmax',NCFLOAT,1,high_32,rc)
2638               if (err("Create: error defining vmax attribute",rc,-35) &
2639                  .LT. 0) return
2640             else
2641               call ncapt (fid,vid(i),'vmin',NCFLOAT,1,amiss_32,rc)
2642               if (err("Create: error defining vmin attribute",rc,-35) &
2643                  .LT. 0) return
2644               call ncapt (fid,vid(i),'vmax',NCFLOAT,1,amiss_32,rc)
2645               if (err("Create: error defining vmax attribute",rc,-35) &
2646                  .LT. 0) return
2647     
2648             endif
2649     
2650             call ncapt (fid,vid(i),'valid_range',NCFLOAT,2,vRange_32(:,i),rc)
2651             if (err("Create: error defining valid_range attribute",rc,-35) &
2652                .LT. 0) return
2653     
2654             if ( cfio%varObjs(i)%timAve ) then
2655                call ncaptc (fid, vid(i), 'cell_methods', NCCHAR,  &
2656                         len(trim(cfio%varObjs(i)%cellMthd))+6,     &
2657                         'time: '//trim(cfio%varObjs(i)%cellMthd), rc)
2658                if (err("Create: error defining cell_methods attribute",rc,-35) &
2659                        .LT. 0) return
2660             end if
2661           enddo
2662      
2663           if ( aveFile ) then
2664              dimsbnd(1) = bndsdim
2665              dimsbnd(2) = timedim
2666              bndsid = ncvdef (fid, 'time_bnds', NCFLOAT, 2, dimsbnd, rc)
2667           end if
2668     
2669     ! Exit define mode.
2670     
2671           call ncendf (fid, rc)
2672           if (err("Create: error exiting define mode",rc,-37) .LT. 0)  &
2673            return
2674     
2675     ! Write out dimension variables.
2676     
2677       do ig = 1, cfio%mGrids
2678           im = cfio%grids(ig)%im
2679           jm = cfio%grids(ig)%jm
2680           km = cfio%grids(ig)%km
2681     
2682           allocate(lon_64(im), lat_64(jm), levs_64(km), ak_32(km+1),         &
2683                 bk_32(km+1), layer(km+1), stat = rtcode) 
2684     
2685           ptop_32(1) = cfio%grids(ig)%ptop
2686           do i=1,im
2687              lon_64(i) = cfio%grids(ig)%lon(i)
2688           enddo
2689           do i=1,jm
2690              lat_64(i) = cfio%grids(ig)%lat(i)
2691           enddo
2692           do i=1,km
2693              levs_64(i) = cfio%grids(ig)%lev(i)
2694           enddo
2695           if ( trim(cfio%grids(ig)%standardName) .eq. &
2696                'atmosphere_hybrid_sigma_pressure_coordinate' ) then
2697              if (associated(cfio%grids(ig)%ak) .and. &
2698                  associated(cfio%grids(ig)%bk) ) then
2699                 do i=1,km+1
2700                    layer(i) = i
2701                    ak_32(i) = cfio%grids(ig)%ak(i)
2702                    bk_32(i) = cfio%grids(ig)%bk(i)
2703                 enddo
2704              else
2705                  if (err(": ak or bk is not set",-1,-1) .lt. 0 ) return
2706              end if
2707           end if
2708     
2709           corner(1) = 1
2710           edges(1) = im
2711           call ncvpt (fid, lonid(ig), corner, edges, lon_64, rc)
2712           if (err("Create: error writing lons",rc,-38) .LT. 0) return
2713           deallocate(lon_64, stat = rtcode)
2714     
2715           corner(1) = 1
2716           edges(1) = jm
2717           call ncvpt (fid, latid(ig), corner, edges, lat_64, rc)
2718           if (err("Create: error writing lats",rc,-38) .LT. 0) return
2719           deallocate(lat_64, stat = rtcode)
2720     
2721           if (.NOT. surfaceOnly) then
2722             corner(1) = 1
2723             edges(1) = km
2724             call ncvpt (fid, levid(ig), corner, edges, levs_64, rc)
2725             if (err("Create: error writing levs",rc,-38) .LT. 0) return
2726           endif
2727           deallocate(levs_64, stat = rtcode)
2728     
2729           if ( trim(cfio%grids(ig)%standardName) .eq. &
2730                'atmosphere_hybrid_sigma_pressure_coordinate' ) then
2731             corner(1) = 1
2732             edges(1) = 1
2733             call ncvpt (fid, ptopid(ig), corner, edges, ptop_32, rc)
2734             corner(1) = 1
2735             edges(1) = km+1
2736             call ncvpt (fid, layerid(ig), corner, edges, layer, rc)
2737             if (err("Create: error writing layers",rc,-38) .LT. 0) return
2738             call ncvpt (fid, akid(ig), corner, edges, ak_32, rc)
2739             call ncvpt (fid, bkid(ig), corner, edges, bk_32, rc)
2740           endif
2741           deallocate(layer, stat = rtcode)
2742           deallocate(ak_32, stat = rtcode)
2743           deallocate(bk_32, stat = rtcode)
2744     
2745           if ( trim(cfio%grids(ig)%standardName) .eq. &
2746                'atmosphere_sigma_coordinate' ) then
2747             corner(1) = 1
2748             edges(1) = 1
2749             call ncvpt (fid, ptopid(ig), corner, edges, ptop_32, rc)
2750           endif
2751     
2752     ! end of mGrids loop
2753      end do
2754           corner(1) = 1
2755           edges(1) = 1
2756           call ncvpt (fid, timeid, corner, edges, 0, rc)
2757           if (err("Create: error writing times",rc,-38) .LT. 0) return
2758     
2759           deallocate(latid, stat = rtcode)
2760           deallocate(lonid, stat = rtcode)
2761           deallocate(levid, stat = rtcode)
2762           deallocate(layerid, stat = rtcode)
2763           deallocate(levid, stat = rtcode)
2764           deallocate(layerid, stat = rtcode)
2765           deallocate(latdim, stat = rtcode)
2766           deallocate(londim, stat = rtcode)
2767           deallocate(levdim, stat = rtcode)
2768           deallocate(layerdim, stat = rtcode)
2769           deallocate(akid, stat = rtcode)
2770           deallocate(bkid, stat = rtcode)
2771           deallocate(ptopid, stat = rtcode)
2772           deallocate(gDims3D, stat = rtcode)
2773           deallocate(gDims2D, stat = rtcode)
2774           deallocate(stationdim, stat = rtcode)
2775           deallocate(stationid, stat = rtcode)
2776     
2777           deallocate(station, stat = rtcode)
2778           deallocate(vname, stat = rtcode)
2779           deallocate(vtitle, stat = rtcode)
2780           deallocate(vunits, stat = rtcode)
2781           deallocate(kmvar, stat = rtcode)
2782           deallocate(valid_range, stat = rtcode)
2783           deallocate(packing_range, stat = rtcode)
2784           deallocate(vid, stat = rtcode)
2785           deallocate(vRange_32, stat = rtcode)
2786           deallocate(pRange_32, stat = rtcode)
2787     
2788           rc=0
2789           return
2790           end subroutine CFIO_Create_
2791     
2792     
2793     !------------------------------------------------------------------------------
2794     !BOP
2795     ! !ROUTINE: writeBnds -- write time bounds
2796     
2797     ! !INTERFACE:
2798           subroutine writeBnds(cfio, vName, date, curTime, rc)
2799     !
2800     ! !ARGUMENTS:
2801     !
2802     ! !INPUT PARAMETERS:
2803     !
2804           type (ESMF_CFIO), intent(in) :: cfio
2805           character(len=*), intent(in) :: vName
2806           integer, intent(in) :: date 
2807           integer, intent(in) :: curTime
2808     !
2809     ! !OUTPUT PARAMETERS:
2810     !
2811           integer, intent(out), OPTIONAL :: rc      ! Error return code:
2812                                                     ! 0   all is well
2813                                                     ! 1   ...
2814     !
2815     !
2816     ! !DESCRIPTION:
2817     !     write time bounds for time averaging variable
2818     !EOP
2819     !------------------------------------------------------------------------------
2820     
2821           integer :: vid, corner(4), edges(4)
2822           integer :: hour, min, sec, incSecs, timeIndex
2823           integer :: seconds, timeinc, curSecs
2824           real*4 :: bndsdata(2)
2825           character*8 :: strBuf
2826           integer :: i, rtcode=0
2827     
2828     !     make sure user provides the right variable name
2829           do i = 1, cfio%mVars
2830              if ( trim(vName) .eq. trim(cfio%varObjs(i)%vName) ) exit
2831           end do
2832           if ( cfio%varObjs(i)%timAve ) then
2833              seconds = DiffDate (cfio%date, cfio%begTime, date, curTime)
2834              timeinc = cfio%timeInc
2835     
2836     !ams          write (strBuf,203) timeinc
2837     !ams 203      format (I6)
2838     !ams          read (strBuf,204) hour, min, sec
2839     !ams 204      format (3I2)
2840     
2841              call CFIO_parseIntTime ( timeinc, hour, min, sec ) 
2842     
2843              incSecs = hour*3600 + min*60 + sec
2844     
2845     !ams         write (strBuf,203) curTime
2846     !ams         read (strBuf,204) hour, min, sec
2847     
2848              call CFIO_parseIntTime ( curTime, hour, min, sec ) 
2849     
2850              curSecs = hour*3600 + min*60 + sec
2851                                                                          
2852              timeIndex = seconds/incSecs + 1
2853              corner(1) = 1
2854              corner(2) = timeIndex
2855              edges(1) = 2
2856              edges(2) = 1
2857              bndsdata(1) = (-incSecs + curSecs)/60.
2858              bndsdata(2) = curSecs/60.
2859              if ( cfio%varObjs(i)%aveMethod .eq. 'c' ) then
2860                 bndsdata(1) = (-incSecs/2. + curSecs)/60.
2861                 bndsdata(2) = (incSecs/2. + curSecs)/60.
2862              end if
2863              if ( cfio%varObjs(i)%aveMethod .eq. 'd' ) then
2864                 bndsdata(1) = curSecs/60.
2865                 bndsdata(2) = (incSecs + curSecs)/60.
2866              end if
2867      
2868              vid = ncvid (cfio%fid, 'time_bnds', rtcode)
2869              if ( rtcode .ne. 0 ) then 
2870                 print *, "ncvid failed in ncvid for time_bnds"
2871                 if ( present(rc) ) rc = rtcode
2872                 return
2873              end if
2874              call ncvpt (cfio%fid, vid, corner, edges, bndsdata, rtcode)
2875              if ( rtcode .ne. 0 ) then 
2876                 print *, "ncvid failed in ncvpt for time_bnds"
2877                 if ( present(rc) ) rc = rtcode
2878                 return
2879              end if
2880           end if
2881      
2882           if ( present(rc) ) rc = rtcode
2883     
2884           end subroutine writeBnds
2885     
2886     !------------------------------------------------------------------------------
2887     !BOP
2888     ! !ROUTINE: ESMF_CFIOSdfVarReadT3D_ -- Read a variable from an existing file
2889                                                                                                                   
2890     ! !INTERFACE:
2891           subroutine ESMF_CFIOSdfVarReadT3D_ ( cfio, vName, field, &
2892                                             timeString, cfio2, rc )
2893     !
2894     ! !ARGUMENTS:
2895     !
2896     ! !INPUT PARAMETERS:
2897     !
2898           type(ESMF_CFIO), intent(inOut) :: cfio      ! a CFIO obj
2899           character(len=*), intent(in) :: vName       ! variable name
2900           type(ESMF_CFIO), intent(inOut), OPTIONAL :: cfio2  ! second CFIO obj
2901           character(len=*), intent(in) :: timeString
2902                                       ! string expression for date and time
2903                                                                                                             
2904     !
2905     ! !OUTPUT PARAMETERS:
2906     !
2907           real, pointer :: field(:,:,:)             ! array contains data
2908           integer, intent(out), OPTIONAL :: rc      ! Error return code:
2909                                                     ! 0   all is well
2910                              !  rc = -2  time is inconsistent with increment
2911                              !  rc = -3  number of levels is incompatible with file
2912                              !  rc = -4  im is incompatible with file
2913                              !  rc = -5  jm is incompatible with file
2914                              !  rc = -6  time must fall on a minute boundary
2915                              !  rc = -7  error in diffdate
2916                              !  rc = -12  error determining default precision
2917                              !  rc = -13  error determining variable type
2918                              !  rc = -19  unable to identify coordinate variable
2919                              !  rc = -38  error from ncvpt (dimension variable)
2920                              !  rc = -40  error from ncvid
2921                              !  rc = -41  error from ncdid or ncdinq (lat or lon)
2922                              !  rc = -42  error from ncdid or ncdinq (lev)
2923                              !  rc = -43  error from ncvid (time variable)
2924                              !  rc = -44  error from ncagt (time attribute)
2925                              !  rc = -46  error from ncvgt
2926                              !  rc = -48  error from ncinq
2927                              !  rc = -52  error from ncvinq
2928                              !  rc = -99  must specify date/curTime of timeString
2929     !
2930     ! !DESCRIPTION:
2931     !     Read a variable from an existing file
2932     !EOP
2933     !------------------------------------------------------------------------------
2934     
2935         integer :: date_, curTime_
2936     
2937     !     Resolve date/time
2938     !     -----------------
2939           date_ = -1
2940           curTime_ = -1
2941           call strToInt(timeString,date_,curTime_)
2942     
2943           if ( date_ < 0 .OR. curTime_ < 0 ) then
2944                if ( present(rc) ) rc = -99
2945                return
2946           end if
2947     
2948           call ESMF_CFIOSdfVarReadT3D__ ( cfio, vName, date_, curTime_, field, & 
2949                                        cfio2=cfio2, rc=rc )
2950     
2951         end subroutine ESMF_CFIOSdfVarReadT3D_
2952     
2953     !------------------------------------------------------------------------------
2954     !BOP
2955     ! !ROUTINE: ESMF_CFIOSdfVarReadT3D_ -- Read a variable from an existing file
2956                                                                                                                   
2957     ! !INTERFACE:
2958     
2959           subroutine ESMF_CFIOSdfVarReadT3D__(cfio, vName, date, curTime, field, rc, cfio2)
2960     !
2961     ! !ARGUMENTS:
2962     !
2963     ! !INPUT PARAMETERS:
2964     !
2965           type(ESMF_CFIO), intent(inOut) :: cfio      ! a CFIO obj
2966           character(len=*), intent(in) :: vName       ! variable name
2967           integer, intent(in) :: date                 ! yyyymmdd
2968           integer, intent(in) :: curTime              ! hhmmss
2969           type(ESMF_CFIO), intent(inOut), OPTIONAL :: cfio2  ! second CFIO obj
2970                                                                                                                   
2971     !
2972     ! !OUTPUT PARAMETERS:
2973     !
2974           real, pointer :: field(:,:,:)             ! array contains data
2975           integer, intent(out), OPTIONAL :: rc      ! Error return code:
2976                                                     ! 0   all is well
2977                              !  rc = -2  time is inconsistent with increment
2978                              !  rc = -3  number of levels is incompatible with file
2979                              !  rc = -4  im is incompatible with file
2980                              !  rc = -5  jm is incompatible with file
2981                              !  rc = -6  time must fall on a minute boundary
2982                              !  rc = -7  error in diffdate
2983                              !  rc = -12  error determining default precision
2984                              !  rc = -13  error determining variable type
2985                              !  rc = -19  unable to identify coordinate variable
2986                              !  rc = -38  error from ncvpt (dimension variable)
2987                              !  rc = -40  error from ncvid
2988                              !  rc = -41  error from ncdid or ncdinq (lat or lon)
2989                              !  rc = -42  error from ncdid or ncdinq (lev)
2990                              !  rc = -43  error from ncvid (time variable)
2991                              !  rc = -44  error from ncagt (time attribute)
2992                              !  rc = -46  error from ncvgt
2993                              !  rc = -48  error from ncinq
2994                              !  rc = -52  error from ncvinq
2995     !
2996     ! !DESCRIPTION:
2997     !     Read a variable from an existing file
2998     !EOP
2999     !------------------------------------------------------------------------------
3000     
3001           integer rtcode
3002           integer begDate, begTime, incSecs, timeIndex1, timeIndex2
3003           integer secs, secs1, secs2, nymd1, nymd2, nhms1, nhms2
3004           integer i, j, k
3005           integer im, jm, km
3006                                                                                              
3007           real    alpha, amiss
3008           real, pointer ::  field2(:,:,:) => null() ! workspace for interpolation
3009     
3010           rtcode = 0
3011     
3012     !     find the right variable obj.
3013           do i = 1, cfio%mVars
3014              if ( trim(vName) .eq. trim(cfio%varObjs(i)%vName) ) exit
3015           end do
3016           im = cfio%varObjs(i)%grid%im
3017           jm = cfio%varObjs(i)%grid%jm
3018           km = cfio%varObjs(i)%grid%km
3019           if (km .lt. 1) km = 1
3020     
3021           if ( .not. associated(field) ) allocate(field(im,jm,km))
3022     
3023     !     Get beginning time & date.  Calculate offset seconds from start.
3024     !     ----------------------------------------------------------------
3025           call GetBegDateTime ( cfio%fid, begDate, begTime, incSecs, rtcode )
3026           if (err("GetVar: could not determine begin_date/begin_time",rtcode,-44)&
3027              .NE. 0) go to 999
3028                                                                                              
3029           secs = DiffDate (begDate, begTime, date, curTime)
3030                                                                                              
3031     !      if (date .LT. begDate .OR. (begDate .EQ. date .AND.  &
3032     !         curTime .LT. begTime) .or. secs .LT. 0) then
3033     !         rc = -7
3034     !         return
3035     !      endif
3036      
3037     !     Determine brackting times
3038     !     -------------------------
3039           if ( secs >= 0 ) then
3040              timeIndex1 = secs/incSecs + 1
3041           else
3042              timeIndex1 = secs/incSecs
3043           end if
3044           timeIndex2 = timeIndex1 + 1
3045           secs1 = (timeIndex1-1) * incSecs
3046           secs2 = (timeIndex2-1) * incSecs
3047           call GetDate ( begDate, begTime, secs1, nymd1, nhms1, rtcode )
3048           call GetDate ( begDate, begTime, secs2, nymd2, nhms2, rtcode )
3049      
3050     !     Read grids at first time with GetVar()
3051     !     --------------------------------------
3052           call ESMF_CFIOSdfVarRead(cfio, vName, field, date=nymd1, curtime=nhms1,  rc=rtcode)
3053           if ( rtcode .ne. 0 ) goto 999
3054                                                                         
3055           if ( secs1 .eq. secs ) goto 999   ! no interpolation needed
3056     
3057           allocate(field2(im,jm,km))
3058                                                                                          
3059     !     Read grids at second time with GetVar()
3060     !     ---------------------------------------
3061           call ESMF_CFIOSdfVarRead(cfio, vName, field2, date=nymd2, curtime=nhms2, rc=rtcode)
3062           if ( rtcode .ne. 0 ) then
3063              if ( present(cfio2) )     &
3064                 call ESMF_CFIOSdfVarRead(cfio2, vName, field2, &
3065                                       date=nymd2, curtime=nhms2, rc=rtcode)
3066              if ( rtcode .ne. 0 ) return
3067           end if
3068                                                                                              
3069     !     Get missing value
3070     !     -----------------
3071           amiss = CFIO_GetMissing ( cfio%fid, rtcode )
3072           if ( rtcode .ne. 0 ) goto 999
3073     
3074     !     Do interpolation
3075     !     ----------------
3076           alpha = float(secs - secs1)/float(secs2 - secs1)
3077     !ams  print *, ' nymd = ', nymd1, nymd2
3078     !ams  print *, ' nhms = ', nhms1, nhms2
3079     !ams  print *, 'alpha = ', alpha
3080           do k = 1, km
3081              do j = 1, jm
3082                 do i = 1, im
3083                    if ( abs(field(i,j,k)-amiss) .gt. 0.001 .and.   &
3084                         abs(field2(i,j,k)-amiss) .gt. 0.001 ) then
3085                       field(i,j,k) = field(i,j,k)        &
3086                                  + alpha * (field2(i,j,k) - field(i,j,k))
3087                    else
3088                       field(i,j,k) = amiss
3089                    end if
3090                 end do
3091              end do
3092           end do
3093                                                             
3094           rtcode = 0
3095     
3096     !     All done
3097     !     --------
3098     999   continue
3099           if ( associated(field2) ) deallocate(field2)
3100           if ( present(rc) ) rc = rtcode
3101                                                                              
3102           end subroutine ESMF_CFIOSdfVarReadT3D__
3103     
3104     
3105     !------------------------------------------------------------------------------
3106     !BOP
3107     ! !ROUTINE: ESMF_CFIOSdfVarReadT2D_ -- Read a variable from an existing file
3108                                                                                                                   
3109     ! !INTERFACE:
3110           subroutine ESMF_CFIOSdfVarReadT2D_ ( cfio, vName, field, &
3111                                             timeString, cfio2, rc )
3112     !
3113     ! !ARGUMENTS:
3114     !
3115     ! !INPUT PARAMETERS:
3116     !
3117           type(ESMF_CFIO), intent(inOut) :: cfio      ! a CFIO obj
3118           character(len=*), intent(in) :: vName       ! variable name
3119           type(ESMF_CFIO), intent(inOut), OPTIONAL :: cfio2  ! second CFIO obj
3120           character(len=*), intent(in) :: timeString
3121                                       ! string expression for date and time
3122                                                                                                             
3123     !
3124     ! !OUTPUT PARAMETERS:
3125     !
3126           real, pointer :: field(:,:)               ! array contains data
3127           integer, intent(out), OPTIONAL :: rc      ! Error return code:
3128                                                     ! 0   all is well
3129                              !  rc = -2  time is inconsistent with increment
3130                              !  rc = -3  number of levels is incompatible with file
3131                              !  rc = -4  im is incompatible with file
3132                              !  rc = -5  jm is incompatible with file
3133                              !  rc = -6  time must fall on a minute boundary
3134                              !  rc = -7  error in diffdate
3135                              !  rc = -12  error determining default precision
3136                              !  rc = -13  error determining variable type
3137                              !  rc = -19  unable to identify coordinate variable
3138                              !  rc = -38  error from ncvpt (dimension variable)
3139                              !  rc = -40  error from ncvid
3140                              !  rc = -41  error from ncdid or ncdinq (lat or lon)
3141                              !  rc = -42  error from ncdid or ncdinq (lev)
3142                              !  rc = -43  error from ncvid (time variable)
3143                              !  rc = -44  error from ncagt (time attribute)
3144                              !  rc = -46  error from ncvgt
3145                              !  rc = -48  error from ncinq
3146                              !  rc = -52  error from ncvinq
3147                              !  rc = -99  must specify date/curTime of timeString
3148     !
3149     ! !DESCRIPTION:
3150     !     Read a variable from an existing file
3151     !EOP
3152     !------------------------------------------------------------------------------
3153     
3154         integer :: date_, curTime_
3155     
3156     !     Resolve date/time
3157     !     -----------------
3158           date_ = -1
3159           curTime_ = -1
3160           call strToInt(timeString,date_,curTime_)
3161           if ( date_ < 0 .OR. curTime_ < 0 ) then
3162                if ( present(rc) ) rc = -99
3163                return
3164           end if
3165     
3166           call ESMF_CFIOSdfVarReadT2D__ ( cfio, vName, date_, curTime_, field, &
3167                                        cfio2=cfio2, rc=rc )
3168     
3169         end subroutine ESMF_CFIOSdfVarReadT2D_
3170     
3171     !------------------------------------------------------------------------------
3172     !BOP
3173     ! !ROUTINE: ESMF_CFIOSdfVarReadT2D_ -- Read a variable from an existing file
3174                                                                                                                   
3175     ! !INTERFACE:
3176     
3177           subroutine ESMF_CFIOSdfVarReadT2D__(cfio, vName, date, curTime, field, rc, cfio2)
3178     !
3179     ! !ARGUMENTS:
3180     !
3181     ! !INPUT PARAMETERS:
3182     !
3183           type(ESMF_CFIO), intent(inOut) :: cfio      ! a CFIO obj
3184           character(len=*), intent(in) :: vName       ! variable name
3185           integer, intent(in) :: date                 ! yyyymmdd
3186           integer, intent(in) :: curTime              ! hhmmss
3187           type(ESMF_CFIO), intent(inOut), OPTIONAL :: cfio2  ! second CFIO obj
3188                                                                                                                   
3189     !
3190     ! !OUTPUT PARAMETERS:
3191     !
3192           real, pointer :: field(:,:)             ! array contains data
3193           integer, intent(out), OPTIONAL :: rc      ! Error return code:
3194                                                     ! 0   all is well
3195                              !  rc = -2  time is inconsistent with increment
3196                              !  rc = -3  number of levels is incompatible with file
3197                              !  rc = -4  im is incompatible with file
3198                              !  rc = -5  jm is incompatible with file
3199                              !  rc = -6  time must fall on a minute boundary
3200                              !  rc = -7  error in diffdate
3201                              !  rc = -12  error determining default precision
3202                              !  rc = -13  error determining variable type
3203                              !  rc = -19  unable to identify coordinate variable
3204                              !  rc = -38  error from ncvpt (dimension variable)
3205                              !  rc = -40  error from ncvid
3206                              !  rc = -41  error from ncdid or ncdinq (lat or lon)
3207                              !  rc = -42  error from ncdid or ncdinq (lev)
3208                              !  rc = -43  error from ncvid (time variable)
3209                              !  rc = -44  error from ncagt (time attribute)
3210                              !  rc = -46  error from ncvgt
3211                              !  rc = -48  error from ncinq
3212                              !  rc = -52  error from ncvinq
3213     !
3214     ! !DESCRIPTION:
3215     !     Read a variable from an existing file
3216     !EOP
3217     !------------------------------------------------------------------------------
3218     
3219           integer rtcode
3220           integer begDate, begTime, incSecs, timeIndex1, timeIndex2
3221           integer secs, secs1, secs2, nymd1, nymd2, nhms1, nhms2
3222           integer i, j, k
3223           integer im, jm, km
3224                                                                                              
3225           real    alpha, amiss
3226           real, pointer ::  field2(:,:) => null() ! workspace for interpolation
3227     
3228           rtcode = 0
3229     
3230     !     find the right variable obj.
3231           do i = 1, cfio%mVars
3232              if ( trim(vName) .eq. trim(cfio%varObjs(i)%vName) ) exit
3233           end do
3234           im = cfio%varObjs(i)%grid%im
3235           jm = cfio%varObjs(i)%grid%jm
3236           km = cfio%varObjs(i)%grid%km
3237           if (km .lt. 1) km = 1
3238     
3239           if ( .not. associated(field) ) allocate(field(im,jm))
3240     
3241     !     Get beginning time & date.  Calculate offset seconds from start.
3242     !     ----------------------------------------------------------------
3243           call GetBegDateTime ( cfio%fid, begDate, begTime, incSecs, rtcode )
3244           if (err("GetVar: could not determine begin_date/begin_time",rtcode,-44)&
3245              .NE. 0) go to 999
3246                                                                                              
3247           secs = DiffDate (begDate, begTime, date, curTime)
3248                                                                                              
3249     !      if (date .LT. begDate .OR. (begDate .EQ. date .AND.  &
3250     !         curTime .LT. begTime) .or. secs .LT. 0) then
3251     !         rc = -7
3252     !         return
3253     !      endif
3254      
3255     !     Determine brackting times
3256     !     -------------------------
3257           if ( secs >= 0 ) then
3258              timeIndex1 = secs/incSecs + 1
3259           else
3260              timeIndex1 = secs/incSecs
3261           end if
3262           timeIndex2 = timeIndex1 + 1
3263           secs1 = (timeIndex1-1) * incSecs
3264           secs2 = (timeIndex2-1) * incSecs
3265           call GetDate ( begDate, begTime, secs1, nymd1, nhms1, rtcode )
3266           call GetDate ( begDate, begTime, secs2, nymd2, nhms2, rtcode )
3267      
3268     !     Read grids at first time with GetVar()
3269     !     --------------------------------------
3270           call ESMF_CFIOSdfVarRead(cfio, vName, field, date=nymd1, curtime=nhms1,  rc=rtcode)
3271           if ( rtcode .ne. 0 ) goto 999
3272                                                                         
3273           if ( secs1 .eq. secs ) goto 999   ! no interpolation needed
3274     
3275           allocate(field2(im,jm))
3276                                                                                          
3277     !     Read grids at second time with GetVar()
3278     !     ---------------------------------------
3279           call ESMF_CFIOSdfVarRead(cfio, vName, field2, date=nymd2, curtime=nhms2, rc=rtcode)
3280           if ( rtcode .ne. 0 ) then
3281              if ( present(cfio2) )     &
3282                 call ESMF_CFIOSdfVarRead(cfio2, vName, field2, &
3283                                       date=nymd2, curtime=nhms2, rc=rtcode)
3284              if ( rtcode .ne. 0 ) return
3285           end if
3286                                                                                              
3287     !     Get missing value
3288     !     -----------------
3289           amiss = CFIO_GetMissing ( cfio%fid, rtcode )
3290           if ( rtcode .ne. 0 ) goto 999
3291     
3292     !     Do interpolation
3293     !     ----------------
3294           alpha = float(secs - secs1)/float(secs2 - secs1)
3295           do j = 1, jm
3296              do i = 1, im
3297                 if ( abs(field(i,j)-amiss) .gt. 0.001 .and.   &
3298                      abs(field2(i,j)-amiss) .gt. 0.001 ) then
3299                    field(i,j) = field(i,j) + alpha * (field2(i,j) - field(i,j))
3300                 else
3301                    field(i,j) = amiss
3302                 end if
3303              end do
3304           end do
3305                                                             
3306           rtcode = 0
3307     
3308     !     All done
3309     !     --------
3310     999   continue
3311           if ( associated(field2) ) deallocate(field2)
3312           if ( present(rc) ) rc = rtcode
3313                                                                              
3314           end subroutine ESMF_CFIOSdfVarReadT2D__
3315     
3316     !..........................................................................
3317     
3318           end module ESMF_CFIOSdfMod
3319     
3320