/[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.8 by edhill, Wed Mar 10 05:50:16 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 56  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_W_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'
# Line 83  C     Set the bi,bj indicies Line 83  C     Set the bi,bj indicies
83          DO lbi = bis,bie          DO lbi = bis,bie
84    
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 95  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 109  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  #endif
127  #ifdef  mnc_rtype_I  #ifdef  mnc_rtype_I
128        CALL MNC_VAR_INIT_INT(myThid,fname,mnc_cw_gname(igrid),vtype)        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 187  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 209  CEH3        write(*,*) 'i,p(i),s(i),e(i) Line 209  CEH3        write(*,*) '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 ''',            write(msgbuf,'(5a)') 'writing variable type ''',
231       &         vtype(nvf:nvl), ''' within file ''',       &         vtype(nvf:nvl), ''' within file ''',
# Line 277  C         Write the variable one vector Line 277  C         Write the variable one vector
277        err = NF_PUT_VARA_INT(fid, idv, vstart, vcount, resh)        err = NF_PUT_VARA_INT(fid, idv, vstart, vcount, resh)
278  #endif  #endif
279    
280        CALL MNC_HANDLE_ERR(myThid, err, msgbuf)        CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
281    
282                      ENDDO                      ENDDO
283                    ENDDO                    ENDDO
# Line 290  C         Sync the file Line 290  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_W_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          ENDDO
296        ENDDO        ENDDO
# Line 305  C---+----1----+----2----+----3----+----4 Line 305  C---+----1----+----2----+----3----+----4
305    
306    
307        SUBROUTINE MNC_CW_RX_R_YY(        SUBROUTINE MNC_CW_RX_R_YY(
      I     myThid,  
308       I     fbname, bi,bj,       I     fbname, bi,bj,
309       I     vtype,       I     vtype,
310       I     indu,       I     indu,
311       I     var )       I     var,
312         I     myThid )
313    
314        implicit none        implicit none
315    
# Line 357  C     Only do I/O if I am the master thr Line 357  C     Only do I/O if I am the master thr
357  C     Check that the Variable Type exists  C     Check that the Variable Type exists
358        nvf = IFNBLNK(vtype)        nvf = IFNBLNK(vtype)
359        nvl = ILNBLNK(vtype)        nvl = ILNBLNK(vtype)
360        CALL MNC_GET_IND(myThid, MNC_MAX_ID, vtype, mnc_cw_vname, ind_vt)        CALL MNC_GET_IND( MNC_MAX_ID, vtype, mnc_cw_vname, ind_vt, myThid)
361        IF (ind_vt .LT. 1) THEN        IF (ind_vt .LT. 1) THEN
362          write(msgbuf,'(3a)') 'MNC_CW_RX_R_YY ERROR: vtype ''',          write(msgbuf,'(3a)') 'MNC_CW_RX_R_YY ERROR: vtype ''',
363       &       vtype(nvf:nvl), ''' is not defined'       &       vtype(nvf:nvl), ''' is not defined'
# Line 388  C     Set the bi,bj indicies Line 388  C     Set the bi,bj indicies
388          DO lbi = bis,bie          DO lbi = bis,bie
389    
390  C         Create the file name  C         Create the file name
391            CALL MNC_CW_GET_TILE_NUM(myThid, lbi,lbj, uniq_tnum)            CALL MNC_CW_GET_TILE_NUM( lbi,lbj, uniq_tnum, myThid)
392            fname(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)            fname(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)
393            n1 = IFNBLNK(fbname)            n1 = IFNBLNK(fbname)
394            n2 = ILNBLNK(fbname)            n2 = ILNBLNK(fbname)
# Line 400  C         Create the file name Line 400  C         Create the file name
400            nfname = ntot+9            nfname = ntot+9
401    
402  C         Open the existing file  C         Open the existing file
403            CALL MNC_FILE_TRY_READ(myThid, fname, ierr, indf)            CALL MNC_FILE_TRY_READ( fname, ierr, indf, myThid)
404    
405  C         Check that the variable (VType) is defined within the file  C         Check that the variable (VType) is defined within the file
406            CALL MNC_GET_FVINDS(myThid, fname, vtype, indf, ind_fv_ids)            CALL MNC_GET_FVINDS( fname, vtype, indf, ind_fv_ids, myThid)
407            IF ((indf .LT. 1) .OR. (ind_fv_ids .LT. 1)) THEN            IF ((indf .LT. 1) .OR. (ind_fv_ids .LT. 1)) THEN
408              write(msgbuf,'(4a)') 'MNC_CW_RX_R_YY ERROR: vtype ''',              write(msgbuf,'(4a)') 'MNC_CW_RX_R_YY ERROR: vtype ''',
409       &           vtype(nvf:nvl), ''' is not defined within file ''',       &           vtype(nvf:nvl), ''' is not defined within file ''',
# Line 421  C         are compatible and WARN (only Line 421  C         are compatible and WARN (only
421            err = NF_INQ_ATT(fid,NF_GLOBAL, 'sNx',atype,alen)            err = NF_INQ_ATT(fid,NF_GLOBAL, 'sNx',atype,alen)
422            IF ((err .EQ. NF_NOERR) .AND. (alen .EQ. 1)) THEN            IF ((err .EQ. NF_NOERR) .AND. (alen .EQ. 1)) THEN
423              err = NF_GET_ATT_INT(fid, NF_GLOBAL, 'sNx', f_sNx)              err = NF_GET_ATT_INT(fid, NF_GLOBAL, 'sNx', f_sNx)
424              CALL MNC_HANDLE_ERR(myThid, err,              CALL MNC_HANDLE_ERR(err,
425       &           'reading attribute ''sNx'' in S/R MNC_CW_RX_R_YY')       &           'reading attribute ''sNx'' in S/R MNC_CW_RX_R_YY',
426         &           myThid)
427            ENDIF            ENDIF
428            err = NF_INQ_ATT(fid,NF_GLOBAL, 'sNy',atype,alen)            err = NF_INQ_ATT(fid,NF_GLOBAL, 'sNy',atype,alen)
429            IF ((err .EQ. NF_NOERR) .AND. (alen .EQ. 1)) THEN            IF ((err .EQ. NF_NOERR) .AND. (alen .EQ. 1)) THEN
430              err = NF_GET_ATT_INT(fid, NF_GLOBAL, 'sNy', f_sNy)              err = NF_GET_ATT_INT(fid, NF_GLOBAL, 'sNy', f_sNy)
431              CALL MNC_HANDLE_ERR(myThid, err,              CALL MNC_HANDLE_ERR(err,
432       &           'reading attribute ''sNy'' in S/R MNC_CW_RX_R_YY')       &           'reading attribute ''sNy'' in S/R MNC_CW_RX_R_YY',
433         &           myThid)
434            ENDIF            ENDIF
435            IF ((f_sNx .NE. sNx) .OR. (f_sNy .NE. sNy)) THEN            IF ((f_sNx .NE. sNx) .OR. (f_sNy .NE. sNy)) THEN
436              write(msgbuf,'(5a)') 'MNC_CW_RX_R_YY WARNING: the ',              write(msgbuf,'(5a)') 'MNC_CW_RX_R_YY WARNING: the ',
# Line 441  C         are compatible and WARN (only Line 443  C         are compatible and WARN (only
443  C         Check that the in-memory variable and the in-file variables  C         Check that the in-memory variable and the in-file variables
444  C         are of compatible sizes  C         are of compatible sizes
445  C           ires = 1  C           ires = 1
446  C           CALL MNC_CHK_VTYP_R_NCVAR(myThid, ind_vt,  C           CALL MNC_CHK_VTYP_R_NCVAR( ind_vt,
447  C      &         indf, ind_fv_ids, indu, ires)  C      &         indf, ind_fv_ids, indu, ires)
448  C           IF (ires .LT. 0) THEN  C           IF (ires .LT. 0) THEN
449  C             write(msgbuf,'(7a)') 'MNC_CW_RX_R_YY WARNING: the sizes ',  C             write(msgbuf,'(7a)') 'MNC_CW_RX_R_YY WARNING: the sizes ',
# Line 497  C               Use the indu value Line 499  C               Use the indu value
499                  udo(i) = indu - 1                  udo(i) = indu - 1
500                ELSEIF (indu .EQ. -1) THEN                ELSEIF (indu .EQ. -1) THEN
501  C               Append one to the current unlimited dim size  C               Append one to the current unlimited dim size
502                  CALL MNC_DIM_UNLIM_SIZE(myThid, fname, unlim_sz)                  CALL MNC_DIM_UNLIM_SIZE( fname, unlim_sz, myThid)
503                  udo(i) = unlim_sz                  udo(i) = unlim_sz
504                ELSE                ELSE
505  C               Use the current unlimited dim size  C               Use the current unlimited dim size
506                  CALL MNC_DIM_UNLIM_SIZE(myThid, fname, unlim_sz)                  CALL MNC_DIM_UNLIM_SIZE( fname, unlim_sz, myThid)
507                  udo(i) = unlim_sz - 1                  udo(i) = unlim_sz - 1
508                ENDIF                ENDIF
509              ENDIF              ENDIF
# Line 519  C     DO i = 9,1,-1 Line 521  C     DO i = 9,1,-1
521  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)
522  C     ENDDO  C     ENDDO
523                        
524            CALL MNC_FILE_ENDDEF(myThid,fname)            CALL MNC_FILE_ENDDEF(fname, myThid)
525    
526            write(msgbuf,'(5a)') 'reading variable type ''',            write(msgbuf,'(5a)') 'reading variable type ''',
527       &         vtype(nvf:nvl), ''' within file ''',       &         vtype(nvf:nvl), ''' within file ''',
# Line 564  C         Read the variable one vector a Line 566  C         Read the variable one vector a
566        err = NF_GET_VARA_INT(fid, idv, vstart, vcount, resh)        err = NF_GET_VARA_INT(fid, idv, vstart, vcount, resh)
567  #endif  #endif
568    
569        CALL MNC_HANDLE_ERR(myThid, err, msgbuf)        CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
570    
571        kr = 0        kr = 0
572        DO j1 = s(1),e(1)        DO j1 = s(1),e(1)
# Line 582  C         Read the variable one vector a Line 584  C         Read the variable one vector a
584            ENDDO            ENDDO
585    
586  C         Close the file  C         Close the file
587            CALL MNC_FILE_CLOSE(myThid, fname)            CALL MNC_FILE_CLOSE(fname, myThid)
588    
589  C         End the lbj,lbi loops  C         End the lbj,lbi loops
590          ENDDO          ENDDO
Legend:
Removed from v.1.8  
changed lines
  Added in v.1.9
  ViewVC Help
Powered by ViewVC 1.1.22