/[MITgcm]/MITgcm/pkg/mnc/mnc_cwrapper.F
ViewVC logotype

Diff of /MITgcm/pkg/mnc/mnc_cwrapper.F

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

revision 1.11 by edhill, Mon Mar 29 03:33:51 2004 UTC revision 1.23 by edhill, Fri Dec 17 04:50:05 2004 UTC
# Line 4  C $Name$ Line 4  C $Name$
4  #include "MNC_OPTIONS.h"  #include "MNC_OPTIONS.h"
5                
6  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7  CBOP  CBOP 0
8  C     !ROUTINE: MNC_CW_ADD_GNAME  C     !ROUTINE: MNC_CW_ADD_GNAME
9    
10  C     !INTERFACE:  C     !INTERFACE:
# Line 29  C     !INPUT PARAMETERS: Line 29  C     !INPUT PARAMETERS:
29        character*(*) name        character*(*) name
30        integer dlens(*), inds_beg(*), inds_end(*)        integer dlens(*), inds_beg(*), inds_end(*)
31        character*(*) dnames(*)        character*(*) dnames(*)
32    CEOP
33    
34  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
35        integer i, nnf,nnl, indg        integer i, nnf,nnl, indg
36        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
37  CEOP  
38  C     Functions  C     Functions
39        integer IFNBLNK, ILNBLNK        integer IFNBLNK, ILNBLNK
40    
# Line 69  C     Check that this name is not alread Line 70  C     Check that this name is not alread
70        END        END
71    
72  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
73  CBOP  CBOP 0
74    C     !ROUTINE: MNC_CW_DEL_GNAME
75    
76    C     !INTERFACE:
77          SUBROUTINE MNC_CW_DEL_GNAME(
78         I     name,
79         I     myThid )
80    
81    C     !DESCRIPTION:
82    C     Delete a grid name from the MNC convenience wrapper layer.
83          
84    C     !USES:
85          implicit none
86    #include "mnc_common.h"
87    #include "EEPARAMS.h"
88    
89    C     !INPUT PARAMETERS:
90          integer myThid
91          character*(*) name
92    CEOP
93    
94    C     !LOCAL VARIABLES:
95          integer nnf,nnl, indg
96    
97    C     Functions
98          integer IFNBLNK, ILNBLNK
99    
100          nnf = IFNBLNK(name)
101          nnl = ILNBLNK(name)
102    
103    C     Check that this name is not already defined
104          CALL MNC_GET_IND(MNC_MAX_ID, name, mnc_cw_gname, indg, myThid)
105          IF (indg .LT. 1) THEN
106            RETURN
107          ENDIF
108    
109          mnc_cw_gname(indg)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)
110          mnc_cw_ndim(indg) = 0
111    
112          RETURN
113          END
114    
115    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
116    CBOP 1
117  C     !ROUTINE: MNC_CW_DUMP  C     !ROUTINE: MNC_CW_DUMP
118    
119  C     !INTERFACE:  C     !INTERFACE:
# Line 88  C     !USES: Line 132  C     !USES:
132    
133  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
134        integer myThid        integer myThid
135    CEOP
136    
137  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
138        integer i,j, ntot        integer i,j, ntot
139        integer NBLNK        integer NBLNK
140        parameter ( NBLNK = 150 )        parameter ( NBLNK = 150 )
141        character s1*(NBLNK), blnk*(NBLNK)        character s1*(NBLNK), blnk*(NBLNK)
 CEOP  
