/[MITgcm]/MITgcm/pkg/mnc/mnc_cw_readwrite.template
ViewVC logotype

Diff of /MITgcm/pkg/mnc/mnc_cw_readwrite.template

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.19 by edhill, Thu Oct 7 01:48:08 2004 UTC revision 1.40 by edhill, Tue Aug 22 03:15:46 2006 UTC
# Line 23  C     !USES: Line 23  C     !USES:
23        implicit none        implicit none
24    
25  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
26        integer myThid, bi,bj, indu        integer myThid, bi,bj
27        character*(*) stype, fbname, vtype        character*(*) stype, fbname, vtype
28        __V var        __V var
29        __V var_arr(1)        __V var_arr(1)
# Line 48  C !INTERFACE: Line 48  C !INTERFACE:
48       I     myThid )       I     myThid )
49    
50  C     !DESCRIPTION:  C     !DESCRIPTION:
51    C     A scalar version of MNC_CW_RX_W() for compilers that cannot
52    C     gracefully handle the conversion on their own.
53          
54    C     !USES:
55          implicit none
56    
57    C     !INPUT PARAMETERS:
58          integer myThid, bi,bj
59          character*(*) stype, fbname, vtype
60          __V var(*)
61          INTEGER offsets(9)
62    CEOP
63          INTEGER i
64    
65          DO i = 1,9
66            offsets(i) = 0
67          ENDDO
68          CALL MNC_CW_RX_W_OFFSET(stype,fbname,bi,bj,vtype, var,
69         &     offsets, myThid)
70    
71          RETURN
72          END
73    
74    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
75    CBOP 0
76    C !ROUTINE: MNC_CW_RX_W_OFFSET
77    
78    C !INTERFACE:
79          SUBROUTINE MNC_CW_RX_W_OFFSET(
80         I     stype,
81         I     fbname, bi,bj,
82         I     vtype,
83         I     var,
84         I     offsets,
85         I     myThid )
86    
87    C     !DESCRIPTION:
88  C     This subroutine writes one variable to a file or a file group,  C     This subroutine writes one variable to a file or a file group,
89  C     depending upon the tile indicies.  C     depending upon the tile indicies.
90                
# Line 56  C     !USES: Line 93  C     !USES:
93  #include "netcdf.inc"  #include "netcdf.inc"
94  #include "mnc_common.h"  #include "mnc_common.h"
95  #include "SIZE.h"  #include "SIZE.h"
96    #include "MNC_BUFF.h"
97  #include "EEPARAMS.h"  #include "EEPARAMS.h"
98  #include "PARAMS.h"  #include "PARAMS.h"
99  #include "MNC_PARAMS.h"  #include "MNC_PARAMS.h"
100    
101  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
102        integer myThid, bi,bj, indu        integer myThid, bi,bj
103        character*(*) stype, fbname, vtype        character*(*) stype, fbname, vtype
104        __V var(*)        __V var(*)
105          INTEGER offsets(*)
106  CEOP  CEOP
107    
108  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
109        integer i,j,k, indv,nvf,nvl, n1,n2, igrid, ntot        integer i,j,k, indv,nvf,nvl, n1,n2, igrid, ntot, indu
110        integer bis,bie, bjs,bje, uniq_tnum, nfname        integer bis,bie, bjs,bje, uniq_tnum, uniq_fnum, nfname, iseq
111        integer fid, idv, indvids, ndim, indf, err        integer fid, idv, indvids, ndim, indf, err, nf
112        integer lbi,lbj, bidim,bjdim, unlim_sz, kr        integer lbi,lbj, bidim,bjdim, unlim_sz, kr
113        integer p(9),s(9),e(9), dimnc(9)        integer p(9),s(9),e(9), dimnc(9)
114        integer vstart(9),vcount(9), udo(9)        integer vstart(9),vcount(9), udo(9)
115        integer j1,j2,j3,j4,j5,j6,j7, k1,k2,k3,k4,k5,k6,k7        integer j1,j2,j3,j4,j5,j6,j7, k1,k2,k3,k4,k5,k6,k7
116        integer indfg, fg1,fg2, npath        integer indfg, fg1,fg2, npath
117        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
118        character*(MNC_MAX_CHAR) fname        character*(MNC_MAX_PATH) fname
119        character*(MNC_MAX_CHAR) path_fname        character*(MNC_MAX_PATH) path_fname
120        REAL*8  resh_d( sNx + 2*OLx + sNy + 2*OLy )        character*(MNC_MAX_PATH) tmpnm
121        REAL*4  resh_r( sNx + 2*OLx + sNy + 2*OLy )        character*(MNC_MAX_PATH) bpath
122        INTEGER resh_i( sNx + 2*OLx + sNy + 2*OLy )        REAL*8  dval, dvm(2)
123          REAL*4  rval, rvm(2)
124          INTEGER ival, ivm(2), irv
125          REAL*8  resh_d( MNC_MAX_BUFF )
126          REAL*4  resh_r( MNC_MAX_BUFF )
127          INTEGER resh_i( MNC_MAX_BUFF )
128          LOGICAL write_attributes, use_missing
129    #ifdef HAVE_STAT
130          integer ntotenc, ncenc, nbytes, fs_isdone
131          character*(200) cenc
132          integer ienc(200)
133          REAL*8  fsnu
134    #endif
135    
136  C     Functions  C     Functions
137        integer IFNBLNK, ILNBLNK        integer IFNBLNK, ILNBLNK
# Line 88  C     Functions Line 139  C     Functions
139  C     Only do I/O if I am the master thread  C     Only do I/O if I am the master thread
140        _BEGIN_MASTER( myThid )        _BEGIN_MASTER( myThid )
141    
142          DO i = 1,MNC_MAX_PATH
143            bpath(i:i) = ' '
144          ENDDO
145    
146  C     Get the current index for the unlimited dimension from the file  C     Get the current index for the unlimited dimension from the file
147  C     group (or base) name  C     group (or base) name
148        fg1 = IFNBLNK(fbname)        fg1 = IFNBLNK(fbname)
# Line 101  C     group (or base) name Line 156  C     group (or base) name
156          STOP 'ABNORMAL END: S/R MNC_CW_RX_W'          STOP 'ABNORMAL END: S/R MNC_CW_RX_W'
157        ENDIF        ENDIF
158        indu = mnc_cw_fgud(indfg)        indu = mnc_cw_fgud(indfg)
159          iseq = mnc_cw_fgis(indfg)
160    C     write(*,*) 'indu,iseq = ', indu, iseq
161    
162  C     Check that the Variable Type exists  C     Check that the Variable Type exists
163        nvf = IFNBLNK(vtype)        nvf = IFNBLNK(vtype)
# Line 131  C     Set the bi,bj indicies Line 188  C     Set the bi,bj indicies
188        DO lbj = bjs,bje        DO lbj = bjs,bje
189          DO lbi = bis,bie          DO lbi = bis,bie
190    
191    #ifdef HAVE_STAT
192              fs_isdone = 0
193    #endif
194     10       CONTINUE
195    
196  C         Create the file name  C         Create the file name
197            CALL MNC_CW_GET_TILE_NUM(lbi,lbj, uniq_tnum, myThid)            CALL MNC_CW_GET_TILE_NUM(lbi,lbj, uniq_tnum, myThid)
198            fname(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)            fname(1:MNC_MAX_PATH) = bpath(1:MNC_MAX_PATH)
199            n1 = IFNBLNK(fbname)            n1 = IFNBLNK(fbname)
200            n2 = ILNBLNK(fbname)            n2 = ILNBLNK(fbname)
201    
202    #ifdef MNC_WRITE_OLDNAMES
203    
204            ntot = n2 - n1 + 1            ntot = n2 - n1 + 1
205            fname(1:ntot) = fbname(n1:n2)            fname(1:ntot) = fbname(n1:n2)
206            ntot = ntot + 1            ntot = ntot + 1
207            fname(ntot:ntot) = '.'            fname(ntot:ntot) = '.'
208            write(fname((ntot+1):(ntot+9)),'(i6.6,a3)') uniq_tnum, '.nc'            IF ( mnc_use_name_ni0 ) THEN
209            nfname = ntot+9              write(fname((ntot+1):(ntot+17)),'(i10.10,a1,i6.6)')
210         &           nIter0,'.',uniq_tnum
211                write(fname((ntot+18):(ntot+25)),'(a1,i4.4,a3)')
212         &           '.', iseq, '.nc'
213                nfname = ntot + 25
214              ELSE
215                write(fname((ntot+1):(ntot+14)),'(i4.4,a1,i6.6,a3)')
216         &           iseq,'.',uniq_tnum, '.nc'
217                nfname = ntot + 14
218              ENDIF
219    
220    #else
221    
222              CALL MNC_PSNCM(tmpnm, uniq_tnum, MNC_DEF_TMNC)
223              k = ILNBLNK(tmpnm)
224              IF ( mnc_cw_cit(1,mnc_cw_fgci(indfg)) .GT. -1 ) THEN
225                j = mnc_cw_cit(2,mnc_cw_fgci(indfg))
226                IF ( mnc_cw_fgis(indfg) .GT. j )
227         &           j = mnc_cw_fgis(indfg)
228                write(fname,'(a,a1,i10.10,a2,a,a3)') fbname(n1:n2),
229         &           '.', j, '.t', tmpnm(1:k), '.nc'
230              ELSEIF ( mnc_cw_cit(1,mnc_cw_fgci(indfg)) .EQ. -1 ) THEN
231    C           Leave off the myIter value entirely
232                write(fname,'(a,a2,a,a3)') fbname(n1:n2), '.t',
233         &           tmpnm(1:k),'.nc'
234              ELSE
235    C           We have an error--bad flag value
236                write(msgbuf,'(4a)')
237         &           'MNC_CW_RX_W ERROR: bad mnc_cw_cit(1,...) ',
238         &           'flag value for base name ''', fbname(fg1:fg2),
239         &           ''''
240                CALL print_error(msgbuf, mythid)
241                STOP 'ABNORMAL END: S/R MNC_CW_RX_W'
242              ENDIF
243              nfname = ILNBLNK(fname)
244    
245    #endif
246    
247  C         Add the path to the file name  C         Add the path to the file name
248            IF (mnc_use_outdir) THEN            IF (mnc_use_outdir) THEN
249              path_fname(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)              path_fname(1:MNC_MAX_PATH) = bpath(1:MNC_MAX_PATH)
250              npath = ILNBLNK(mnc_out_path)              npath = ILNBLNK(mnc_out_path)
251              path_fname(1:npath) = mnc_out_path(1:npath)              path_fname(1:npath) = mnc_out_path(1:npath)
252              path_fname((npath+1):(npath+nfname)) = fname(1:nfname)              path_fname((npath+1):(npath+nfname)) = fname(1:nfname)
253              fname(1:MNC_MAX_CHAR) = path_fname(1:MNC_MAX_CHAR)              fname(1:MNC_MAX_PATH) = path_fname(1:MNC_MAX_PATH)
254              nfname = npath + nfname              nfname = npath + nfname
255            ENDIF            ENDIF
256    
257  C         Append to an existing or create a new file  C         Append to an existing or create a new file
258            CALL MNC_CW_FILE_AORC(fname, indf, myThid)            CALL MNC_CW_FILE_AORC(fname,indf, lbi,lbj,uniq_tnum, myThid)
259            fid = mnc_f_info(indf,2)            fid = mnc_f_info(indf,2)
260    
261    #ifdef HAVE_STAT
262              IF ((mnc_cw_fgig(indfg) .EQ. 1)
263         &         .AND. (fs_isdone .EQ. 0)) THEN
264    C           Decide whether to append to the existing or create a new
265    C           file based on the byte count per unlimited dimension
266                ncenc = 70
267                cenc(1:26)  = 'abcdefghijklmnopqrstuvwxyz'
268                cenc(27:52) = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
269                cenc(53:70) = '0123456789_.,+-=/~'
270                k = nfname
271                IF (k .GT. 200)  k = 200
272                ntotenc = 0
273                DO i = 1,k
274                  DO j = 1,ncenc
275                    IF (fname(i:i) .EQ. cenc(j:j)) THEN
276                      ntotenc = ntotenc + 1
277                      ienc(ntotenc) = j
278                      GOTO 20
279                    ENDIF
280                  ENDDO
281     20           CONTINUE
282                ENDDO
283                CALL mncfsize(ntotenc, ienc, nbytes)
284                IF (nbytes .GT. 0) THEN
285                  CALL MNC_DIM_UNLIM_SIZE(fname, unlim_sz, myThid)
286                  fsnu = (1.0 _d 0 + 1.0 _d 0 / DBLE(unlim_sz))
287         &             * DBLE(nbytes)
288                  IF (fsnu .GT. mnc_max_fsize) THEN
289    C               Delete the now-full fname from the lookup tables since
290    C               we are all done writing to it.
291                    CALL MNC_FILE_CLOSE(fname, myThid)
292                    indu = 1
293                    mnc_cw_fgud(indfg) = 1
294    
295    #ifdef MNC_WRITE_OLDNAMES
296                    iseq = iseq + 1
297                    mnc_cw_fgis(indfg) = iseq
298    #else
299                    IF (mnc_cw_cit(1,mnc_cw_fgci(indfg)) .LT. 0) THEN
300                      write(msgbuf,'(5a)')
301         &            'MNC_CW_RX_W ERROR: output file for base name ''',
302         &            fbname(fg1:fg2), ''' is about to exceed the max ',
303         &            'file size and is NOT ALLOWED an iteration value ',
304         &            'within its file name'
305                      CALL print_error(msgbuf, mythid)
306                      STOP 'ABNORMAL END: S/R MNC_CW_RX_W'
307                    ELSEIF (mnc_cw_cit(3,mnc_cw_fgci(indfg)) .LT. 0) THEN
308                      write(msgbuf,'(5a)')
309         &            'MNC_CW_RX_W ERROR: output file for base name ''',
310         &            fbname(fg1:fg2), ''' is about to exceed the max ',
311         &            'file size and no next-iter has been specified--',
312         &            'please see the MNC CITER functions'
313                      CALL print_error(msgbuf, mythid)
314                      STOP 'ABNORMAL END: S/R MNC_CW_RX_W'
315                    ENDIF
316                    mnc_cw_fgis(indfg) = mnc_cw_cit(3,mnc_cw_fgci(indfg))
317    C               DO NOT BUMP THE CURRENT ITER FOR ALL FILES IN THIS CITER
318    C               GROUP SINCE THIS IS ONLY GROWTH TO AVOID FILE SIZE
319    C               LIMITS FOR THIS ONE BASENAME GROUP, NOT GROWTH OF THE
320    C               ENTIRE CITER GROUP !!!
321    C               mnc_cw_cit(2,mnc_cw_fgci(indfg))
322    C               &   = mnc_cw_cit(3,mnc_cw_fgci(indfg))
323    C               mnc_cw_cit(3,mnc_cw_fgci(indfg)) = -1
324    #endif
325                    fs_isdone = 1
326                    GOTO 10
327    
328                  ENDIF
329                ENDIF
330              ENDIF
331    #endif  /*  HAVE_STAT  */
332    
333  C         Ensure that all the NetCDF dimensions are defined and create a  C         Ensure that all the NetCDF dimensions are defined and create a
334  C         local copy of them  C         local copy of them
335            DO i = 1,9            DO i = 1,9
# Line 168  C         local copy of them Line 341  C         local copy of them
341              ELSE              ELSE
342                dimnc(i) = mnc_cw_ie(i,igrid) - mnc_cw_is(i,igrid) + 1                dimnc(i) = mnc_cw_ie(i,igrid) - mnc_cw_is(i,igrid) + 1
343              ENDIF              ENDIF
344              CALL MNC_DIM_INIT(fname,  
345       &           mnc_cw_dn(i,igrid), dimnc(i), myThid)  C           Add the coordinate variables
346                CALL MNC_DIM_INIT_ALL_CV(fname,
347         &           mnc_cw_dn(i,igrid), dimnc(i), 'Y', lbi,lbj, myThid)
348    
349            ENDDO            ENDDO
350    
351  C         Ensure that the "grid" is defined  C         Ensure that the "grid" is defined
# Line 177  C         Ensure that the "grid" is defi Line 353  C         Ensure that the "grid" is defi
353       &        mnc_cw_ndim(igrid), mnc_cw_dn(1,igrid), myThid)       &        mnc_cw_ndim(igrid), mnc_cw_dn(1,igrid), myThid)
354    
355  C         Ensure that the variable is defined  C         Ensure that the variable is defined
356              irv = 0
357            IF (stype(1:1) .EQ. 'D')            IF (stype(1:1) .EQ. 'D')
358       &         CALL MNC_VAR_INIT_DBL(       &         CALL MNC_VAR_INIT_DBL(
359       &         fname, mnc_cw_gname(igrid), vtype, myThid)       &         fname, mnc_cw_gname(igrid), vtype, irv, myThid)
360            IF (stype(1:1) .EQ. 'R')            IF (stype(1:1) .EQ. 'R')
361       &         CALL MNC_VAR_INIT_REAL(       &         CALL MNC_VAR_INIT_REAL(
362       &         fname, mnc_cw_gname(igrid), vtype, myThid)       &         fname, mnc_cw_gname(igrid), vtype, irv, myThid)
363            IF (stype(1:1) .EQ. 'I')            IF (stype(1:1) .EQ. 'I')
364       &         CALL MNC_VAR_INIT_INT(       &         CALL MNC_VAR_INIT_INT(
365       &         fname, mnc_cw_gname(igrid), vtype, myThid)       &         fname, mnc_cw_gname(igrid), vtype, irv, myThid)
366    
367              IF (irv .GT. 0) THEN
368    C           Return value indicates that the variable did not previously
369    C           exist in this file, so we need to write all the attributes
370                write_attributes = .TRUE.
371              ELSE
372                write_attributes = .FALSE.
373              ENDIF
374    
375            DO i = 1,mnc_fv_ids(indf,1)            DO i = 1,mnc_fv_ids(indf,1)
376              j = 2 + 3*(i - 1)              j = 2 + 3*(i - 1)
# Line 193  C         Ensure that the variable is de Line 378  C         Ensure that the variable is de
378                idv = mnc_fv_ids(indf,j+1)                idv = mnc_fv_ids(indf,j+1)
379                indvids = mnc_fd_ind(indf, mnc_f_info(indf,                indvids = mnc_fd_ind(indf, mnc_f_info(indf,
380       &             (mnc_fv_ids(indf,j+2) + 1)) )       &             (mnc_fv_ids(indf,j+2) + 1)) )
381                GOTO 10                GOTO 30
382              ENDIF              ENDIF
383            ENDDO            ENDDO
384            write(msgbuf,'(4a)') 'MNC_MNC_CW_RX_W ERROR: ',            write(msgbuf,'(4a)') 'MNC_MNC_CW_RX_W ERROR: ',
385       &         'cannot reference variable ''', vtype, ''''       &         'cannot reference variable ''', vtype, ''''
386            CALL print_error(msgbuf, mythid)            CALL print_error(msgbuf, mythid)
387            STOP 'ABNORMAL END: package MNC'            STOP 'ABNORMAL END: package MNC'
388   10       CONTINUE   30       CONTINUE
389    
390  C         Check for bi,bj indicies  C         Check for bi,bj indicies
391            bidim = mnc_cw_vbij(1,indv)            bidim = mnc_cw_vbij(1,indv)
# Line 227  C         Set the dimensions for the in- Line 412  C         Set the dimensions for the in-
412              ELSE              ELSE
413                p(i) = k * p(i-1)                p(i) = k * p(i-1)
414              ENDIF              ENDIF
415                IF (offsets(i) .GT. 0) THEN
416                  k = 1
417                  p(i) = k * p(i-1)
418                ENDIF
419            ENDDO            ENDDO
420    
421  C         Set starting and ending indicies for the in-memory array and  C         Set starting and ending indicies for the in-memory array and
# Line 264  C               Use the current unlimite Line 453  C               Use the current unlimite
453              s(bjdim) = lbj              s(bjdim) = lbj
454              e(bjdim) = lbj              e(bjdim) = lbj
455            ENDIF            ENDIF
456  CEH3      DO i = 1,9            
457  CEH3        write(*,*) 'i,p(i),s(i),e(i) = ', i,p(i),s(i),e(i)  C         Check the offsets
458  CEH3      ENDDO            DO i = 1,9
459                IF (offsets(i) .GT. 0) THEN
460  C         Add the global attributes                udo(i) = udo(i) + offsets(i) - 1
461            CALL MNC_CW_SET_GATTR( fname, lbi,lbj, uniq_tnum, myThid)                s(i) = 1
462                  e(i) = 1
463  C         Add the per-variable attributes              ENDIF
           DO i = 1,mnc_cw_vnat(1,indv)  
             CALL MNC_VAR_ADD_ATTR_STR( fname, vtype,  
      &           mnc_cw_vtnm(i,indv), mnc_cw_vtat(i,indv), myThid)  
           ENDDO  
           DO i = 1,mnc_cw_vnat(2,indv)  
             CALL MNC_VAR_ADD_ATTR_INT( fname, vtype,  
      &           mnc_cw_vinm(i,indv), 1, mnc_cw_viat(i,indv), myThid)  
           ENDDO  
           DO i = 1,mnc_cw_vnat(3,indv)  
             CALL MNC_VAR_ADD_ATTR_DBL( fname, vtype,  
      &           mnc_cw_vdnm(i,indv), 1, mnc_cw_vdat(i,indv), myThid)  
464            ENDDO            ENDDO
465    
466              IF (write_attributes) THEN
467    C           Add the per-variable attributes
468                DO i = 1,mnc_cw_vnat(1,indv)
469                  CALL MNC_VAR_ADD_ATTR_STR( fname, vtype,
470         &             mnc_cw_vtnm(i,indv), mnc_cw_vtat(i,indv), myThid)
471                ENDDO
472                DO i = 1,mnc_cw_vnat(2,indv)
473                  CALL MNC_VAR_ADD_ATTR_INT( fname, vtype,
474         &             mnc_cw_vinm(i,indv), 1, mnc_cw_viat(i,indv), myThid)
475                ENDDO
476                DO i = 1,mnc_cw_vnat(3,indv)
477                  CALL MNC_VAR_ADD_ATTR_DBL( fname, vtype,
478         &             mnc_cw_vdnm(i,indv), 1, mnc_cw_vdat(i,indv), myThid)
479                ENDDO
480              ENDIF
481    
482    C         Handle missing values
483              use_missing = .FALSE.
484              IF (mnc_cw_vfmv(indv) .EQ. 0) THEN
485                use_missing = .FALSE.
486              ELSE
487                IF (mnc_cw_vfmv(indv) .EQ. 1) THEN
488                  use_missing = .TRUE.
489                  dvm(1)  = mnc_def_dmv(1)
490                  dvm(2)  = mnc_def_dmv(2)
491                  rvm(1)  = mnc_def_rmv(1)
492                  rvm(2)  = mnc_def_rmv(2)
493                  ivm(1)  = mnc_def_imv(1)
494                  ivm(2)  = mnc_def_imv(2)
495                ELSEIF (mnc_cw_vfmv(indv) .EQ. 2) THEN
496                  use_missing = .TRUE.
497                  dvm(1)  = mnc_cw_vmvd(1,indv)
498                  dvm(2)  = mnc_cw_vmvd(2,indv)
499                  rvm(1)  = mnc_cw_vmvr(1,indv)
500                  rvm(2)  = mnc_cw_vmvr(2,indv)
501                  ivm(1)  = mnc_cw_vmvi(1,indv)
502                  ivm(2)  = mnc_cw_vmvi(2,indv)
503                ENDIF
504              ENDIF
505              IF (write_attributes .AND. use_missing) THEN
506                write(msgbuf,'(4a)') 'writing attribute ''missing_value''',
507         &           ' within file ''', fname(1:nfname), ''''
508                IF (stype(1:1) .EQ. 'D') THEN
509                  err = NF_PUT_ATT_DOUBLE(fid, idv, 'missing_value',
510         &             NF_DOUBLE, 1, dvm(2))
511                ELSEIF (stype(1:1) .EQ. 'R') THEN
512                  err = NF_PUT_ATT_REAL(fid, idv, 'missing_value',
513         &             NF_FLOAT, 1, dvm(2))
514                ELSEIF (stype(1:1) .EQ. 'I') THEN
515                  err = NF_PUT_ATT_INT(fid, idv, 'missing_value',
516         &             NF_INT, 1, ivm(2))
517                ENDIF
518                CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
519              ENDIF
520    
521            CALL MNC_FILE_ENDDEF(fname, myThid)            CALL MNC_FILE_ENDDEF(fname, myThid)
522    
523            write(msgbuf,'(5a)') 'writing variable type ''',            write(msgbuf,'(5a)') 'writing variable type ''',
524       &         vtype(nvf:nvl), ''' within file ''',       &         vtype(nvf:nvl), ''' within file ''',
525       &         fname(1:nfname), ''''       &         fname(1:nfname), ''''
526    
527    C         DO i = 1,9
528    C         write(*,*) 'i,p(i),s(i),e(i),udo(i),offsets(i) = ',
529    C         &        i,p(i),s(i),e(i),udo(i),offsets(i)
530    C         ENDDO
531    
532  C         Write the variable one vector at a time  C         Write the variable one vector at a time
533            DO j7 = s(7),e(7)            DO j7 = s(7),e(7)
534              k7 = (j7 - 1)*p(6)              k7 = (j7 - 1)*p(6)
# Line 321  C         Write the variable one vector Line 559  C         Write the variable one vector
559        vstart(1) = udo(1) + 1        vstart(1) = udo(1) + 1
560        vcount(1) = e(1) - s(1) + 1        vcount(1) = e(1) - s(1) + 1
561    
562        IF (stype(1:1) .EQ. 'D') THEN        IF (vcount(1) .GT. MNC_MAX_BUFF) THEN
563          DO j1 = s(1),e(1)          write(msgbuf,'(2a,I7,a)') 'MNC_MAX_BUFF is too small',
564            k1 = k2 + j1       &       '--please increase to at least ',
565            kr = kr + 1       &       vcount(1), ' in ''MNC_BUFF.h'''
566            resh_d(kr) = var(k1)          CALL PRINT_ERROR(msgBuf , 1)
567          ENDDO          STOP 'ABNORMAL END: S/R MNC_CW_RX_W_OFFSET'
         err = NF_PUT_VARA_DOUBLE(fid, idv, vstart, vcount, resh_d)  
       ENDIF  
       IF (stype(1:1) .EQ. 'R') THEN  
         DO j1 = s(1),e(1)  
           k1 = k2 + j1  
           kr = kr + 1  
           resh_r(kr) = var(k1)  
         ENDDO  
         err = NF_PUT_VARA_REAL(fid, idv, vstart, vcount, resh_r)  
       ENDIF  
       IF (stype(1:1) .EQ. 'I') THEN  
         DO j1 = s(1),e(1)  
           k1 = k2 + j1  
           kr = kr + 1  
           resh_i(kr) = var(k1)  
         ENDDO  
         err = NF_PUT_VARA_INT(fid, idv, vstart, vcount, resh_i)  
