/[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.6 by edhill, Thu Feb 5 05:42:07 2004 UTC revision 1.35 by jmc, Thu Jan 21 01:48:05 2010 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2  C $Name$  C $Name$
3          
4  #include "MNC_OPTIONS.h"  #include "MNC_OPTIONS.h"
         
 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  
5    
6        SUBROUTINE MNC_CW_ADD_GNAME(  C--  File mnc_cwrapper.F:
7       I     myThid,  C--   Contents
8       I     name,  C--   o MNC_CW_ADD_GNAME
9       I     ndim,  C--   o MNC_CW_DEL_GNAME
10       I     dlens,  C--   o MNC_CW_DUMP
11       I     dnames,  C--   o MNC_CW_APPEND_VNAME
12       I     inds_beg, inds_end )  C--   o MNC_CW_ADD_VNAME
13    C--   o MNC_CW_DEL_VNAME
14    C--   o MNC_CW_ADD_VATTR_TEXT
15    C--   o MNC_CW_ADD_VATTR_INT
16    C--   o MNC_CW_ADD_VATTR_DBL
17    C--   o MNC_CW_ADD_VATTR_ANY
18    C--   o MNC_CW_GET_TILE_NUM
19    C--   o MNC_CW_GET_FACE_NUM
20    C--   o MNC_CW_GET_XYFO
21    C--   o MNC_CW_FILE_AORC
22    
23    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
24    CBOP 0
25    C     !ROUTINE: MNC_CW_ADD_GNAME
26    
27    C     !INTERFACE:
28          SUBROUTINE MNC_CW_ADD_GNAME(
29         I     name,
30         I     ndim,
31         I     dlens,
32         I     dnames,
33         I     inds_beg, inds_end,
34         I     myThid )
35    
36    C     !DESCRIPTION:
37    C     Add a grid name to the MNC convenience wrapper layer.
38    
39    C     !USES:
40        implicit none        implicit none
41  #include "mnc_common.h"  #include "MNC_COMMON.h"
42  #include "EEPARAMS.h"  #include "EEPARAMS.h"
43    
44  C     Arguments  C     !INPUT PARAMETERS:
45        integer myThid, ndim        integer myThid, ndim
46        character*(*) name        character*(*) name
47        integer dlens(*), inds_beg(*), inds_end(*)        integer dlens(*), inds_beg(*), inds_end(*)
48        character*(*) dnames(*)        character*(*) dnames(*)
49    CEOP
50    
51  C     Functions  C     !LOCAL VARIABLES:
       integer IFNBLNK, ILNBLNK  
   
 C     Local Variables  
52        integer i, nnf,nnl, indg        integer i, nnf,nnl, indg
53        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
54    
55    C     Functions
56          integer IFNBLNK, ILNBLNK
57    
58        nnf = IFNBLNK(name)        nnf = IFNBLNK(name)
59        nnl = ILNBLNK(name)        nnl = ILNBLNK(name)
60    
61  C     Check that this name is not already defined  C     Check that this name is not already defined
62        CALL MNC_GET_IND(myThid, MNC_MAX_ID, name, mnc_cw_gname, indg)        CALL MNC_GET_IND(MNC_MAX_ID, name, mnc_cw_gname, indg, myThid)
63        IF (indg .GT. 0) THEN        IF (indg .GT. 0) THEN
64          write(msgbuf,'(3a)') 'MNC_CW_ADD_GNAME ERROR: ''', name,          write(msgbuf,'(3a)') 'MNC_CW_ADD_GNAME ERROR: ''', name,
65       &       ''' is already defined'       &       ''' is already defined'
66          CALL print_error(msgbuf, mythid)          CALL print_error(msgbuf, mythid)
67          stop 'ABNORMAL END: S/R MNC_CW_ADD_GNAME'          stop 'ABNORMAL END: S/R MNC_CW_ADD_GNAME'
68        ENDIF        ENDIF
69        CALL MNC_GET_NEXT_EMPTY_IND(myThid, MNC_MAX_ID, mnc_cw_gname,        CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID, mnc_cw_gname,
70       &     indg)       &     'mnc_cw_gname', indg, myThid)
71    
72        mnc_cw_gname(indg)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)        mnc_cw_gname(indg)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)
73        mnc_cw_gname(indg)(1:(nnl-nnf+1)) = name(nnf:nnl)        mnc_cw_gname(indg)(1:(nnl-nnf+1)) = name(nnf:nnl)
# Line 62  C     Check that this name is not alread Line 87  C     Check that this name is not alread
87        END        END
88    
89  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
90    CBOP 0
91    C     !ROUTINE: MNC_CW_DEL_GNAME
92    
93    C     !INTERFACE:
94          SUBROUTINE MNC_CW_DEL_GNAME(
95         I     name,
96         I     myThid )
97    
98    C     !DESCRIPTION:
99    C     Delete a grid name from the MNC convenience wrapper layer.
100    
101    C     !USES:
102          implicit none
103    #include "MNC_COMMON.h"
104    #include "EEPARAMS.h"
105    
106    C     !INPUT PARAMETERS:
107          integer myThid
108          character*(*) name
109    CEOP
110    
111    C     !LOCAL VARIABLES:
112          integer nnf,nnl, indg
113    
114    C     Functions
115          integer IFNBLNK, ILNBLNK
116    
117          nnf = IFNBLNK(name)
118          nnl = ILNBLNK(name)
119    
120    C     Check that this name is not already defined
121          CALL MNC_GET_IND(MNC_MAX_ID, name, mnc_cw_gname, indg, myThid)
122          IF (indg .LT. 1) THEN
123            RETURN
124          ENDIF
125    
126          mnc_cw_gname(indg)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)
127          mnc_cw_ndim(indg) = 0
128    
129          RETURN
130          END
131    
132    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
133    CBOP 1
134    C     !ROUTINE: MNC_CW_DUMP
135    
136    C     !INTERFACE:
137          SUBROUTINE MNC_CW_DUMP( myThid )
138    
139        SUBROUTINE MNC_CW_DUMP()  C     !DESCRIPTION:
140    C     Write a condensed view of the current state of the MNC look-up
141    C     tables for the convenience wrapper section.
142    
143    C     !USES:
144        implicit none        implicit none
145  #include "mnc_common.h"  #include "MNC_COMMON.h"
146    #include "SIZE.h"
147    #include "EEPARAMS.h"
148    #include "PARAMS.h"
149    
150  C     Local Variables  C     !INPUT PARAMETERS:
151          integer myThid
152    CEOP
153    
154    C     !LOCAL VARIABLES:
155        integer i,j, ntot        integer i,j, ntot
156          integer NBLNK
157          parameter ( NBLNK = 150 )
158          character s1*(NBLNK), blnk*(NBLNK)
159    
160          _BEGIN_MASTER(myThid)
161    
162        write(*,'(a)') 'The currently defined Grid Types are:'        DO i = 1,NBLNK
163            blnk(i:i) = ' '
164          ENDDO
165    
166          s1(1:NBLNK) = blnk(1:NBLNK)
167          write(s1,'(a5,a)') 'MNC: ',
168         &     'The currently defined Grid Types are:'
169          CALL PRINT_MESSAGE(
170         &     s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
171        ntot = 0        ntot = 0
172        DO j = 1,MNC_MAX_ID        DO j = 1,MNC_MAX_ID
173          IF (mnc_cw_gname(j)(1:MNC_MAX_CHAR)          IF (mnc_cw_gname(j)(1:MNC_MAX_CHAR)
174       &       .NE. mnc_blank_name(1:MNC_MAX_CHAR)) THEN       &       .NE. mnc_blank_name(1:MNC_MAX_CHAR)) THEN
175              
176            ntot = ntot + 1            ntot = ntot + 1
177            write(*,'(2i5,a3,a20,i3,a3,5i4,a4,5i4,a4,5i4,6a4)')            s1(1:NBLNK) = blnk(1:NBLNK)
178       &         j, ntot, ' : ', mnc_cw_gname(j)(1:20), mnc_cw_ndim(j),            write(s1,'(a5,2i5,a3,a20,i3,a3,5i4,a4,5i4,a4,5i4,6a8)')
179       &         ' : ', (mnc_cw_dims(i,j), i=1,5),       &         'MNC: ',
180         &         j, ntot, ' : ', mnc_cw_gname(j)(1:20), mnc_cw_ndim(j),
181         &         ' : ', (mnc_cw_dims(i,j), i=1,5),
182       &         '  | ', (mnc_cw_is(i,j), i=1,5),       &         '  | ', (mnc_cw_is(i,j), i=1,5),
183       &         '  | ', (mnc_cw_ie(i,j), i=1,5),       &         '  | ', (mnc_cw_ie(i,j), i=1,5),
184       &         '  | ', (mnc_cw_dn(i,j)(1:4), i=1,5)       &         '  | ', (mnc_cw_dn(i,j)(1:7), i=1,5)
185              CALL PRINT_MESSAGE(
186         &         s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
187    
188          ENDIF          ENDIF
189        ENDDO        ENDDO
190    
191        write(*,'(a)') 'The currently defined Variable Types are:'        s1(1:NBLNK) = blnk(1:NBLNK)
192          write(s1,'(a5,a)') 'MNC: ',
193         &     'The currently defined Variable Types are:'
194          CALL PRINT_MESSAGE(
195         &     s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
196        ntot = 0        ntot = 0
197        DO j = 1,MNC_MAX_ID        DO j = 1,MNC_MAX_ID
198          IF (mnc_cw_vname(j)(1:MNC_MAX_CHAR)          IF (mnc_cw_vname(j)(1:MNC_MAX_CHAR)
199       &       .NE. mnc_blank_name(1:MNC_MAX_CHAR)) THEN       &       .NE. mnc_blank_name(1:MNC_MAX_CHAR)) THEN
200    
201            ntot = ntot + 1            ntot = ntot + 1
202            write(*,'(2i5,a3,a25,a3,i4)') j, ntot, ' : ',            s1(1:NBLNK) = blnk(1:NBLNK)
203       &         mnc_cw_vname(j)(1:20), ' : ', mnc_cw_vgind(j)            write(s1,'(a5,2i5,a3,a25,a3,i4)') 'MNC: ',
204         &         j, ntot, ' | ',
205         &         mnc_cw_vname(j)(1:20), ' | ', mnc_cw_vgind(j)
206              CALL PRINT_MESSAGE(
207         &         s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
208    
209            DO i = 1,mnc_cw_vnat(1,j)            DO i = 1,mnc_cw_vnat(1,j)
210              write(*,'(a14,i4,a3,a25,a3,a25)') '      text_at:',i,              s1(1:NBLNK) = blnk(1:NBLNK)
211                write(s1,'(a5,a14,i4,a3,a25,a3,a55)')
212         &           'MNC: ','      text_at:',i,
213       &           ' : ', mnc_cw_vtnm(i,j)(1:25), ' : ',       &           ' : ', mnc_cw_vtnm(i,j)(1:25), ' : ',
214       &           mnc_cw_vtat(i,j)(1:25)       &           mnc_cw_vtat(i,j)(1:MNC_MAX_CHAR)
215                CALL PRINT_MESSAGE(
216         &           s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
217            ENDDO            ENDDO
218            DO i = 1,mnc_cw_vnat(2,j)            DO i = 1,mnc_cw_vnat(2,j)
219              write(*,'(a14,i4,a3,a25,a3,i20)') '      int__at:',i,              s1(1:NBLNK) = blnk(1:NBLNK)
220                write(s1,'(a5,a14,i4,a3,a25,a3,i20)')
221         &           'MNC: ','      int__at:',i,
222       &           ' : ', mnc_cw_vinm(i,j)(1:25), ' : ',       &           ' : ', mnc_cw_vinm(i,j)(1:25), ' : ',
223       &           mnc_cw_viat(i,j)       &           mnc_cw_viat(i,j)
224                CALL PRINT_MESSAGE(
225         &           s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
226            ENDDO            ENDDO
227            DO i = 1,mnc_cw_vnat(3,j)            DO i = 1,mnc_cw_vnat(3,j)
228              write(*,'(a14,i4,a3,a25,a3,f25.10)') '      dbl__at:',i,              s1(1:NBLNK) = blnk(1:NBLNK)
229                write(s1,'(a5,a14,i4,a3,a25,a3,f25.10)')
230         &           'MNC: ','      dbl__at:',i,
231       &           ' : ', mnc_cw_vdnm(i,j)(1:25), ' : ',       &           ' : ', mnc_cw_vdnm(i,j)(1:25), ' : ',
232       &           mnc_cw_vdat(i,j)       &           mnc_cw_vdat(i,j)
233            ENDDO              CALL PRINT_MESSAGE(
234         &           s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
235            ENDDO
236    
237          ENDIF          ENDIF
238        ENDDO        ENDDO
239        IF (ntot .EQ. 0) THEN        IF (ntot .EQ. 0) THEN
240          write(*,'(a)') '   None defined!'          s1(1:NBLNK) = blnk(1:NBLNK)
241            write(s1,'(a)') 'MNC:    None defined!'
242            CALL PRINT_MESSAGE(
243         &       s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
244        ENDIF        ENDIF
245    
246          _END_MASTER(myThid)
247    
248        RETURN        RETURN
249        END        END
250    
251  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
252    CBOP 0
253    C     !ROUTINE: MNC_CW_APPEND_VNAME
254    
255        SUBROUTINE MNC_CW_INIT(  C     !INTERFACE:
256       I     myThid,        SUBROUTINE MNC_CW_APPEND_VNAME(
257       I     sNx,sNy, OLx,OLy, nSx,nSy, nPx,nPy, Nr )       I     vname,
258         I     gname,
259         I     bi_dim, bj_dim,
260         I     myThid )
261    
262    C     !DESCRIPTION:
263    C     If it is not yet defined within the MNC CW layer, append a
264    C     variable type.  Calls MNC\_CW\_ADD\_VNAME().
265    
266    C     !USES:
267        implicit none        implicit none
268  #include "mnc_common.h"  #include "MNC_COMMON.h"
 #include "EEPARAMS.h"  
269    
270  C     Arguments  C     !INPUT PARAMETERS:
271        integer myThid        integer myThid, bi_dim, bj_dim
272        integer sNx,sNy, OLx,OLy, nSx,nSy, nPx,nPy, Nr        character*(*) vname, gname
273    CEOP
 C     Functions  
       integer IFNBLNK, ILNBLNK  
274    
275  C     Local Variables  C     !LOCAL VARIABLES:
276        integer CW_MAX_LOC        integer indv
       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)  
   
 C     ......12345....12345....12345....12345....12345...  
       data horz_dat /  
      &     '-    ', '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  
277    
278                    CALL MNC_CW_ADD_GNAME(myThid, name, ndim,  C     Check whether vname is defined
279       &                 dim, dn, ib, ie)        CALL MNC_GET_IND(MNC_MAX_ID, vname, mnc_cw_vname, indv, myThid)
280                  ENDIF        IF (indv .LT. 1) THEN
281            CALL MNC_CW_ADD_VNAME(vname, gname, bi_dim, bj_dim, myThid)
282          ENDIF
283    
               ENDDO  
             ENDDO  
284    
  10         CONTINUE  
           ENDDO  
         ENDDO  
       ENDDO  
         
285        RETURN        RETURN
286        END        END
287    
288  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
289    CBOP 0
290    C     !ROUTINE: MNC_CW_ADD_VNAME
291    
292        SUBROUTINE MNC_CW_ADD_VNAME(  C     !INTERFACE:
293       I     myThid,        SUBROUTINE MNC_CW_ADD_VNAME(
294       I     vname,       I     vname,
295       I     gname,       I     gname,
296       I     bi_dim, bj_dim )       I     bi_dim, bj_dim,
297         I     myThid )
298    
299    C     !DESCRIPTION:
300    C     Add a variable type to the MNC CW layer.  The variable type is an
301    C     association between a variable type name and the following items:
302    C     \begin{center}
303    C       \begin{tabular}[h]{|ll|}\hline
304    C         \textbf{Item}  & \textbf{Purpose}  \\\hline
305    C         grid type  &  defines the in-memory arrangement  \\
306    C         \texttt{bi,bj} dimensions  &  tiling indices, if present  \\\hline
307    C       \end{tabular}
308    C     \end{center}
309    
310    C     !USES:
311        implicit none        implicit none
312  #include "mnc_common.h"  #include "MNC_COMMON.h"
313  #include "EEPARAMS.h"  #include "EEPARAMS.h"
314    
315  C     Arguments  C     !INPUT PARAMETERS:
316        integer myThid, bi_dim, bj_dim        integer myThid, bi_dim, bj_dim
317        character*(*) vname, gname        character*(*) vname, gname
318    CEOP
319    
320  C     Functions  C     !LOCAL VARIABLES:
       integer IFNBLNK, ILNBLNK  
   
 C     Local Variables  
321        integer i, nvf,nvl, ngf,ngl, indv,indg        integer i, nvf,nvl, ngf,ngl, indv,indg
322        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
323    
324    C     Functions
325          integer IFNBLNK, ILNBLNK
326    
327        nvf = IFNBLNK(vname)        nvf = IFNBLNK(vname)
328        nvl = ILNBLNK(vname)        nvl = ILNBLNK(vname)
329        ngf = IFNBLNK(gname)        ngf = IFNBLNK(gname)
330        ngl = ILNBLNK(gname)        ngl = ILNBLNK(gname)
331    
332  C     Check that this vname is not already defined  C     Check that this vname is not already defined
333        CALL MNC_GET_IND(myThid, MNC_MAX_ID, vname, mnc_cw_vname, indv)        CALL MNC_GET_IND(MNC_MAX_ID, vname, mnc_cw_vname, indv, myThid)
334        IF (indv .GT. 0) THEN        IF (indv .GT. 0) THEN
335          write(msgbuf,'(3a)') 'MNC_CW_ADD_VNAME ERROR: ''',          write(msgbuf,'(3a)') 'MNC_CW_ADD_VNAME ERROR: ''',
336       &       vname(nvf:nvl), ''' is already defined'       &       vname(nvf:nvl), ''' is already defined'
337          CALL print_error(msgbuf, mythid)          CALL print_error(msgbuf, mythid)
338          stop 'ABNORMAL END: S/R MNC_CW_ADD_VNAME'          stop 'ABNORMAL END: S/R MNC_CW_ADD_VNAME'
339        ENDIF        ENDIF
340        CALL MNC_GET_NEXT_EMPTY_IND(myThid, MNC_MAX_ID, mnc_cw_vname,        CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID, mnc_cw_vname,
341       &     indv)       &     'mnc_cw_vname', indv, myThid)
342    
343  C     Check that gname exists  C     Check that gname exists
344        CALL MNC_GET_IND(myThid, MNC_MAX_ID, gname, mnc_cw_gname, indg)        CALL MNC_GET_IND(MNC_MAX_ID, gname, mnc_cw_gname, indg, myThid)
345        IF (indg .LT. 1) THEN        IF (indg .LT. 1) THEN
346          write(msgbuf,'(3a)') 'MNC_CW_ADD_VNAME ERROR: ''',          write(msgbuf,'(3a)') 'MNC_CW_ADD_VNAME ERROR: ''',
347       &       gname(ngf:ngl), ''' is not defined'       &       gname(ngf:ngl), ''' is not defined'
348          CALL print_error(msgbuf, mythid)          CALL print_error(msgbuf, mythid)
349          stop 'ABNORMAL END: S/R MNC_CW_ADD_VNAME'          stop 'ABNORMAL END: S/R MNC_CW_ADD_VNAME'
# Line 377  C     Check that gname exists Line 358  C     Check that gname exists
358        mnc_cw_vbij(1,indv) = bi_dim        mnc_cw_vbij(1,indv) = bi_dim
359        mnc_cw_vbij(2,indv) = bj_dim        mnc_cw_vbij(2,indv) = bj_dim
360    
361        CALL MNC_CW_ADD_VATTR_TEXT(myThid,vname,1,'mitgcm_grid',gname)  #ifdef MNC_DEBUG_GTYPE
362          CALL MNC_CW_ADD_VATTR_TEXT(vname,1,'mitgcm_grid',gname, myThid)
363    #endif
364    
365        RETURN        RETURN
366        END        END
367    
368  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
369    CBOP 0
370    C     !ROUTINE: MNC_CW_DEL_VNAME
371    
372    C     !INTERFACE:
373          SUBROUTINE MNC_CW_DEL_VNAME(
374         I     vname,
375         I     myThid )
376    
377        SUBROUTINE MNC_CW_ADD_VATTR_TEXT(  C     !DESCRIPTION:
378       I     myThid,  C     Delete a variable type from the MNC CW layer.
      I     vname,  
      I     ntat,  
      I     tnames,  
      I     tvals )  
379    
380    C     !USES:
381        implicit none        implicit none
382    #include "MNC_COMMON.h"
383    #include "EEPARAMS.h"
384    
385  C     Arguments  C     !INPUT PARAMETERS:
386        integer myThid, ntat        integer myThid
387        character*(*) vname, tnames(*), tvals(*)        character*(*) vname
388    CEOP
389    
390        CALL MNC_CW_ADD_VATTR_ANY(myThid, vname,  C     !LOCAL VARIABLES:
391       &     ntat, 0, 0,        integer i, indv
392       &     tnames, ' ', ' ',  
393       &     tvals, 0, 0.0D0 )  C     Check that this vname is not already defined
394          CALL MNC_GET_IND(MNC_MAX_ID, vname, mnc_cw_vname, indv, myThid)
395          IF (indv .LT. 1) THEN
396            RETURN
397          ENDIF
398    
399          mnc_cw_vname(indv)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)
400          mnc_cw_vgind(indv) = 0
401          DO i = 1,3
402            mnc_cw_vnat(i,indv) = 0
403          ENDDO
404    
405        RETURN        RETURN
406        END        END
407    
408  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
409    CBOP
410    C     !ROUTINE: MNC_CW_ADD_VATTR_TEXT
411    C     !INTERFACE:
412          SUBROUTINE MNC_CW_ADD_VATTR_TEXT(
413         I     vname, tname, tval,
414         I     myThid )
415    
416        SUBROUTINE MNC_CW_ADD_VATTR_INT(  C     !DESCRIPTION:
417       I     myThid,  C     Add a text attribute
      I     vname,  
      I     niat,  
      I     inames,  
      I     ivals )  
418    
419    C     !USES:
420        implicit none        implicit none
421    
422  C     Arguments  C     !INPUT PARAMETERS:
423        integer myThid, niat        integer myThid
424        character*(*) vname, inames(*)        character*(*) vname, tname, tval
425        integer ivals(*)        integer ival
426          REAL*8 dval
427        CALL MNC_CW_ADD_VATTR_ANY(myThid, vname,  CEOP
428       &     0, niat, 0,        ival = 0
429       &     ' ', inames, ' ',        dval = 0.0D0
430       &     ' ', ivals, 0.0D0 )        CALL MNC_CW_ADD_VATTR_ANY(vname, 1,
431         &     tname, ' ', ' ', tval, ival, dval, myThid )
432        RETURN        RETURN
433        END        END
   
434  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
435    CBOP
436    C     !ROUTINE: MNC_CW_ADD_VATTR_INT
437    C     !INTERFACE:
438          SUBROUTINE MNC_CW_ADD_VATTR_INT(
439         I     vname, iname, ival,
440         I     myThid )
441    
442        SUBROUTINE MNC_CW_ADD_VATTR_DBL(  C     !DESCRIPTION:
443       I     myThid,  C     Add integer attribute
      I     vname,  
      I     ndat,  
      I     dnames,  
      I     dvals )  
444    
445    C     !USES:
446        implicit none        implicit none
447    
448  C     Arguments  C     !INPUT PARAMETERS:
449        integer myThid, ndat        integer myThid
450        character*(*) vname, dnames(*)        character*(*) vname, iname
451        REAL*8 dvals(*)        integer ival
452          REAL*8 dval
453    CEOP
454          dval = 0.0D0
455          CALL MNC_CW_ADD_VATTR_ANY(vname, 2,
456         &     ' ', iname, ' ', ' ', ival, dval, myThid )
457          RETURN
458          END
459    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
460    CBOP
461    C !ROUTINE: MNC_CW_ADD_VATTR_DBL
462    C !INTERFACE:
463          SUBROUTINE MNC_CW_ADD_VATTR_DBL(
464         I     vname, dname, dval,
465         I     myThid )
466    
467        CALL MNC_CW_ADD_VATTR_ANY(myThid, vname,  C     !DESCRIPTION:
468       &     0, 0, ndat,  C     Add double-precision real attribute
      &     ' ', ' ', dnames,  
      &     ' ', 0, dvals )  
469    
470    C     !USES:
471          implicit none
472    
473    C     !INPUT PARAMETERS:
474          integer myThid
475          character*(*) vname, dname
476          integer ival
477          REAL*8 dval
478    CEOP
479          ival = 0
480          CALL MNC_CW_ADD_VATTR_ANY(vname, 3,
481         &     ' ', ' ', dname, ' ', ival, dval, myThid )
482        RETURN        RETURN
483        END        END
   
484  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
485    CBOP 1
486    C     !ROUTINE: MNC_CW_ADD_VATTR_ANY
487    
488    C     !INTERFACE:
489          SUBROUTINE MNC_CW_ADD_VATTR_ANY(
490         I     vname,
491         I     atype,
492         I     tname, iname, dname,
493         I     tval,  ival,  dval,
494         I     myThid )
495    
496        SUBROUTINE MNC_CW_ADD_VATTR_ANY(  C     !DESCRIPTION:
      I     myThid,  
      I     vname,  
      I     ntat,   niat,   ndat,  
      I     tnames, inames, dnames,  
      I     tvals,  ivals,  dvals )  
497    
498    C     !USES:
499        implicit none        implicit none
500  #include "mnc_common.h"  #include "MNC_COMMON.h"
501  #include "EEPARAMS.h"  #include "EEPARAMS.h"
502    
503  C     Arguments  C     !INPUT PARAMETERS:
504        integer myThid, ntat, niat, ndat        integer myThid
505          integer atype
506        character*(*) vname        character*(*) vname
507        character*(*) tnames(*), inames(*), dnames(*)        character*(*) tname, iname, dname
508        character*(*) tvals(*)        character*(*) tval
509        integer ivals(*)        integer ival
510        REAL*8 dvals(*)        REAL*8 dval
511    CEOP
512    
513    C     !LOCAL VARIABLES:
514          integer n, nvf,nvl, n1,n2, indv, ic
515          character*(MAX_LEN_MBUF) msgbuf
516    
517  C     Functions  C     Functions
518        integer IFNBLNK, ILNBLNK        integer IFNBLNK, ILNBLNK
519    
 C     Local Variables  
       integer i, n, nvf,nvl, n1,n2, indv  
       character*(MAX_LEN_MBUF) msgbuf  
   
520        nvf = IFNBLNK(vname)        nvf = IFNBLNK(vname)
521        nvl = ILNBLNK(vname)        nvl = ILNBLNK(vname)
522    
523  C     Check that vname is defined  C     Check that vname is defined
524        CALL MNC_GET_IND(myThid, MNC_MAX_ID, vname, mnc_cw_vname, indv)        CALL MNC_GET_IND(MNC_MAX_ID, vname, mnc_cw_vname, indv, myThid)
525        IF (indv .LT. 1) THEN        IF (indv .LT. 1) THEN
526          write(msgbuf,'(3a)') 'MNC_CW_ADD_VATTR_ANY ERROR: ''',          write(msgbuf,'(3a)') 'MNC_CW_ADD_VATTR_ANY ERROR: ''',
527       &       vname(nvf:nvl), ''' is not defined'       &       vname(nvf:nvl), ''' is not defined'
528          CALL print_error(msgbuf, mythid)          CALL print_error(msgbuf, mythid)
529          stop 'ABNORMAL END: S/R MNC_CW_ADD_VATTR_ANY'          stop 'ABNORMAL END: S/R MNC_CW_ADD_VATTR_ANY'
530        ENDIF        ENDIF
531    
532  C     Text Attributes        IF (atype .EQ. 1) THEN
533        n = mnc_cw_vnat(1,indv)  C       Text Attribute
534        DO i = 1,ntat          n = mnc_cw_vnat(1,indv) + 1
535          n1 = IFNBLNK(tnames(i))          n1 = IFNBLNK(tname)
536          n2 = ILNBLNK(tnames(i))          n2 = ILNBLNK(tname)
537          mnc_cw_vtnm(n+i,indv)(1:(n2-n1+1)) = tnames(i)(n1:n2)          IF ((n2-n1+1) .GT. MNC_MAX_CHAR) THEN
538          n1 = IFNBLNK(tvals(i))            write(msgbuf,'(3a,i6,2a)')
539          n2 = ILNBLNK(tvals(i))       &         'MNC_CW_ADD_VATTR_ANY WARNING: attribute name ''',
540          mnc_cw_vtat(n+i,indv)(1:(n2-n1+1)) = tvals(i)(n1:n2)       &         tname(n1:n2), ''' has more than ', MNC_MAX_CHAR,
541        ENDDO       &         ' characters and has been truncated to fit--please',
542        mnc_cw_vnat(1,indv) = n + ntat       &         'use a smaller name or increase MNC_MAX_CHAR'
543              CALL PRINT_MESSAGE( msgbuf, errorMessageUnit,
544         &                        SQUEEZE_RIGHT , myThid)
545    C         MNC_MAX_CHAR = n2 - n1 + 1
546              n2 = MNC_MAX_CHAR + n1 - 1
547            ENDIF
548    C       write(*,*) atype,tname(n1:n2)
549            mnc_cw_vtnm(n,indv)(1:MNC_MAX_CHAR) =
550         &       mnc_blank_name(1:MNC_MAX_CHAR)
551            mnc_cw_vtnm(n,indv)(1:(n2-n1+1)) = tname(n1:n2)
552    
553            n1 = IFNBLNK(tval)
554            n2 = ILNBLNK(tval)
555            IF ((n2-n1+1) .GT. MNC_MAX_CATT) THEN
556              write(msgbuf,'(3a,i6,2a)')
557         &         'MNC_CW_ADD_VATTR_ANY WARNING: attribute value ''',
558         &         tval(n1:n2), ''' has more than ', MNC_MAX_CATT,
559         &         ' characters and has been truncated to fit--please',
560         &         'use a smaller name or increase MNC_MAX_CATT'
561              CALL PRINT_MESSAGE( msgbuf, errorMessageUnit,
562         &                        SQUEEZE_RIGHT , myThid)
563              n2 = MNC_MAX_CATT + n1 - 1
564            ENDIF
565    
566  C     Integer Attributes          mnc_cw_vnat(1,indv) = n
567        n = mnc_cw_vnat(2,indv)          DO ic = 1,MNC_MAX_CATT
568        DO i = 1,niat            mnc_cw_vtat(n,indv)(ic:ic) = ' '
569          n1 = IFNBLNK(inames(i))          ENDDO
570          n2 = ILNBLNK(inames(i))          IF ((n1 .NE. 0) .AND. (n2 .NE. 0)) THEN
571          mnc_cw_vinm(n+i,indv)(1:(n2-n1+1)) = inames(i)(n1:n2)            mnc_cw_vtat(n,indv)(1:(n2-n1+1)) = tval(n1:n2)
572          mnc_cw_viat(n+i,indv) = ivals(i)          ENDIF
573        ENDDO        ENDIF
       mnc_cw_vnat(2,indv) = n + niat  
574    
575  C     Double Attributes        IF (atype .EQ. 2) THEN
576        n = mnc_cw_vnat(3,indv)  C       Integer Attribute
577        DO i = 1,ndat          n = mnc_cw_vnat(2,indv) + 1
578          n1 = IFNBLNK(dnames(i))          n1 = IFNBLNK(iname)
579          n2 = ILNBLNK(dnames(i))          n2 = ILNBLNK(iname)
580          mnc_cw_vdnm(n+i,indv)(1:(n2-n1+1)) = dnames(i)(n1:n2)  C       write(*,*) atype,iname(n1:n2)
581          mnc_cw_vdat(n+i,indv) = dvals(i)          mnc_cw_vinm(n,indv)(1:(n2-n1+1)) = iname(n1:n2)
582        ENDDO          mnc_cw_viat(n,indv) = ival
583        mnc_cw_vnat(3,indv) = n + ndat          mnc_cw_vnat(2,indv) = n
584          ENDIF
585    
586          IF (atype .EQ. 3) THEN
587    C       Double Attribute
588            n = mnc_cw_vnat(3,indv) + 1
589            n1 = IFNBLNK(dname)
590            n2 = ILNBLNK(dname)
591    C       write(*,*) atype,dname(n1:n2)
592            mnc_cw_vdnm(n,indv)(1:(n2-n1+1)) = dname(n1:n2)
593            mnc_cw_vdat(n,indv) = dval
594            mnc_cw_vnat(3,indv) = n
595          ENDIF
596    
597        RETURN        RETURN
598        END        END
599    
600  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
601    CBOP 1
602    C     !ROUTINE: MNC_CW_GET_TILE_NUM
603    
604        SUBROUTINE MNC_CW_GET_TILE_NUM(  C     !INTERFACE:
605       I     myThid,        SUBROUTINE MNC_CW_GET_TILE_NUM(
606       I     bi, bj,       I     bi, bj,
607       O     uniq_tnum )       O     uniq_tnum,
608         I     myThid )
609    
610    C     !DESCRIPTION:
611    
612    C     !USES:
613        implicit none        implicit none
614  #include "EEPARAMS.h"  #include "EEPARAMS.h"
615  #include "SIZE.h"  #include "SIZE.h"
616    #ifdef ALLOW_EXCH2
617    #include "W2_EXCH2_SIZE.h"
618    #include "W2_EXCH2_TOPOLOGY.h"
619    #endif
620    
621  C     Arguments  C     !INPUT PARAMETERS:
622        integer myThid, bi,bj, uniq_tnum        integer myThid, bi,bj, uniq_tnum
623    CEOP
624    
625  C     Local Variables  C     !LOCAL VARIABLES:
626        integer iG,jG        integer iG,jG
627    
628        iG = 0        iG = 0
# Line 550  C     Local Variables Line 630  C     Local Variables
630    
631  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
632    
633  #include "W2_EXCH2_PARAMS.h"        uniq_tnum = W2_myTileList(bi,bj)
       uniq_tnum = W2_myTileList(bi)  
634    
635  #else  #else
636    
# Line 569  CEH3      write(*,*) 'iG,jG,uniq_tnum :' Line 648  CEH3      write(*,*) 'iG,jG,uniq_tnum :'
648        END        END
649    
650  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
651    CBOP 1
652    C     !ROUTINE: MNC_CW_GET_FACE_NUM
653    
654        SUBROUTINE MNC_CW_FILE_AORC(  C     !INTERFACE:
655       I     myThid,        SUBROUTINE MNC_CW_GET_FACE_NUM(
656       I     fname,       I     bi, bj,
657       O     indf )       O     uniq_fnum,
658         I     myThid )
659    
660    C     !DESCRIPTION:
661    
662    C     !USES:
663        implicit none        implicit none
 #include "netcdf.inc"  
 #include "mnc_common.h"  
664  #include "EEPARAMS.h"  #include "EEPARAMS.h"
665    #include "SIZE.h"
666    #ifdef ALLOW_EXCH2
667    #include "W2_EXCH2_SIZE.h"
668    #include "W2_EXCH2_TOPOLOGY.h"
669    #endif
670    
671    C     !INPUT PARAMETERS:
672          integer myThid, bi,bj, uniq_fnum
673    CEOP
674    
675    #ifdef ALLOW_EXCH2
676    
677          uniq_fnum = exch2_myFace( W2_myTileList(bi,bj) )
678    
679    #else
680    
681    C     Global face number for simple (EXCH "1") domains
682          uniq_fnum = -1
683    
684  C     Arguments  #endif
685        integer myThid, indf  
686          RETURN
687          END
688    
689    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
690    CBOP 1
691    C     !ROUTINE: MNC_CW_GET_XYFO
692    
693    C     !INTERFACE:
694          SUBROUTINE MNC_CW_GET_XYFO(
695         I     bi, bj,
696         O     ixoff, iyoff,
697         I     myThid )
698    
699    C     !DESCRIPTION:
700    
701    C     !USES:
702          implicit none
703    #include "EEPARAMS.h"
704    #include "SIZE.h"
705    #ifdef ALLOW_EXCH2
706    #include "W2_EXCH2_SIZE.h"
707    #include "W2_EXCH2_TOPOLOGY.h"
708    #endif
709    
710    C     !INPUT PARAMETERS:
711          integer myThid, bi,bj, ixoff,iyoff
712    CEOP
713    
714    C     !LOCAL VARIABLES:
715    #ifdef ALLOW_EXCH2
716          integer uniq_tnum
717    #endif
718    
719    #ifdef ALLOW_EXCH2
720    
721          uniq_tnum = W2_myTileList(bi,bj)
722          ixoff = exch2_tbasex( uniq_tnum )
723          iyoff = exch2_tbasey( uniq_tnum )
724    
725    #else
726    
727    C     Global tile number for simple (non-cube) domains
728    C     iG = bi+(myXGlobalLo-1)/sNx
729    C     jG = bj+(myYGlobalLo-1)/sNy
730    C     uniq_tnum = (jG - 1)*(nPx*nSx) + iG
731          ixoff = myXGlobalLo + bi * sNx
732          iyoff = myYGlobalLo + bj * sNy
733    
734    #endif
735    
736          RETURN
737          END
738    
739    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
740    CBOP 1
741    C     !ROUTINE: MNC_CW_FILE_AORC
742    
743    C     !INTERFACE:
744          SUBROUTINE MNC_CW_FILE_AORC(
745         I     fname,
746         O     indf,
747         I     lbi, lbj, uniq_tnum,
748         I     myThid )
749    
750    C     !DESCRIPTION:
751    C     Open a NetCDF file, appending to the file if it already exists
752    C     and, if not, creating a new file.
753    
754    C     !USES:
755          implicit none
756    #include "MNC_COMMON.h"
757    #include "EEPARAMS.h"
758    #include "netcdf.inc"
759    
760    C     !INPUT PARAMETERS:
761          integer myThid, indf, lbi, lbj, uniq_tnum
762        character*(*) fname        character*(*) fname
763    CEOP
764    
765  C     Local Variables  C     !LOCAL VARIABLES:
766        integer i, ierr        integer ierr
       character*(MAX_LEN_MBUF) msgbuf  
767    
768  C     Check if the file is already open  C     Check if the file is already open
769        CALL MNC_GET_IND(myThid, MNC_MAX_ID, fname, mnc_f_names, indf)        CALL MNC_GET_IND(MNC_MAX_FID, fname, mnc_f_names, indf, myThid)
770        IF (indf .GT. 0) THEN        IF (indf .GT. 0) THEN
771          RETURN          RETURN
772        ENDIF        ENDIF
773    
774  C     Try to open an existing file  C     Try to open an existing file
775        CALL MNC_FILE_TRY_READ(myThid, fname, ierr, indf)        CALL MNC_FILE_TRY_READ(fname, ierr, indf, myThid)
776        IF (ierr .EQ. NF_NOERR) THEN        IF (ierr .NE. NF_NOERR) THEN
777          RETURN  C       Try to create a new one
778            CALL MNC_FILE_OPEN(fname, 0, indf, myThid)
779        ENDIF        ENDIF
780    
781  C     Try to create a new one  C     Add the global attributes
782        CALL MNC_FILE_OPEN(myThid, fname, 0, indf)        CALL MNC_CW_SET_GATTR(fname, lbi,lbj, uniq_tnum, myThid)
783    
784        RETURN        RETURN
785        END        END
786    
787  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
   
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.35
  ViewVC Help
Powered by ViewVC 1.1.22