142    
143        _BEGIN_MASTER(myThid)        _BEGIN_MASTER(myThid)
144                
# Line 114  CEOP Line 158  CEOP
158                        
159            ntot = ntot + 1            ntot = ntot + 1
160            s1(1:NBLNK) = blnk(1:NBLNK)            s1(1:NBLNK) = blnk(1:NBLNK)
161            write(s1,'(a5,2i5,a3,a20,i3,a3,5i4,a4,5i4,a4,5i4,6a4)')            write(s1,'(a5,2i5,a3,a20,i3,a3,5i4,a4,5i4,a4,5i4,6a8)')
162       &         'MNC: ',       &         'MNC: ',
163       &         j, ntot, ' : ', mnc_cw_gname(j)(1:20), mnc_cw_ndim(j),       &         j, ntot, ' : ', mnc_cw_gname(j)(1:20), mnc_cw_ndim(j),
164       &         ' : ', (mnc_cw_dims(i,j), i=1,5),       &         ' : ', (mnc_cw_dims(i,j), i=1,5),
165       &         '  | ', (mnc_cw_is(i,j), i=1,5),       &         '  | ', (mnc_cw_is(i,j), i=1,5),
166       &         '  | ', (mnc_cw_ie(i,j), i=1,5),       &         '  | ', (mnc_cw_ie(i,j), i=1,5),
167       &         '  | ', (mnc_cw_dn(i,j)(1:4), i=1,5)       &         '  | ', (mnc_cw_dn(i,j)(1:7), i=1,5)
168            CALL PRINT_MESSAGE(            CALL PRINT_MESSAGE(
169       &         s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)       &         s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
170                        
# Line 188  CEOP Line 232  CEOP
232        END        END
233    
234  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
235  CBOP  CBOP 0
236  C     !ROUTINE: MNC_CW_INIT  C     !ROUTINE: MNC_CW_APPEND_VNAME
237    
238  C     !INTERFACE:  C     !INTERFACE:
239        SUBROUTINE MNC_CW_INIT(        SUBROUTINE MNC_CW_APPEND_VNAME(
240       I     sNx,sNy, OLx,OLy, nSx,nSy, nPx,nPy, Nr,       I     vname,
241         I     gname,
242         I     bi_dim, bj_dim,
243       I     myThid )       I     myThid )
244    
245  C     !DESCRIPTION:  C     !DESCRIPTION:
246  C     Create the pre-defined grid types and variable types  C     If it is not yet defined within the MNC CW layer, append a
247          C     variable type.  Calls MNC\_CW\_ADD\_VNAME().
248      
249  C     !USES:  C     !USES:
250        implicit none        implicit none
251  #include "mnc_common.h"  #include "mnc_common.h"
 #include "EEPARAMS.h"  
252    
253  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
254        integer myThid        integer myThid, bi_dim, bj_dim
255        integer sNx,sNy, OLx,OLy, nSx,nSy, nPx,nPy, Nr        character*(*) vname, gname
   
 C     !LOCAL VARIABLES:  
       integer CW_MAX_LOC  
       parameter ( CW_MAX_LOC = 5 )  
       integer i, ihorz,ihsub,ivert,itime,ihalo, is,ih, n,ntot  
       integer ndim, ncomb  
       character*(MAX_LEN_MBUF) msgbuf  
       character*(MNC_MAX_CHAR) name  
       character*(MNC_MAX_CHAR) dn(CW_MAX_LOC)  
       character*(5) horz_dat(CW_MAX_LOC), hsub_dat(CW_MAX_LOC),  
      &     vert_dat(CW_MAX_LOC), time_dat(CW_MAX_LOC),  
      &     halo_dat(CW_MAX_LOC)  
       integer dim(CW_MAX_LOC), ib(CW_MAX_LOC), ie(CW_MAX_LOC)  
256  CEOP  CEOP
 C     Functions  
       integer IFNBLNK, ILNBLNK  
257    
258  C     ......12345....12345....12345....12345....12345...  C     !LOCAL VARIABLES:
259        data horz_dat /        integer indv
      &     '-    ', 'U    ', 'V    ', 'Cen  ', 'Cor  '  /  
       data hsub_dat /  
      &     'xy   ', 'x    ', 'y    ', '-    ', '     '  /  
       data halo_dat /  
      &     'Hn   ', 'Hy   ', '--   ', '     ', '     '  /  
       data vert_dat /  
      &     '-    ', 'C    ', 'I    ', '     ', '     '  /  
       data time_dat /  
      &     '-    ', 't    ', '     ', '     ', '     '  /  
   
       ncomb = 0  
       DO ihorz = 1,5  
         DO is = 1,3  
           DO ih = 1,2  
               
 C           Loop just ONCE if the Horiz component is "-"  
             ihsub = is  
             ihalo = ih  
             IF (ihorz .EQ. 1) THEN  
               IF ((is .EQ. 1) .AND. (ih .EQ. 1)) THEN  
                 ihsub = 4  
                 ihalo = 3  
               ELSE  
                 GOTO 10  
               ENDIF  
             ENDIF  
               
             DO ivert = 1,3  
               DO itime = 1,2  
                   
 C               horiz and hsub  
                 name(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)  
                 n = ILNBLNK(horz_dat(ihorz))  
                 name(1:n) = horz_dat(ihorz)(1:n)  
                 ntot = n + 1                
                 name(ntot:ntot) = '_'  
                 n = ILNBLNK(hsub_dat(ihsub))  
                 name((ntot+1):(ntot+n)) = hsub_dat(ihsub)(1:n)  
                 ntot = ntot + n  
   
 C               vert, time, and halo  
                 write(name((ntot+1):(ntot+9)), '(a1,2a2,a1,a2,a1)')  
      &               '_', halo_dat(ihalo)(1:2), '__',  
      &               vert_dat(ivert)(1:1), '__',  
      &               time_dat(itime)(1:1)  
   
                 ndim = 0  
                 DO i = 1,CW_MAX_LOC  
                   dn(i)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)  
                   dim(i) = 0  
                   ib(i) = 0  
                   ie(i) = 0  
                 ENDDO  
   
 C               Horizontal dimensions  
                 IF (halo_dat(ihalo)(1:5) .EQ. 'Hn   ') THEN  
   
                   IF (hsub_dat(ihsub)(1:1) .EQ. 'x') THEN  
                     ndim = ndim + 1  
                     IF ( (horz_dat(ihorz)(1:3) .EQ. 'Cen')  
      &                   .OR. (horz_dat(ihorz)(1:1) .EQ. 'V') ) THEN  
                       dn(ndim)(1:1) = 'X'  
                       dim(ndim) = sNx + 2*OLx  
                       ib(ndim)  = OLx + 1  
                       ie(ndim)  = OLx + sNx  
                     ENDIF  
                     IF ( (horz_dat(ihorz)(1:3) .EQ. 'Cor')  
      &                   .OR. (horz_dat(ihorz)(1:1) .EQ. 'U') ) THEN  
                       dn(ndim)(1:3) = 'Xp1'  
                       dim(ndim) = sNx + 2*OLx  
                       ib(ndim)  = OLx + 1  
                       ie(ndim)  = OLx + sNx + 1  
                     ENDIF  
                   ENDIF  
                   IF ((hsub_dat(ihsub)(1:1) .EQ. 'y')  
      &                 .OR. (hsub_dat(ihsub)(2:2) .EQ. 'y')) THEN  
                     ndim = ndim + 1  
                     IF ( (horz_dat(ihorz)(1:3) .EQ. 'Cen')  
      &                   .OR. (horz_dat(ihorz)(1:1) .EQ. 'U') ) THEN  
                       dn(ndim)(1:1) = 'Y'  
                       dim(ndim) = sNy + 2*OLy  
                       ib(ndim)  = OLy + 1  
                       ie(ndim)  = OLy + sNy  
                     ENDIF  
                     IF ( (horz_dat(ihorz)(1:3) .EQ. 'Cor')  
      &                   .OR. (horz_dat(ihorz)(1:1) .EQ. 'V') ) THEN  
                       dn(ndim)(1:3) = 'Yp1'  
                       dim(ndim) = sNy + 2*OLy  
                       ib(ndim)  = OLy + 1  
                       ie(ndim)  = OLy + sNy + 1  
                     ENDIF  
                   ENDIF  
   
                 ELSEIF (halo_dat(ihalo)(1:5) .EQ. 'Hy   ') THEN  
   
                   IF (hsub_dat(ihsub)(1:1) .EQ. 'x') THEN  
                     ndim = ndim + 1  
                     dn(ndim)(1:3) = 'Xwh'  
                     dim(ndim) = sNx + 2*OLx  
                     ib(ndim)  = 1  
                     ie(ndim)  = sNx + 2*OLx  
                   ENDIF  
                   IF ((hsub_dat(ihsub)(1:1) .EQ. 'y')  
      &                 .OR. (hsub_dat(ihsub)(2:2) .EQ. 'y')) THEN  
                     ndim = ndim + 1  
                     dn(ndim)(1:3) = 'Ywh'  
                     dim(ndim) = sNy + 2*OLy  
                     ib(ndim)  = 1  
                     ie(ndim)  = sNy + 2*OLy  
                   ENDIF  
   
                 ENDIF  
   
 C               Vertical dimension  
                 IF (vert_dat(ivert)(1:1) .EQ. 'C') THEN  
                   ndim = ndim + 1  
                   dn(ndim)(1:1) = 'Z'  
                   dim(ndim) = Nr  
                   ib(ndim)  = 1  
                   ie(ndim)  = Nr  
                 ENDIF  
                 IF (vert_dat(ivert)(1:1) .EQ. 'I') THEN  
                   ndim = ndim + 1  
                   dn(ndim)(1:3) = 'Zp1'  
                   dim(ndim) = Nr + 1  
                   ib(ndim)  = 1  
                   ie(ndim)  = Nr + 1  
                 ENDIF  
   
 C               Time dimension  
                 IF (time_dat(itime)(1:1) .EQ. 't') THEN  
                   ndim = ndim + 1  
                   dn(ndim)(1:1) = 'T'  
                   dim(ndim) = -1  
                   ib(ndim)  = 1  
                   ie(ndim)  = 1  
                 ENDIF  
   
                 IF (ndim .GT. 0) THEN  
 #ifdef MNC_DEBUG  
                   ncomb = ncomb + 1  
                   write(*,'(i4,a3,a15,i3,a3,5i4,a4,5i4,a4,5i4,6a4)')  
      &                 ncomb, ' : ', name(1:15), ndim,  
      &                 ' : ', (dim(i), i=1,5),  
      &                 '  | ', (ib(i), i=1,5),  
      &                 '  | ', (ie(i), i=1,5),  
      &                 '  | ', (dn(i)(1:4), i=1,5)  
 #endif  