568        ENDIF        ENDIF
569    
570          IF (use_missing) THEN
571    
572            IF (stype(1:1) .EQ. 'D') THEN
573              DO j1 = s(1),e(1)
574                k1 = k2 + j1
575                kr = kr + 1
576                dval = var(k1)
577                IF (dval .EQ. dvm(1)) THEN
578                  resh_d(kr) = dvm(2)
579                ELSE
580                  resh_d(kr) = dval
581                ENDIF
582              ENDDO
583              err = NF_PUT_VARA_DOUBLE(fid, idv, vstart, vcount, resh_d)
584            ELSEIF (stype(1:1) .EQ. 'R') THEN
585              DO j1 = s(1),e(1)
586                k1 = k2 + j1
587                kr = kr + 1
588                rval = var(k1)
589                IF (rval .EQ. rvm(1)) THEN
590                  resh_r(kr) = rvm(2)
591                ELSE
592                  resh_r(kr) = rval
593                ENDIF
594              ENDDO
595              err = NF_PUT_VARA_REAL(fid, idv, vstart, vcount, resh_r)
596            ELSEIF (stype(1:1) .EQ. 'I') THEN
597              DO j1 = s(1),e(1)
598                k1 = k2 + j1
599                kr = kr + 1
600                ival = MNC2I( var(k1) )
601                IF (ival .EQ. ivm(1)) THEN
602                  resh_i(kr) = ivm(2)
603                ELSE
604                  resh_i(kr) = ival
605                ENDIF
606              ENDDO
607              err = NF_PUT_VARA_INT(fid, idv, vstart, vcount, resh_i)
608            ENDIF
609    
610          ELSE
611            
612            IF (stype(1:1) .EQ. 'D') THEN
613              DO j1 = s(1),e(1)
614                k1 = k2 + j1
615                kr = kr + 1
616                resh_d(kr) = var(k1)
617              ENDDO
618              err = NF_PUT_VARA_DOUBLE(fid, idv, vstart, vcount, resh_d)
619            ELSEIF (stype(1:1) .EQ. 'R') THEN
620              DO j1 = s(1),e(1)
621                k1 = k2 + j1
622                kr = kr + 1
623                resh_r(kr) = var(k1)
624              ENDDO
625              err = NF_PUT_VARA_REAL(fid, idv, vstart, vcount, resh_r)
626            ELSEIF (stype(1:1) .EQ. 'I') THEN
627              DO j1 = s(1),e(1)
628                k1 = k2 + j1
629                kr = kr + 1
630                resh_i(kr) = MNC2I( var(k1) )
631              ENDDO
632              err = NF_PUT_VARA_INT(fid, idv, vstart, vcount, resh_i)
633            ENDIF
634    
635          ENDIF
636        CALL MNC_HANDLE_ERR(err, msgbuf, myThid)        CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
637    
638                      ENDDO                      ENDDO
# Line 357  C         Write the variable one vector Line 644  C         Write the variable one vector
644    
645  C         Sync the file  C         Sync the file
646            err = NF_SYNC(fid)            err = NF_SYNC(fid)
647            write(msgbuf,'(3a)') 'sync for file ''', fname,            nf = ILNBLNK( fname )
648              write(msgbuf,'(3a)') 'sync for file ''', fname(1:nf),
649       &         ''' in S/R MNC_CW_RX_W'       &         ''' in S/R MNC_CW_RX_W'
650            CALL MNC_HANDLE_ERR(err, msgbuf, myThid)            CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
651    
# Line 390  C     !USES: Line 678  C     !USES:
678        implicit none        implicit none
679    
680  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
681        integer myThid, bi,bj, indu        integer myThid, bi,bj
682        character*(*) stype, fbname, vtype        character*(*) stype, fbname, vtype
683        __V var        __V var
684        __V var_arr(1)        __V var_arr(1)
# Line 415  C !INTERFACE: Line 703  C !INTERFACE:
703       I     var,       I     var,
704       I     myThid )       I     myThid )
705    
706    C     !DESCRIPTION:
707    C     A simple wrapper for the old version of this routine.  The new
708    C     version includes the isvar argument which, for backwards
709    C     compatibility, is set to false here.
710          
711    C     !USES:
712          implicit none
713    
714    C     !INPUT PARAMETERS:
715          integer myThid, bi,bj
716          character*(*) stype, fbname, vtype
717          __V var(*)
718    CEOP
719    
720    C     !LOCAL VARIABLES:
721          LOGICAL isvar
722    
723          isvar = .FALSE.
724    
725          CALL MNC_CW_RX_R_TF(stype,fbname,bi,bj,vtype,var,isvar,myThid)
726    
727          RETURN
728          END
729    
730    
731    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
732    CBOP 0
733    C !ROUTINE: MNC_CW_RX_R
734    
735    C !INTERFACE:
736          SUBROUTINE MNC_CW_RX_R_TF(
737         I     stype,
738         I     fbname, bi,bj,
739         I     vtype,
740         I     var,
741         B     isvar,
742         I     myThid )
743    
744  C     !DESCRIPTION:  C     !DESCRIPTION:
745  C     This subroutine reads one variable from a file or a file group,  C     This subroutine reads one variable from a file or a file group,
746  C     depending upon the tile indicies.  C     depending upon the tile indicies.  If isvar is true and the
747    C     variable does not exist, then isvar is set to false and the
748    C     program continues normally.  This allows one to gracefully handle
749    C     the case of reading variables that might or might not exist.
750                
751  C     !USES:  C     !USES:
752        implicit none        implicit none
753  #include "netcdf.inc"  #include "netcdf.inc"
754  #include "mnc_common.h"  #include "mnc_common.h"
755  #include "SIZE.h"  #include "SIZE.h"
756    #include "MNC_BUFF.h"
757  #include "EEPARAMS.h"  #include "EEPARAMS.h"
758  #include "PARAMS.h"  #include "PARAMS.h"
759  #include "MNC_PARAMS.h"  #include "MNC_PARAMS.h"
760    
761  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
762        integer myThid, bi,bj, indu        integer myThid, bi,bj
763        character*(*) stype, fbname, vtype        character*(*) stype, fbname, vtype
764        __V var(*)        __V var(*)
765          LOGICAL isvar
766  CEOP  CEOP
767    
768  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
769        integer i,k, nvf,nvl, n1,n2, igrid, ntot        integer i,k, nvf,nvl, n1,n2, igrid, ntot, indu
770        integer bis,bie, bjs,bje, uniq_tnum, nfname, fid, idv        integer bis,bie, bjs,bje, uniq_tnum,uniq_fnum, nfname, fid, idv
771        integer ndim, indf, err, lbi,lbj, bidim,bjdim, unlim_sz, kr        integer ndim, err, lbi,lbj, bidim,bjdim, unlim_sz, kr
772        integer ind_fv_ids, ind_vt, ierr, atype, alen        integer ind_vt, npath, unlid, f_or_t, ixoff,iyoff
773        integer f_sNx,f_sNy, npath  C     integer f_sNx,f_sNy, alen, atype, ind_fv_ids, ierr, indf
774        integer p(9),s(9),e(9), vstart(9),vcount(9), udo(9)        integer p(9),s(9),e(9), vstart(9),vcount(9), udo(9)
775        integer j1,j2,j3,j4,j5,j6,j7, k1,k2,k3,k4,k5,k6,k7        integer j1,j2,j3,j4,j5,j6,j7, k1,k2,k3,k4,k5,k6,k7
776        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
777        character*(MNC_MAX_CHAR) fname        character*(MNC_MAX_PATH) fname
778        character*(MNC_MAX_CHAR) path_fname        character*(MNC_MAX_PATH) fname_zs
779          character*(MNC_MAX_PATH) tmpnm
780          character*(MNC_MAX_PATH) path_fname
781          character*(MNC_MAX_PATH) bpath
782        integer indfg, fg1,fg2        integer indfg, fg1,fg2
783        REAL*8  resh_d( sNx + 2*OLx + sNy + 2*OLy )        REAL*8  resh_d( MNC_MAX_BUFF )
784        REAL*4  resh_r( sNx + 2*OLx + sNy + 2*OLy )        REAL*4  resh_r( MNC_MAX_BUFF )
785        INTEGER resh_i( sNx + 2*OLx + sNy + 2*OLy )        INTEGER resh_i( MNC_MAX_BUFF )
786    
787  C     Functions  C     Functions
788        integer IFNBLNK, ILNBLNK        integer IFNBLNK, ILNBLNK
# Line 456  C     Functions Line 790  C     Functions
790  C     Only do I/O if I am the master thread  C     Only do I/O if I am the master thread
791        _BEGIN_MASTER( myThid )        _BEGIN_MASTER( myThid )
792    
793          DO i = 1,MNC_MAX_PATH
794            bpath(i:i) = ' '
795          ENDDO
796    
797  C     Get the current index for the unlimited dimension from the file  C     Get the current index for the unlimited dimension from the file
798  C     group (or base) name  C     group (or base) name
799        fg1 = IFNBLNK(fbname)        fg1 = IFNBLNK(fbname)
# Line 505  C     Set the bi,bj indicies Line 843  C     Set the bi,bj indicies
843    
844  C         Create the file name  C         Create the file name
845            CALL MNC_CW_GET_TILE_NUM( lbi,lbj, uniq_tnum, myThid)            CALL MNC_CW_GET_TILE_NUM( lbi,lbj, uniq_tnum, myThid)
846            fname(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)            fname(1:MNC_MAX_PATH) = bpath(1:MNC_MAX_PATH)
847    
848    #ifdef MNC_READ_OLDNAMES
849    
850            n1 = IFNBLNK(fbname)            n1 = IFNBLNK(fbname)
851            n2 = ILNBLNK(fbname)            n2 = ILNBLNK(fbname)
852            ntot = n2 - n1 + 1            ntot = n2 - n1 + 1
# Line 517  C         Create the file name Line 858  C         Create the file name
858    
859  C         Add the path to the file name  C         Add the path to the file name
860            IF (mnc_use_indir) THEN            IF (mnc_use_indir) THEN
861              path_fname(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)              path_fname(1:MNC_MAX_PATH) = bpath(1:MNC_MAX_PATH)
862              npath = ILNBLNK(mnc_indir_str)              npath = ILNBLNK(mnc_indir_str)
863              path_fname(1:npath) = mnc_indir_str(1:npath)              path_fname(1:npath) = mnc_indir_str(1:npath)
864              path_fname((npath+1):(npath+nfname)) = fname(1:nfname)              path_fname((npath+1):(npath+nfname)) = fname(1:nfname)
865              fname(1:MNC_MAX_CHAR) = path_fname(1:MNC_MAX_CHAR)              fname(1:MNC_MAX_PATH) = path_fname(1:MNC_MAX_PATH)
866              nfname = npath + nfname              nfname = npath + nfname
867            ENDIF            ENDIF
868    
869  C         Open the existing file            WRITE(fname_zs,'(2a,i4.4,a1,i6.6,a3)')
870            CALL MNC_FILE_TRY_READ( fname, ierr, indf, myThid)       &         mnc_indir_str(1:npath), fbname(n1:n2),
871         &         0, '.', uniq_tnum, '.nc'
872    
873    C         The steps are:
874    C         (1) open the file in a READ-ONLY mode,
875    C         (2) get the var id for the current variable,
876    C         (3) read the data, and then
877    C         (4) close the file--theres no need to keep it open!
878    
879              write(msgbuf,'(4a)') 'MNC_CW_RX_R: cannot open',
880         &         ' file ''', fname(1:nfname), ''' in read-only mode'
881              err = NF_OPEN(fname, NF_NOWRITE, fid)
882              IF ( err .NE. NF_NOERR ) THEN
883    C           If the initial open fails, try again using a name with a
884    C           zero sequence number inserted
885                err = NF_OPEN(fname_zs, NF_NOWRITE, fid)
886              ENDIF
887              CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
888    
889  C         Check that the variable (VType) is defined within the file            write(msgbuf,'(5a)')
890            CALL MNC_GET_FVINDS( fname, vtype, indf, ind_fv_ids, myThid)       &         'MNC_CW_RX_R: cannot get id for variable ''',
891            IF ((indf .LT. 1) .OR. (ind_fv_ids .LT. 1)) THEN       &         vtype(nvf:nvl), '''in file ''', fname(1:nfname), ''''
892              write(msgbuf,'(4a)') 'MNC_CW_RX_R ERROR: vtype ''',            err = NF_INQ_VARID(fid, vtype, idv)
893       &           vtype(nvf:nvl), ''' is not defined within file ''',            IF ( isvar .AND. ( err .NE. NF_NOERR ) ) THEN
894       &           fname(1:nfname)              isvar = .FALSE.
895              CALL print_error(msgbuf, mythid)              RETURN
             STOP 'ABNORMAL END: S/R MNC_CW_RX_R'  
