/[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.3 by edhill, Thu Feb 5 00:13:47 2004 UTC revision 1.9 by edhill, Fri Mar 19 03:28:36 2004 UTC
# Line 6  C $Name$ Line 6  C $Name$
6  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7    
8        SUBROUTINE MNC_CW_RX_W_YY(        SUBROUTINE MNC_CW_RX_W_YY(
      I     myThid,  
9       I     fbname, bi,bj,       I     fbname, bi,bj,
10       I     vtype,       I     vtype,
11       I     indu,       I     indu,
12       I     var )       I     var,
13         I     myThid )
14    
15        implicit none        implicit none
16    
# Line 24  C---+----1----+----2----+----3----+----4 Line 24  C---+----1----+----2----+----3----+----4
24  C     Arguments  C     Arguments
25        integer myThid, bi,bj, indu        integer myThid, bi,bj, indu
26        character*(*) fbname, vtype        character*(*) fbname, vtype
27        _RX var(*)        __V var(*)
28    
29  C     Functions  C     Functions
30        integer IFNBLNK, ILNBLNK        integer IFNBLNK, ILNBLNK
# Line 41  C     Local Variables Line 41  C     Local Variables
41  C     Temporary storage for the simultaneous type conversion and  C     Temporary storage for the simultaneous type conversion and
42  C     re-shaping before passing to NetCDF  C     re-shaping before passing to NetCDF
43  #ifdef  mnc_rtype_D  #ifdef  mnc_rtype_D
44        REAL*8 resh( sNx + 2*OLx + sNy + 2*OLy )        REAL*8  resh( sNx + 2*OLx + sNy + 2*OLy )
45  #endif  #endif
46  #ifdef  mnc_rtype_R  #ifdef  mnc_rtype_R
47        REAL*4 resh( sNx + 2*OLx + sNy + 2*OLy )        REAL*4  resh( sNx + 2*OLx + sNy + 2*OLy )
48    #endif
49    #ifdef  mnc_rtype_I
50          INTEGER resh( sNx + 2*OLx + sNy + 2*OLy )
51  #endif  #endif
52    
53  C     Only do I/O if I am the master thread  C     Only do I/O if I am the master thread
# Line 53  C     Only do I/O if I am the master thr Line 56  C     Only do I/O if I am the master thr
56  C     Check that the Variable Type exists  C     Check that the Variable Type exists
57        nvf = IFNBLNK(vtype)        nvf = IFNBLNK(vtype)
58        nvl = ILNBLNK(vtype)        nvl = ILNBLNK(vtype)
59        CALL MNC_GET_IND(myThid, MNC_MAX_ID, vtype, mnc_cw_vname, indv)        CALL MNC_GET_IND(MNC_MAX_ID, vtype, mnc_cw_vname, indv, myThid)
60        IF (indv .LT. 1) THEN        IF (indv .LT. 1) THEN
61          write(msgbuf,'(3a)') 'MNC_CW_RX_WRITES_YY ERROR: vtype ''',          write(msgbuf,'(3a)') 'MNC_CW_RX_W_YY ERROR: vtype ''',
62       &       vtype(nvf:nvl), ''' is not defined'       &       vtype(nvf:nvl), ''' is not defined'
63          CALL print_error(msgbuf, mythid)          CALL print_error(msgbuf, mythid)
64          stop 'ABNORMAL END: S/R MNC_CW_RX_WRITES_YY'          STOP 'ABNORMAL END: S/R MNC_CW_RX_W_YY'
65        ENDIF        ENDIF
66        igrid = mnc_cw_vgind(indv)        igrid = mnc_cw_vgind(indv)
67    
68  C      C     Set the bi,bj indicies
69        bis = bi        bis = bi
70        bie = bi        bie = bi
71        IF (bi .LT. 1) THEN        IF (bi .LT. 1) THEN
# Line 79  C Line 82  C
82        DO lbj = bjs,bje        DO lbj = bjs,bje
83          DO lbi = bis,bie          DO lbi = bis,bie
84    
       write(*,*) 'lbi,lbj = ',lbi,lbj, '  ', vtype(nvf:nvl)  
   
85  C         Create the file name  C         Create the file name
86            CALL MNC_CW_GET_TILE_NUM(myThid, lbi,lbj, uniq_tnum)            CALL MNC_CW_GET_TILE_NUM(lbi,lbj, uniq_tnum, myThid)
87            fname(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)            fname(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)
88            n1 = IFNBLNK(fbname)            n1 = IFNBLNK(fbname)
89            n2 = ILNBLNK(fbname)            n2 = ILNBLNK(fbname)
# Line 94  C         Create the file name Line 95  C         Create the file name
95            nfname = ntot+9            nfname = ntot+9
96    
97  C         Append to an existing or create a new file  C         Append to an existing or create a new file
98            CALL MNC_CW_FILE_AORC(myThid, fname, indf)            CALL MNC_CW_FILE_AORC(fname, indf, myThid)
99            fid = mnc_f_info(indf,2)            fid = mnc_f_info(indf,2)
100    
101  C         Ensure that all the NetCDF dimensions are defined and create a  C         Ensure that all the NetCDF dimensions are defined and create a
# Line 108  C         local copy of them Line 109  C         local copy of them
109              ELSE              ELSE
110                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
111              ENDIF              ENDIF
112              CALL MNC_DIM_INIT(myThid,fname,              CALL MNC_DIM_INIT(fname,
113       &           mnc_cw_dn(i,igrid), dimnc(i) )       &           mnc_cw_dn(i,igrid), dimnc(i), myThid)
114            ENDDO            ENDDO
115    
116  C         Ensure that the "grid" is defined  C         Ensure that the "grid" is defined
117            CALL MNC_GRID_INIT(myThid,fname, mnc_cw_gname(igrid),            CALL MNC_GRID_INIT(fname, mnc_cw_gname(igrid),
118       &        mnc_cw_ndim(igrid), mnc_cw_dn(1,igrid))       &        mnc_cw_ndim(igrid), mnc_cw_dn(1,igrid), myThid)
119    
120  C         Ensure that the variable is defined  C         Ensure that the variable is defined
121  #ifdef  mnc_rtype_D  #ifdef  mnc_rtype_D
122        CALL MNC_VAR_INIT_DBL(myThid,fname,mnc_cw_gname(igrid),vtype)        CALL MNC_VAR_INIT_DBL(fname,mnc_cw_gname(igrid),vtype, myThid)
123  #endif  #endif
124  #ifdef  mnc_rtype_R  #ifdef  mnc_rtype_R
125        CALL MNC_VAR_INIT_REAL(myThid,fname,mnc_cw_gname(igrid),vtype)        CALL MNC_VAR_INIT_REAL(fname,mnc_cw_gname(igrid),vtype, myThid)
126    #endif
127    #ifdef  mnc_rtype_I
128          CALL MNC_VAR_INIT_INT(fname,mnc_cw_gname(igrid),vtype, myThid)
129  #endif  #endif
130            DO i = 1,mnc_fv_ids(indf,1)            DO i = 1,mnc_fv_ids(indf,1)
131              j = 2 + 3*(i - 1)              j = 2 + 3*(i - 1)
# Line 132  C         Ensure that the variable is de Line 136  C         Ensure that the variable is de
136                GOTO 10                GOTO 10
137              ENDIF              ENDIF
138            ENDDO            ENDDO
139            write(msgbuf,'(4a)') 'MNC_MNC_CW_RX_WRITES_YY ERROR: ',            write(msgbuf,'(4a)') 'MNC_MNC_CW_RX_W_YY ERROR: ',
140       &         'cannot reference variable ''', vtype, ''''       &         'cannot reference variable ''', vtype, ''''
141            CALL print_error(msgbuf, mythid)            CALL print_error(msgbuf, mythid)
142            stop 'ABNORMAL END: package MNC'            STOP 'ABNORMAL END: package MNC'
143   10       CONTINUE   10       CONTINUE
144    
145  C         Check for bi,bj indicies  C         Check for bi,bj indicies
146            bidim = mnc_cw_vbij(1,indv)            bidim = mnc_cw_vbij(1,indv)
147            bjdim = mnc_cw_vbij(2,indv)            bjdim = mnc_cw_vbij(2,indv)
148    CEH3      write(*,*) 'bidim,bjdim = ', bidim,bjdim
149    
150  C         Set the dimensions for the in-memory array  C         Set the dimensions for the in-memory array
151            ndim = mnc_cw_ndim(igrid)            ndim = mnc_cw_ndim(igrid)
# Line 182  C               Use the indu value Line 187  C               Use the indu value
187                  udo(i) = indu - 1                  udo(i) = indu - 1
188                ELSEIF (indu .EQ. -1) THEN                ELSEIF (indu .EQ. -1) THEN
189  C               Append one to the current unlimited dim size  C               Append one to the current unlimited dim size
190                  CALL MNC_DIM_UNLIM_SIZE(myThid, fname, unlim_sz)                  CALL MNC_DIM_UNLIM_SIZE( fname, unlim_sz, myThid)
191                  udo(i) = unlim_sz                  udo(i) = unlim_sz
192                ELSE                ELSE
193  C               Use the current unlimited dim size  C               Use the current unlimited dim size
194                  CALL MNC_DIM_UNLIM_SIZE(myThid, fname, unlim_sz)                  CALL MNC_DIM_UNLIM_SIZE( fname, unlim_sz, myThid)
195                  udo(i) = unlim_sz - 1                  udo(i) = unlim_sz - 1
196                ENDIF                ENDIF
197              ENDIF              ENDIF
# Line 199  C               Use the current unlimite Line 204  C               Use the current unlimite
204              s(bjdim) = lbj              s(bjdim) = lbj
205              e(bjdim) = lbj              e(bjdim) = lbj
206            ENDIF            ENDIF
207  CEH3          DO i = 1,7  CEH3      DO i = 1,9
208  CEH3            write(*,*) 'i,s(i),e(i) = ', i,s(i),e(i)  CEH3        write(*,*) 'i,p(i),s(i),e(i) = ', i,p(i),s(i),e(i)
209  CEH3          ENDDO  CEH3      ENDDO
210    
211  C         Add the global attributes  C         Add the global attributes
212            CALL MNC_CW_SET_GATTR(myThid, fname, lbi,lbj, uniq_tnum)            CALL MNC_CW_SET_GATTR( fname, lbi,lbj, uniq_tnum, myThid)
213    
214  C         Add the per-variable attributes  C         Add the per-variable attributes
215            DO i = 1,mnc_cw_vnat(1,indv)            DO i = 1,mnc_cw_vnat(1,indv)
216              CALL MNC_VAR_ADD_ATTR_STR(myThid, fname, vtype,              CALL MNC_VAR_ADD_ATTR_STR( fname, vtype,
217       &           mnc_cw_vtnm(i,indv), mnc_cw_vtat(i,indv))       &           mnc_cw_vtnm(i,indv), mnc_cw_vtat(i,indv), myThid)
218            ENDDO            ENDDO
219            DO i = 1,mnc_cw_vnat(2,indv)            DO i = 1,mnc_cw_vnat(2,indv)
220              CALL MNC_VAR_ADD_ATTR_INT(myThid, fname, vtype,              CALL MNC_VAR_ADD_ATTR_INT( fname, vtype,
221       &           mnc_cw_vinm(i,indv), 1, mnc_cw_viat(i,indv))       &           mnc_cw_vinm(i,indv), 1, mnc_cw_viat(i,indv), myThid)
222            ENDDO            ENDDO
223            DO i = 1,mnc_cw_vnat(3,indv)            DO i = 1,mnc_cw_vnat(3,indv)
224              CALL MNC_VAR_ADD_ATTR_DBL(myThid, fname, vtype,              CALL MNC_VAR_ADD_ATTR_DBL( fname, vtype,
225       &           mnc_cw_vdnm(i,indv), 1, mnc_cw_vdat(i,indv))       &           mnc_cw_vdnm(i,indv), 1, mnc_cw_vdat(i,indv), myThid)
226            ENDDO            ENDDO
227    
228            CALL MNC_FILE_ENDDEF(myThid,fname)            CALL MNC_FILE_ENDDEF(fname, myThid)
229    
230              write(msgbuf,'(5a)') 'writing variable type ''',
231         &         vtype(nvf:nvl), ''' within file ''',
232         &         fname(1:nfname), ''''
233    
234  C         Write the variable one vector at a time  C         Write the variable one vector at a time
235            DO j7 = s(7),e(7)            DO j7 = s(7),e(7)
236              k7 = (j7 - s(7))*p(6)              k7 = (j7 - 1)*p(6)
237              vstart(7) = udo(7) + j7 - s(7) + 1              vstart(7) = udo(7) + j7 - s(7) + 1
238              vcount(7) = 1              vcount(7) = 1
239              DO j6 = s(6),e(6)              DO j6 = s(6),e(6)
240                k6 = (j6 - s(6))*p(5) + k7                k6 = (j6 - 1)*p(5) + k7
241                vstart(6) = udo(6) + j6 - s(6) + 1                vstart(6) = udo(6) + j6 - s(6) + 1
242                vcount(6) = 1                vcount(6) = 1
243                DO j5 = s(5),e(5)                DO j5 = s(5),e(5)
244                  k5 = (j5 - s(5))*p(4) + k6                  k5 = (j5 - 1)*p(4) + k6
245                  vstart(5) = udo(5) + j5 - s(5) + 1                  vstart(5) = udo(5) + j5 - s(5) + 1
246                  vcount(5) = 1                  vcount(5) = 1
247                  DO j4 = s(4),e(4)                  DO j4 = s(4),e(4)
248                    k4 = (j4 - s(4))*p(3) + k5                    k4 = (j4 - 1)*p(3) + k5
249                    vstart(4) = udo(4) + j4 - s(4) + 1                    vstart(4) = udo(4) + j4 - s(4) + 1
250                    vcount(4) = 1                    vcount(4) = 1
251                    DO j3 = s(3),e(3)                    DO j3 = s(3),e(3)
252                      k3 = (j3 - s(3))*p(2) + k4                      k3 = (j3 - 1)*p(2) + k4
253                      vstart(3) = udo(3) + j3 - s(3) + 1                      vstart(3) = udo(3) + j3 - s(3) + 1
254                      vcount(3) = 1                      vcount(3) = 1
255                      DO j2 = s(2),e(2)                      DO j2 = s(2),e(2)
256                        k2 = (j2 - s(2))*p(1) + k3                        k2 = (j2 - 1)*p(1) + k3
257                        vstart(2) = udo(2) + j2 - s(2) + 1                        vstart(2) = udo(2) + j2 - s(2) + 1
258                        vcount(2) = 1                        vcount(2) = 1
259    
 CEH3      write(*,*) 's/e: ', k2+s(1), k2+e(1)  
         
260        kr = 0        kr = 0
261        DO j1 = s(1),e(1)        DO j1 = s(1),e(1)
262          k1 = k2 + j1          k1 = k2 + j1
# Line 266  CEH3      write(*,*) 's/e: ', k2+s(1), k Line 273  CEH3      write(*,*) 's/e: ', k2+s(1), k
273  #ifdef  mnc_rtype_R  #ifdef  mnc_rtype_R
274        err = NF_PUT_VARA_REAL(fid, idv, vstart, vcount, resh)        err = NF_PUT_VARA_REAL(fid, idv, vstart, vcount, resh)
275  #endif  #endif
276    #ifdef  mnc_rtype_I
277          err = NF_PUT_VARA_INT(fid, idv, vstart, vcount, resh)
278    #endif
279    
280          CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
281    
282                      ENDDO                      ENDDO
283                    ENDDO                    ENDDO
# Line 277  CEH3      write(*,*) 's/e: ', k2+s(1), k Line 289  CEH3      write(*,*) 's/e: ', k2+s(1), k
289  C         Sync the file  C         Sync the file
290            err = NF_SYNC(fid)            err = NF_SYNC(fid)
291            write(msgbuf,'(3a)') 'sync for file ''', fname,            write(msgbuf,'(3a)') 'sync for file ''', fname,
292       &         ''' in S/R MNC_CW_RX_WRITES_YY'       &         ''' in S/R MNC_CW_RX_W_YY'
293            CALL MNC_HANDLE_ERR(myThid, err, msgbuf)            CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
294    
295            ENDDO
296          ENDDO
297    
298          _END_MASTER( myThid )
299    
300          RETURN
301          END
302          
303    
304    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
305    
306    
307          SUBROUTINE MNC_CW_RX_R_YY(
308         I     fbname, bi,bj,
309         I     vtype,
310         I     indu,
311         I     var,
312         I     myThid )
313    
314          implicit none
315    
316    #include "netcdf.inc"
317    #include "mnc_common.h"
318    #include "EEPARAMS.h"
319    #include "SIZE.h"
320    
321    #define mnc_rtype_YY
322    
323    C     Arguments
324          integer myThid, bi,bj, indu
325          character*(*) fbname, vtype
326          __V var(*)
327    
328    C     Functions
329          integer IFNBLNK, ILNBLNK
330    
331    C     Local Variables
332          integer i,k, nvf,nvl, n1,n2, igrid, ntot
333          integer bis,bie, bjs,bje, uniq_tnum, nfname, fid, idv
334          integer ndim, indf, err, lbi,lbj, bidim,bjdim, unlim_sz, kr
335          integer ind_fv_ids, ind_vt, ierr, atype, alen
336          integer f_sNx,f_sNy, ires
337          integer p(9),s(9),e(9), vstart(9),vcount(9), udo(9)
338          integer j1,j2,j3,j4,j5,j6,j7, k1,k2,k3,k4,k5,k6,k7
339          character*(MAX_LEN_MBUF) msgbuf
340          character*(MNC_MAX_CHAR) fname
341    
342    C     Temporary storage for the simultaneous type conversion and
343    C     re-shaping before passing to NetCDF
344    #ifdef  mnc_rtype_D
345          REAL*8  resh( sNx + 2*OLx + sNy + 2*OLy )
346    #endif
347    #ifdef  mnc_rtype_R
348          REAL*4  resh( sNx + 2*OLx + sNy + 2*OLy )
349    #endif
350    #ifdef  mnc_rtype_I
351          INTEGER resh( sNx + 2*OLx + sNy + 2*OLy )
352    #endif
353    
354    C     Only do I/O if I am the master thread
355          _BEGIN_MASTER( myThid )
356    
357    C     Check that the Variable Type exists
358          nvf = IFNBLNK(vtype)
359          nvl = ILNBLNK(vtype)
360          CALL MNC_GET_IND( MNC_MAX_ID, vtype, mnc_cw_vname, ind_vt, myThid)
361          IF (ind_vt .LT. 1) THEN
362            write(msgbuf,'(3a)') 'MNC_CW_RX_R_YY ERROR: vtype ''',
363         &       vtype(nvf:nvl), ''' is not defined'
364            CALL print_error(msgbuf, mythid)
365            STOP 'ABNORMAL END: S/R MNC_CW_RX_R_YY'
366          ENDIF
367          igrid = mnc_cw_vgind(ind_vt)
368    
369    C     Check for bi,bj indicies
370          bidim = mnc_cw_vbij(1,ind_vt)
371          bjdim = mnc_cw_vbij(2,ind_vt)
372    
373    C     Set the bi,bj indicies
374          bis = bi
375          bie = bi
376          IF (bi .LT. 1) THEN
377            bis = 1
378            bie = nSx
379          ENDIF
380          bjs = bj
381          bje = bj
382          IF (bj .LT. 1) THEN
383            bjs = 1
384            bje = nSy
385          ENDIF
386    
387          DO lbj = bjs,bje
388            DO lbi = bis,bie
389    
390    C         Create the file name
391              CALL MNC_CW_GET_TILE_NUM( lbi,lbj, uniq_tnum, myThid)
392              fname(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)
393              n1 = IFNBLNK(fbname)
394              n2 = ILNBLNK(fbname)
395              ntot = n2 - n1 + 1
396              fname(1:ntot) = fbname(n1:n2)
397              ntot = ntot + 1
398              fname(ntot:ntot) = '.'
399              write(fname((ntot+1):(ntot+9)),'(i6.6,a3)') uniq_tnum, '.nc'
400              nfname = ntot+9
401    
402    C         Open the existing file
403              CALL MNC_FILE_TRY_READ( fname, ierr, indf, myThid)
404    
405    C         Check that the variable (VType) is defined within the file
406              CALL MNC_GET_FVINDS( fname, vtype, indf, ind_fv_ids, myThid)
407              IF ((indf .LT. 1) .OR. (ind_fv_ids .LT. 1)) THEN
408                write(msgbuf,'(4a)') 'MNC_CW_RX_R_YY ERROR: vtype ''',
409         &           vtype(nvf:nvl), ''' is not defined within file ''',
410         &           fname(1:nfname)
411                CALL print_error(msgbuf, mythid)
412                STOP 'ABNORMAL END: S/R MNC_CW_RX_R_YY'
413              ENDIF
414              fid = mnc_f_info(indf,2)
415              idv = mnc_fv_ids(indf,ind_fv_ids+1)
416    
417    C         Check that the current sNy,sNy values and the in-file values
418    C         are compatible and WARN (only warn) if not
419              f_sNx = -1
420              f_sNy = -1
421              err = NF_INQ_ATT(fid,NF_GLOBAL, 'sNx',atype,alen)
422              IF ((err .EQ. NF_NOERR) .AND. (alen .EQ. 1)) THEN
423                err = NF_GET_ATT_INT(fid, NF_GLOBAL, 'sNx', f_sNx)
424                CALL MNC_HANDLE_ERR(err,
425         &           'reading attribute ''sNx'' in S/R MNC_CW_RX_R_YY',
426         &           myThid)
427              ENDIF
428              err = NF_INQ_ATT(fid,NF_GLOBAL, 'sNy',atype,alen)
429              IF ((err .EQ. NF_NOERR) .AND. (alen .EQ. 1)) THEN
430                err = NF_GET_ATT_INT(fid, NF_GLOBAL, 'sNy', f_sNy)
431                CALL MNC_HANDLE_ERR(err,
432         &           'reading attribute ''sNy'' in S/R MNC_CW_RX_R_YY',
433         &           myThid)
434              ENDIF
435              IF ((f_sNx .NE. sNx) .OR. (f_sNy .NE. sNy)) THEN
436                write(msgbuf,'(5a)') 'MNC_CW_RX_R_YY WARNING: the ',
437         &           'attributes ''sNx'' and ''sNy'' within the file ''',
438         &           fname(1:nfname), ''' do not exist or do not match ',
439         &           'the current sizes within the model'
440                CALL print_error(msgbuf, mythid)
441              ENDIF
442    
443    C         Check that the in-memory variable and the in-file variables
444    C         are of compatible sizes
445    C           ires = 1
446    C           CALL MNC_CHK_VTYP_R_NCVAR( ind_vt,
447    C      &         indf, ind_fv_ids, indu, ires)
448    C           IF (ires .LT. 0) THEN
449    C             write(msgbuf,'(7a)') 'MNC_CW_RX_R_YY WARNING: the sizes ',
450    C      &           'of the in-program variable ''', vtype(nvf:nvl),
451    C      &           ''' and the corresponding variable within file ''',
452    C      &           fname(1:nfname), ''' are not compatible -- please ',
453    C      &           'check the sizes'
454    C             CALL print_error(msgbuf, mythid)
455    C             STOP 'ABNORMAL END: S/R MNC_CW_RX_R_YY'
456    C           ENDIF
457    
458    C         Check for bi,bj indicies
459              bidim = mnc_cw_vbij(1,ind_vt)
460              bjdim = mnc_cw_vbij(2,ind_vt)
461    
462    C         Set the dimensions for the in-memory array
463              ndim = mnc_cw_ndim(igrid)
464              k = mnc_cw_dims(1,igrid)
465              IF (k .GT. 0) THEN
466                p(1) = k
467              ELSE
468                p(1) = 1
469              ENDIF
470              DO i = 2,9
471                k = mnc_cw_dims(i,igrid)
472                IF (k .LT. 1) THEN
473                  k = 1
474                ENDIF
475                IF ((bidim .GT. 0) .AND. (i .EQ. bidim)) THEN
476                  p(i) = nSx * p(i-1)
477                ELSEIF ((bjdim .GT. 0) .AND. (i .EQ. bjdim)) THEN
478                  p(i) = nSy * p(i-1)
479                ELSE
480                  p(i) = k * p(i-1)
481                ENDIF
482              ENDDO
483    
484    C         Set starting and ending indicies for the in-memory array and
485    C         the unlimited dimension offset for the NetCDF array
486              DO i = 1,9
487                udo(i) = 0
488                s(i) = 1
489                e(i) = 1
490                IF (i .LE. ndim) THEN
491                  s(i) = mnc_cw_is(i,igrid)
492                  e(i) = mnc_cw_ie(i,igrid)
493                ENDIF
494    C           Check for the unlimited dimension
495                IF ((i .EQ. ndim)
496         &           .AND. (mnc_cw_dims(i,igrid) .EQ. -1)) THEN
497                  IF (indu .GT. 0) THEN
498    C               Use the indu value
499                    udo(i) = indu - 1
500                  ELSEIF (indu .EQ. -1) THEN
501    C               Append one to the current unlimited dim size
502                    CALL MNC_DIM_UNLIM_SIZE( fname, unlim_sz, myThid)
503                    udo(i) = unlim_sz
504                  ELSE
505    C               Use the current unlimited dim size
506                    CALL MNC_DIM_UNLIM_SIZE( fname, unlim_sz, myThid)
507                    udo(i) = unlim_sz - 1
508                  ENDIF
509                ENDIF
510              ENDDO
511              IF (bidim .GT. 0) THEN
512                s(bidim) = lbi
513                e(bidim) = lbi
514              ENDIF
515              IF (bjdim .GT. 0) THEN
516                s(bjdim) = lbj
517                e(bjdim) = lbj
518              ENDIF
519    
520    C     DO i = 9,1,-1
521    C     write(*,*) 'i,p(i),s(i),e(i) = ', i,': ',p(i),s(i),e(i)
522    C     ENDDO
523              
524              CALL MNC_FILE_ENDDEF(fname, myThid)
525    
526              write(msgbuf,'(5a)') 'reading variable type ''',
527         &         vtype(nvf:nvl), ''' within file ''',
528         &         fname(1:nfname), ''''
529    
530    C         Read the variable one vector at a time
531              DO j7 = s(7),e(7)
532                k7 = (j7 - 1)*p(6)
533                vstart(7) = udo(7) + j7 - s(7) + 1
534                vcount(7) = 1
535                DO j6 = s(6),e(6)
536                  k6 = (j6 - 1)*p(5) + k7
537                  vstart(6) = udo(6) + j6 - s(6) + 1
538                  vcount(6) = 1
539                  DO j5 = s(5),e(5)
540                    k5 = (j5 - 1)*p(4) + k6
541                    vstart(5) = udo(5) + j5 - s(5) + 1
542                    vcount(5) = 1
543                    DO j4 = s(4),e(4)
544                      k4 = (j4 - 1)*p(3) + k5
545                      vstart(4) = udo(4) + j4 - s(4) + 1
546                      vcount(4) = 1
547                      DO j3 = s(3),e(3)
548                        k3 = (j3 - 1)*p(2) + k4
549                        vstart(3) = udo(3) + j3 - s(3) + 1
550                        vcount(3) = 1
551                        DO j2 = s(2),e(2)
552                          k2 = (j2 - 1)*p(1) + k3
553                          vstart(2) = udo(2) + j2 - s(2) + 1
554                          vcount(2) = 1
555    
556          vstart(1) = udo(1) + 1
557          vcount(1) = e(1) - s(1) + 1
558          
559    #ifdef  mnc_rtype_D
560          err = NF_GET_VARA_DOUBLE(fid, idv, vstart, vcount, resh)
561    #endif
562    #ifdef  mnc_rtype_R
563          err = NF_GET_VARA_REAL(fid, idv, vstart, vcount, resh)
564    #endif
565    #ifdef  mnc_rtype_I
566          err = NF_GET_VARA_INT(fid, idv, vstart, vcount, resh)
567    #endif
568    
569          CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
570    
571          kr = 0
572          DO j1 = s(1),e(1)
573            k1 = k2 + j1
574            kr = kr + 1
575            var(k1) = resh(kr)
576          ENDDO
577          
578    
579                        ENDDO
580                      ENDDO
581                    ENDDO
582                  ENDDO
583                ENDDO
584              ENDDO
585    
586    C         Close the file
587              CALL MNC_FILE_CLOSE(fname, myThid)
588    
589    C         End the lbj,lbi loops
590          ENDDO          ENDDO
591        ENDDO        ENDDO
592    
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.9
  ViewVC Help
Powered by ViewVC 1.1.22