260    
261                    CALL MNC_CW_ADD_GNAME(name, ndim,  C     Check whether vname is defined
262       &                 dim, dn, ib, ie, myThid)        CALL MNC_GET_IND(MNC_MAX_ID, vname, mnc_cw_vname, indv, myThid)
263                  ENDIF        IF (indv .LT. 1) THEN
264            CALL MNC_CW_ADD_VNAME(vname, gname, bi_dim, bj_dim, myThid)
265          ENDIF
266    
               ENDDO  
             ENDDO  
267    
  10         CONTINUE  
           ENDDO  
         ENDDO  
       ENDDO  
         
268        RETURN        RETURN
269        END        END
270    
271  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
272  CBOP  CBOP 0
273  C     !ROUTINE: MNC_CW_ADD_VNAME  C     !ROUTINE: MNC_CW_ADD_VNAME
274    
275  C     !INTERFACE:  C     !INTERFACE:
# Line 401  C     !INTERFACE: Line 279  C     !INTERFACE:
279       I     bi_dim, bj_dim,       I     bi_dim, bj_dim,
280       I     myThid )       I     myThid )
281    
282  C     !DESCRIPTION:  C     !DESCRIPTION:
283  C     Add a variable type.  C     Add a variable type to the MNC CW layer.  The variable type is an
284          C     association between a variable type name and the following items:
285    C     \begin{center}
286    C       \begin{tabular}[h]{|ll|}\hline
287    C         \textbf{Item}  & \textbf{Purpose}  \\\hline
288    C         grid type  &  defines the in-memory arrangement  \\
289    C         \texttt{bi,bj} dimensions  &  tiling indices, if present  \\\hline
290    C       \end{tabular}
291    C     \end{center}
292      
293  C     !USES:  C     !USES:
294        implicit none        implicit none
295  #include "mnc_common.h"  #include "mnc_common.h"
# Line 412  C     !USES: Line 298  C     !USES:
298  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
299        integer myThid, bi_dim, bj_dim        integer myThid, bi_dim, bj_dim
300        character*(*) vname, gname        character*(*) vname, gname
301    CEOP
302    
303  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
304        integer i, nvf,nvl, ngf,ngl, indv,indg        integer i, nvf,nvl, ngf,ngl, indv,indg
305        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
306  CEOP  
307  C     Functions  C     Functions
308        integer IFNBLNK, ILNBLNK        integer IFNBLNK, ILNBLNK
309    
# Line 454  C     Check that gname exists Line 341  C     Check that gname exists
341        mnc_cw_vbij(1,indv) = bi_dim        mnc_cw_vbij(1,indv) = bi_dim
342        mnc_cw_vbij(2,indv) = bj_dim        mnc_cw_vbij(2,indv) = bj_dim
343    
344    #ifdef MNC_DEBUG_GTYPE
345        CALL MNC_CW_ADD_VATTR_TEXT(vname,1,'mitgcm_grid',gname, myThid)        CALL MNC_CW_ADD_VATTR_TEXT(vname,1,'mitgcm_grid',gname, myThid)
346    #endif
347    
348          RETURN
349          END
350    
351    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
352    CBOP 0
353    C     !ROUTINE: MNC_CW_DEL_VNAME
354    
355    C     !INTERFACE:
356          SUBROUTINE MNC_CW_DEL_VNAME(
357         I     vname,
358         I     myThid )
359    
360    C     !DESCRIPTION:
361    C     Delete a variable type from the MNC CW layer.
362      
363    C     !USES:
364          implicit none
365    #include "mnc_common.h"
366    #include "EEPARAMS.h"
367    
368    C     !INPUT PARAMETERS:
369          integer myThid
370          character*(*) vname
371    CEOP
372    
373    C     !LOCAL VARIABLES:
374          integer i, indv
375    
376    C     Check that this vname is not already defined
377          CALL MNC_GET_IND(MNC_MAX_ID, vname, mnc_cw_vname, indv, myThid)
378          IF (indv .LT. 1) THEN
379            RETURN
380          ENDIF
381    
382          mnc_cw_vname(indv)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)
383          mnc_cw_vgind(indv) = 0
384          DO i = 1,3
385            mnc_cw_vnat(i,indv) = 0
386          ENDDO
387    
388        RETURN        RETURN
389        END        END
# Line 462  C     Check that gname exists Line 391  C     Check that gname exists
391  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
392  CBOP  CBOP
393  C     !ROUTINE: MNC_CW_ADD_VATTR_TEXT  C     !ROUTINE: MNC_CW_ADD_VATTR_TEXT
   