896            ENDIF            ENDIF
897            fid = mnc_f_info(indf,2)            isvar = .TRUE.
898            idv = mnc_fv_ids(indf,ind_fv_ids+1)            CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
899              f_or_t = 0
900    
901    #else
902    
903    C         The sequence for PER-FACE and PER-TILE is:
904    C         (1) check whether a PER-FACE file exists
905    C         .   (a) if only one face is used for the entire domain,
906    C         .       then omit the face index from the file name
907    C         .   (b) if the PER-FACE file exists and is somehow faulty,
908    C         .       then we die with an error message
909    C         (2) if no PER-FACE file exists, then use a PER-TILE file
910    
911    C         Create the PER-FACE file name
912              n1 = IFNBLNK(fbname)
913              n2 = ILNBLNK(fbname)
914    C         Add an iteraton count to the file name if its requested
915              IF (mnc_cw_cit(1,mnc_cw_fgci(indfg)) .LT. 0) THEN
916                WRITE(fname,'(a,a1)') fbname(n1:n2), '.'
917              ELSE
918                WRITE(fname,'(a,a1,i10.10,a1)') fbname(n1:n2), '.',
919         &            mnc_cw_cit(2,mnc_cw_fgci(indfg)), '.'
920              ENDIF
921              ntot = ILNBLNK(fname)
922              path_fname(1:MNC_MAX_PATH) = bpath(1:MNC_MAX_PATH)
923              npath = ILNBLNK(mnc_indir_str)
924    C         Add the face index
925              CALL MNC_CW_GET_FACE_NUM( lbi,lbj, uniq_fnum, myThid)
926              IF ( uniq_fnum .EQ. -1 ) THEN
927    C           There is only one face
928                WRITE(path_fname,'(2a,a2)')
929         &           mnc_indir_str(1:npath), fname(1:ntot), 'nc'
930              ELSE
931                CALL MNC_PSNCM(tmpnm, uniq_fnum, MNC_DEF_FMNC)
932                k = ILNBLNK(tmpnm)
933                WRITE(path_fname,'(2a,a1,a,a3)')
934         &           mnc_indir_str(1:npath), fname(1:ntot), 'f',
935         &           tmpnm(1:k), '.nc'
936              ENDIF
937    
938    C         Try to open the PER-FACE file
939    C         WRITE(*,*) 'trying: "', path_fname, '"'
940              err = NF_OPEN(path_fname, NF_NOWRITE, fid)
941              IF ( err .EQ. NF_NOERR ) THEN
942                f_or_t = 1
943              ELSE
944    
945    C           Create the PER-TILE file name
946                CALL MNC_PSNCM(tmpnm, uniq_tnum, MNC_DEF_TMNC)
947                k = ILNBLNK(tmpnm)
948                path_fname(1:MNC_MAX_PATH) = bpath(1:MNC_MAX_PATH)
949                WRITE(path_fname,'(2a,a1,a,a3)')
950         &           mnc_indir_str(1:npath), fname(1:ntot), 't',
951         &           tmpnm(1:k), '.nc'
952    C           WRITE(*,*) 'trying: "', path_fname, '"'
953                err = NF_OPEN(path_fname, NF_NOWRITE, fid)
954                IF ( err .EQ. NF_NOERR ) THEN
955                  f_or_t = 0
956                ELSE
957                  k = ILNBLNK(path_fname)
958                  write(msgbuf,'(4a)')
959         &             'MNC_CW_RX_R: cannot open either a per-face or a ',
960         &             'per-tile file: last try was ''', path_fname(1:k),
961         &             ''''
962                  CALL print_error(msgbuf, mythid)
963                  STOP 'ABNORMAL END: S/R MNC_CW_RX_W'
964                ENDIF
965    
966              ENDIF
967    
968              ntot = ILNBLNK(path_fname)
969              write(msgbuf,'(5a)')
970         &         'MNC_CW_RX_R: cannot get netCDF id for variable ''',
971         &         vtype(nvf:nvl), ''' in file ''', path_fname(1:ntot),
972         &         ''''
973              err = NF_INQ_VARID(fid, vtype, idv)
974              IF ( isvar .AND. ( err .NE. NF_NOERR ) ) THEN
975                isvar = .FALSE.
976                RETURN
977              ENDIF
978              isvar = .TRUE.
979              CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
980    
981              k = ILNBLNK(path_fname)
982              fname(1:k) = path_fname(1:k)
983              nfname = k
984    
985    #endif
986    
987              IF ( f_or_t .EQ. 1 ) THEN
988    
989    C           write(msgbuf,'(2a)')
990    C           &           'MNC_CW_RX_R: per-face reads are not yet ',
991    C           &           'implemented -- so pester Ed to finish them'
992    C           CALL print_error(msgbuf, mythid)
993    C           STOP 'ABNORMAL END: S/R MNC_CW_RX_W'
994                
995    C           Get the X,Y PER-FACE offsets
996                CALL MNC_CW_GET_XYFO(lbi,lbj, ixoff,iyoff, myThid)
997    
998              ENDIF
999    
1000    C         WRITE(*,*) 'f_or_t = ',f_or_t
1001    
1002  C         Check that the current sNy,sNy values and the in-file values  C         Check that the current sNy,sNy values and the in-file values
1003  C         are compatible and WARN (only warn) if not  C         are compatible and WARN (only warn) if not
1004            f_sNx = -1  C           f_sNx = -1
1005            f_sNy = -1  C           f_sNy = -1
1006            err = NF_INQ_ATT(fid,NF_GLOBAL, 'sNx',atype,alen)  C           err = NF_INQ_ATT(fid,NF_GLOBAL, 'sNx',atype,alen)
1007            IF ((err .EQ. NF_NOERR) .AND. (alen .EQ. 1)) THEN  C           IF ((err .EQ. NF_NOERR) .AND. (alen .EQ. 1)) THEN
1008              err = NF_GET_ATT_INT(fid, NF_GLOBAL, 'sNx', f_sNx)  C             err = NF_GET_ATT_INT(fid, NF_GLOBAL, 'sNx', f_sNx)
1009              CALL MNC_HANDLE_ERR(err,  C             CALL MNC_HANDLE_ERR(err,
1010       &           'reading attribute ''sNx'' in S/R MNC_CW_RX_R',  C      &           'reading attribute ''sNx'' in S/R MNC_CW_RX_R',
1011       &           myThid)  C      &           myThid)
1012            ENDIF  C           ENDIF
1013            err = NF_INQ_ATT(fid,NF_GLOBAL, 'sNy',atype,alen)  C           err = NF_INQ_ATT(fid,NF_GLOBAL, 'sNy',atype,alen)
1014            IF ((err .EQ. NF_NOERR) .AND. (alen .EQ. 1)) THEN  C           IF ((err .EQ. NF_NOERR) .AND. (alen .EQ. 1)) THEN
1015              err = NF_GET_ATT_INT(fid, NF_GLOBAL, 'sNy', f_sNy)  C             err = NF_GET_ATT_INT(fid, NF_GLOBAL, 'sNy', f_sNy)
1016              CALL MNC_HANDLE_ERR(err,  C             CALL MNC_HANDLE_ERR(err,
1017       &           'reading attribute ''sNy'' in S/R MNC_CW_RX_R',  C      &           'reading attribute ''sNy'' in S/R MNC_CW_RX_R',
1018       &           myThid)  C      &           myThid)
1019            ENDIF  C           ENDIF
1020            IF ((f_sNx .NE. sNx) .OR. (f_sNy .NE. sNy)) THEN  C           IF ((f_sNx .NE. sNx) .OR. (f_sNy .NE. sNy)) THEN
1021              write(msgbuf,'(5a)') 'MNC_CW_RX_R WARNING: the ',  C             write(msgbuf,'(5a)') 'MNC_CW_RX_R WARNING: the ',
1022       &           'attributes ''sNx'' and ''sNy'' within the file ''',  C      &           'attributes ''sNx'' and ''sNy'' within the file ''',
1023       &           fname(1:nfname), ''' do not exist or do not match ',  C      &           fname(1:nfname), ''' do not exist or do not match ',
1024       &           'the current sizes within the model'  C      &           'the current sizes within the model'
1025              CALL print_error(msgbuf, mythid)  C             CALL print_error(msgbuf, mythid)
1026            ENDIF  C           ENDIF
1027    
1028  C         Check that the in-memory variable and the in-file variables  C         Check that the in-memory variable and the in-file variables
1029  C         are of compatible sizes  C         are of compatible sizes
# Line 616  C         the unlimited dimension offset Line 1075  C         the unlimited dimension offset
1075              IF (i .LE. ndim) THEN              IF (i .LE. ndim) THEN
1076                s(i) = mnc_cw_is(i,igrid)                s(i) = mnc_cw_is(i,igrid)
1077                e(i) = mnc_cw_ie(i,igrid)                e(i) = mnc_cw_ie(i,igrid)
1078    
1079                  IF ( f_or_t .EQ. 1 ) THEN
1080    C               Add the per-face X,Y offsets to the udo offset vector
1081    C               since they accomplish the same thing
1082                    IF ( mnc_cw_dn(i,igrid)(1:1) .EQ. 'X' ) THEN
1083                      udo(i) = ixoff - 1
1084                    ELSEIF ( mnc_cw_dn(i,igrid)(1:1) .EQ. 'Y' ) THEN
1085                      udo(i) = iyoff - 1
1086                    ENDIF
1087                  ENDIF
1088    
1089              ENDIF              ENDIF
1090  C           Check for the unlimited dimension  C           Check for the unlimited dimension
1091              IF ((i .EQ. ndim)              IF ((i .EQ. ndim)
# Line 623  C           Check for the unlimited dime Line 1093  C           Check for the unlimited dime
1093                IF (indu .GT. 0) THEN                IF (indu .GT. 0) THEN
1094  C               Use the indu value  C               Use the indu value
1095                  udo(i) = indu - 1                  udo(i) = indu - 1
               ELSEIF (indu .EQ. -1) THEN  
 C               Append one to the current unlimited dim size  
                 CALL MNC_DIM_UNLIM_SIZE( fname, unlim_sz, myThid)  
                 udo(i) = unlim_sz  
1096                ELSE                ELSE
1097  C               Use the current unlimited dim size  C               We need the current unlim dim size
1098                  CALL MNC_DIM_UNLIM_SIZE( fname, unlim_sz, myThid)                  write(msgbuf,'(5a)') 'MNC_CW_RX_R: getting the ',
1099                  udo(i) = unlim_sz - 1       &               'unlim dim id within file ''',
1100         &               fname(1:nfname), ''''
1101                    err = NF_INQ_UNLIMDIM(fid, unlid)
1102                    CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
1103                    write(msgbuf,'(5a)') 'MNC_CW_RX_R: getting the ',
1104         &               'unlim dim size within file ''',
1105         &               fname(1:nfname), ''''
1106                    err = NF_INQ_DIMLEN(fid, unlid, unlim_sz)
1107                    CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
1108                    udo(i) = unlim_sz
1109                ENDIF                ENDIF
1110              ENDIF              ENDIF
1111            ENDDO            ENDDO
# Line 647  C     DO i = 9,1,-1 Line 1122  C     DO i = 9,1,-1
1122  C     write(*,*) 'i,p(i),s(i),e(i) = ', i,': ',p(i),s(i),e(i)  C     write(*,*) 'i,p(i),s(i),e(i) = ', i,': ',p(i),s(i),e(i)
1123  C     ENDDO  C     ENDDO
1124                        
           CALL MNC_FILE_ENDDEF(fname, myThid)  
   
1125            write(msgbuf,'(5a)') 'reading variable type ''',            write(msgbuf,'(5a)') 'reading variable type ''',
1126       &         vtype(nvf:nvl), ''' within file ''',       &         vtype(nvf:nvl), ''' within file ''',
1127       &         fname(1:nfname), ''''       &         fname(1:nfname), ''''
# Line 682  C         Read the variable one vector a Line 1155  C         Read the variable one vector a
1155        kr = 0        kr = 0
1156        vstart(1) = udo(1) + 1        vstart(1) = udo(1) + 1
1157        vcount(1) = e(1) - s(1) + 1        vcount(1) = e(1) - s(1) + 1
1158          
1159          IF (vcount(1) .GT. MNC_MAX_BUFF) THEN
1160            write(msgbuf,'(2a,I7,a)') 'MNC_MAX_BUFF is too small',
1161         &       '--please increase to at least ',
1162         &       vcount(1), ' in ''MNC_BUFF.h'''
1163            CALL PRINT_ERROR(msgBuf , 1)
1164            STOP 'ABNORMAL END: S/R MNC_CW_RX_R_OFFSET'
1165          ENDIF
1166    
1167        IF (stype(1:1) .EQ. 'D') THEN        IF (stype(1:1) .EQ. 'D') THEN
1168          err = NF_GET_VARA_DOUBLE(fid, idv, vstart, vcount, resh_d)          err = NF_GET_VARA_DOUBLE(fid, idv, vstart, vcount, resh_d)
1169          CALL MNC_HANDLE_ERR(err, msgbuf, myThid)          CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
1170          DO j1 = s(1),e(1)          DO j1 = s(1),e(1)
1171            k1 = k2 + j1            k1 = k2 + j1
1172            kr = kr + 1            kr = kr + 1
1173            var(k1) = resh_d(kr)            var(k1) = MNCI2( resh_d(kr) )
1174          ENDDO          ENDDO
1175        ENDIF        ENDIF
1176        IF (stype(1:1) .EQ. 'R') THEN        IF (stype(1:1) .EQ. 'R') THEN
# Line 698  C         Read the variable one vector a Line 1179  C         Read the variable one vector a
1179          DO j1 = s(1),e(1)          DO j1 = s(1),e(1)
1180            k1 = k2 + j1            k1 = k2 + j1
1181            kr = kr + 1            kr = kr + 1
1182            var(k1) = resh_r(kr)            var(k1) = MNCI2( resh_r(kr) )
1183          ENDDO          ENDDO
1184        ENDIF        ENDIF
1185        IF (stype(1:1) .EQ. 'I') THEN        IF (stype(1:1) .EQ. 'I') THEN
# Line 711  C         Read the variable one vector a Line 1192  C         Read the variable one vector a
1192          ENDDO          ENDDO
1193        ENDIF        ENDIF
1194    
         
1195    
1196                      ENDDO                      ENDDO
1197                    ENDDO                    ENDDO
# Line 721  C         Read the variable one vector a Line 1201  C         Read the variable one vector a
1201            ENDDO            ENDDO
1202    
1203  C         Close the file  C         Close the file
1204            CALL MNC_FILE_CLOSE(fname, myThid)  C         CALL MNC_FILE_CLOSE(fname, myThid)
1205              err = NF_CLOSE(fid)
1206              write(msgbuf,'(3a)') 'MNC_CW_RX_R:  cannot close file ''',
1207         &         fname(1:nfname), ''''
1208              CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
1209    
1210    
1211  C         End the lbj,lbi loops  C         End the lbj,lbi loops
1212          ENDDO          ENDDO
Legend:
Removed from v.1.19  
changed lines
  Added in v.1.40
  ViewVC Help
Powered by ViewVC 1.1.22