394  C     !INTERFACE:  C     !INTERFACE:
395        SUBROUTINE MNC_CW_ADD_VATTR_TEXT(        SUBROUTINE MNC_CW_ADD_VATTR_TEXT(
396       I     vname,       I     vname, tname, tval,
      I     ntat,  
      I     tnames,  
      I     tvals,  
397       I     myThid )       I     myThid )
398    
399  C     !DESCRIPTION:  C     !DESCRIPTION:
# Line 478  C     !USES: Line 403  C     !USES:
403        implicit none        implicit none
404    
405  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
406        integer myThid, ntat        integer myThid
407        character*(*) vname, tnames(*), tvals(*)        character*(*) vname, tname, tval
408          integer ival
409          REAL*8 dval
410  CEOP  CEOP
411          ival = 0
412        CALL MNC_CW_ADD_VATTR_ANY(vname,        dval = 0.0D0
413       &     ntat, 0, 0,        CALL MNC_CW_ADD_VATTR_ANY(vname, 1,
414       &     tnames, ' ', ' ',       &     tname, ' ', ' ', tval, ival, dval, myThid )
      &     tvals, 0, 0.0D0, myThid )  
   
415        RETURN        RETURN
416        END        END
   
417  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
418  CBOP  CBOP
419  C     !ROUTINE: MNC_CW_ADD_VATTR_INT  C     !ROUTINE: MNC_CW_ADD_VATTR_INT
   
420  C     !INTERFACE:  C     !INTERFACE:
421        SUBROUTINE MNC_CW_ADD_VATTR_INT(        SUBROUTINE MNC_CW_ADD_VATTR_INT(
422       I     vname,       I     vname, iname, ival,
      I     niat,  
      I     inames,  
      I     ivals,  
423       I     myThid )       I     myThid )
424    
425  C     !DESCRIPTION:  C     !DESCRIPTION:
426    C     Add integer attribute
427    
428  C     !USES:  C     !USES:
429        implicit none        implicit none
430    
431  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
432        integer myThid, niat        integer myThid
433        character*(*) vname, inames(*)        character*(*) vname, iname
434        integer ivals(*)        integer ival
435          REAL*8 dval
436  CEOP  CEOP
437          dval = 0.0D0
438        CALL MNC_CW_ADD_VATTR_ANY(vname,        CALL MNC_CW_ADD_VATTR_ANY(vname, 2,
439       &     0, niat, 0,       &     ' ', iname, ' ', ' ', ival, dval, myThid )
      &     ' ', inames, ' ',  
      &     ' ', ivals, 0.0D0, myThid )  
   
440        RETURN        RETURN
441        END        END
   
442  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
443  CBOP  CBOP
444  C !ROUTINE: MNC_CW_ADD_VATTR_DBL  C !ROUTINE: MNC_CW_ADD_VATTR_DBL
   
445  C !INTERFACE:  C !INTERFACE:
446        SUBROUTINE MNC_CW_ADD_VATTR_DBL(        SUBROUTINE MNC_CW_ADD_VATTR_DBL(
447       I     vname,       I     vname, dname, dval,
      I     ndat,  
      I     dnames,  
      I     dvals,  
448       I     myThid )       I     myThid )
449    
450  C     !DESCRIPTION:  C     !DESCRIPTION:
451    C     Add double-precision real attribute
452    
453  C     !USES:  C     !USES:
454        implicit none        implicit none
455    
456  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
457        integer myThid, ndat        integer myThid
458        character*(*) vname, dnames(*)        character*(*) vname, dname
459        REAL*8 dvals(*)        integer ival
460          REAL*8 dval
461  CEOP  CEOP
462          ival = 0
463        CALL MNC_CW_ADD_VATTR_ANY(vname,        CALL MNC_CW_ADD_VATTR_ANY(vname, 3,
464       &     0, 0, ndat,       &     ' ', ' ', dname, ' ', ival, dval, myThid )
      &     ' ', ' ', dnames,  
      &     ' ', 0, dvals, myThid )  
   
465        RETURN        RETURN
466        END        END
   
467  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
468  CBOP  CBOP 1
469  C     !ROUTINE: MNC_CW_ADD_VATTR_ANY  C     !ROUTINE: MNC_CW_ADD_VATTR_ANY
470    
471  C     !INTERFACE:  C     !INTERFACE:
472        SUBROUTINE MNC_CW_ADD_VATTR_ANY(        SUBROUTINE MNC_CW_ADD_VATTR_ANY(
473       I     vname,       I     vname,
474       I     ntat,   niat,   ndat,       I     atype,
475       I     tnames, inames, dnames,       I     tname, iname, dname,
476       I     tvals,  ivals,  dvals,       I     tval,  ival,  dval,
477       I     myThid )       I     myThid )
478    
479  C     !DESCRIPTION:  C     !DESCRIPTION:
# Line 572  C     !USES: Line 484  C     !USES:
484  #include "EEPARAMS.h"  #include "EEPARAMS.h"
485    
486  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
487        integer myThid, ntat, niat, ndat        integer myThid
488          integer atype
489        character*(*) vname        character*(*) vname
490        character*(*) tnames(*), inames(*), dnames(*)        character*(*) tname, iname, dname
491        character*(*) tvals(*)        character*(*) tval
492        integer ivals(*)        integer ival
493        REAL*8 dvals(*)        REAL*8 dval
494    CEOP
495    
496  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
497        integer i, n, nvf,nvl, n1,n2, indv        integer n, nvf,nvl, n1,n2, indv
498        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
499  CEOP  
500  C     Functions  C     Functions
501        integer IFNBLNK, ILNBLNK        integer IFNBLNK, ILNBLNK
502    
# Line 598  C     Check that vname is defined Line 512  C     Check that vname is defined
512          stop 'ABNORMAL END: S/R MNC_CW_ADD_VATTR_ANY'          stop 'ABNORMAL END: S/R MNC_CW_ADD_VATTR_ANY'
513        ENDIF        ENDIF
514    
515  C     Text Attributes        IF (atype .EQ. 1) THEN
516        n = mnc_cw_vnat(1,indv)  C       Text Attribute
517        DO i = 1,ntat          n = mnc_cw_vnat(1,indv) + 1
518          n1 = IFNBLNK(tnames(i))          n1 = IFNBLNK(tname)
519          n2 = ILNBLNK(tnames(i))          n2 = ILNBLNK(tname)
520          mnc_cw_vtnm(n+i,indv)(1:(n2-n1+1)) = tnames(i)(n1:n2)  C       write(*,*) atype,tname(n1:n2)
521          n1 = IFNBLNK(tvals(i))          mnc_cw_vtnm(n,indv)(1:MNC_MAX_CHAR) =
522          n2 = ILNBLNK(tvals(i))       &       mnc_blank_name(1:MNC_MAX_CHAR)
523          mnc_cw_vtat(n+i,indv)(1:(n2-n1+1)) = tvals(i)(n1:n2)          mnc_cw_vtnm(n,indv)(1:(n2-n1+1)) = tname(n1:n2)
524        ENDDO          n1 = IFNBLNK(tval)
525        mnc_cw_vnat(1,indv) = n + ntat          n2 = ILNBLNK(tval)
526            IF ((n1 .EQ. 0) .OR. (n2 .EQ. 0)) THEN
527  C     Integer Attributes            mnc_cw_vtat(n,indv)(1:MNC_MAX_CHAR) =
528        n = mnc_cw_vnat(2,indv)       &         mnc_blank_name(1:MNC_MAX_CHAR)          
529        DO i = 1,niat            mnc_cw_vnat(1,indv) = n
530          n1 = IFNBLNK(inames(i))          ELSE
531          n2 = ILNBLNK(inames(i))            mnc_cw_vtat(n,indv)(1:MNC_MAX_CHAR) =
532          mnc_cw_vinm(n+i,indv)(1:(n2-n1+1)) = inames(i)(n1:n2)       &         mnc_blank_name(1:MNC_MAX_CHAR)
533          mnc_cw_viat(n+i,indv) = ivals(i)            mnc_cw_vtat(n,indv)(1:(n2-n1+1)) = tval(n1:n2)
534        ENDDO            mnc_cw_vnat(1,indv) = n
535        mnc_cw_vnat(2,indv) = n + niat          ENDIF
536          ENDIF
537  C     Double Attributes          
538        n = mnc_cw_vnat(3,indv)        IF (atype .EQ. 2) THEN
539        DO i = 1,ndat  C       Integer Attribute
540          n1 = IFNBLNK(dnames(i))          n = mnc_cw_vnat(2,indv) + 1
541          n2 = ILNBLNK(dnames(i))          n1 = IFNBLNK(iname)
542          mnc_cw_vdnm(n+i,indv)(1:(n2-n1+1)) = dnames(i)(n1:n2)          n2 = ILNBLNK(iname)
543          mnc_cw_vdat(n+i,indv) = dvals(i)  C       write(*,*) atype,iname(n1:n2)
544        ENDDO          mnc_cw_vinm(n,indv)(1:(n2-n1+1)) = iname(n1:n2)
545        mnc_cw_vnat(3,indv) = n + ndat          mnc_cw_viat(n,indv) = ival
546            mnc_cw_vnat(2,indv) = n
547          ENDIF
548    
549          IF (atype .EQ. 3) THEN
550    C       Double Attribute
551            n = mnc_cw_vnat(3,indv) + 1
552            n1 = IFNBLNK(dname)
553            n2 = ILNBLNK(dname)
554    C       write(*,*) atype,dname(n1:n2)
555            mnc_cw_vdnm(n,indv)(1:(n2-n1+1)) = dname(n1:n2)
556            mnc_cw_vdat(n,indv) = dval
557            mnc_cw_vnat(3,indv) = n
558          ENDIF
559          
560        RETURN        RETURN
561        END        END
562    
563  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
564  CBOP  CBOP 1
565  C     !ROUTINE: MNC_CW_GET_TILE_NUM  C     !ROUTINE: MNC_CW_GET_TILE_NUM
566    
567  C     !INTERFACE:  C     !INTERFACE:
# Line 656  C     !USES: Line 583  C     !USES:
583    
584  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
585        integer myThid, bi,bj, uniq_tnum        integer myThid, bi,bj, uniq_tnum
586    CEOP
587    
588  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
589        integer iG,jG        integer iG,jG
 CEOP  
590    
591        iG = 0        iG = 0
592        jG = 0        jG = 0
# Line 684  CEH3      write(*,*) 'iG,jG,uniq_tnum :' Line 611  CEH3      write(*,*) 'iG,jG,uniq_tnum :'
611        END        END
612    
613  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
614  CBOP  CBOP 1
615  C     !ROUTINE: MNC_CW_FILE_AORC  C     !ROUTINE: MNC_CW_FILE_AORC
616                
617  C     !INTERFACE:  C     !INTERFACE:
618        SUBROUTINE MNC_CW_FILE_AORC(        SUBROUTINE MNC_CW_FILE_AORC(
619       I     fname,       I     fname,
620       O     indf,       O     indf,
621         I     lbi, lbj, uniq_tnum,
622       I     myThid )       I     myThid )
623    
624  C     !DESCRIPTION:  C     !DESCRIPTION:
625    C     Open a NetCDF file, appending to the file if it already exists
626    C     and, if not, creating a new file.
627    
628  C     !USES:  C     !USES:
629        implicit none        implicit none
# Line 702  C     !USES: Line 632  C     !USES:
632  #include "EEPARAMS.h"  #include "EEPARAMS.h"
633    
634  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
635        integer myThid, indf        integer myThid, indf, lbi, lbj, uniq_tnum
636        character*(*) fname        character*(*) fname
637    CEOP
638    
639  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
640        integer i, ierr        integer ierr
       character*(MAX_LEN_MBUF) msgbuf  
 CEOP  
641    
642  C     Check if the file is already open  C     Check if the file is already open
643        CALL MNC_GET_IND(MNC_MAX_ID, fname, mnc_f_names, indf, myThid)        CALL MNC_GET_IND(MNC_MAX_ID, fname, mnc_f_names, indf, myThid)
# Line 718  C     Check if the file is already open Line 647  C     Check if the file is already open
647    
648  C     Try to open an existing file  C     Try to open an existing file
649        CALL MNC_FILE_TRY_READ(fname, ierr, indf, myThid)        CALL MNC_FILE_TRY_READ(fname, ierr, indf, myThid)
650        IF (ierr .EQ. NF_NOERR) THEN        IF (ierr .NE. NF_NOERR) THEN
651          RETURN  C       Try to create a new one
652            CALL MNC_FILE_OPEN(fname, 0, indf, myThid)
653        ENDIF        ENDIF
654    
655  C     Try to create a new one  C     Add the global attributes
656        CALL MNC_FILE_OPEN(fname, 0, indf, myThid)        CALL MNC_CW_SET_GATTR(fname, lbi,lbj, uniq_tnum, myThid)
657    
658        RETURN        RETURN
659        END        END
Legend:
Removed from v.1.11  
changed lines
  Added in v.1.23
  ViewVC Help
Powered by ViewVC 1.1.22