/[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.12 by edhill, Fri Apr 2 16:12:48 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"
5          
6    C--  File mnc_cwrapper.F:
7    C--   Contents
8    C--   o MNC_CW_ADD_GNAME
9    C--   o MNC_CW_DEL_GNAME
10    C--   o MNC_CW_DUMP
11    C--   o MNC_CW_APPEND_VNAME
12    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-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
24  CBOP 0  CBOP 0
25  C     !ROUTINE: MNC_CW_ADD_GNAME  C     !ROUTINE: MNC_CW_ADD_GNAME
26    
27  C     !INTERFACE:  C     !INTERFACE:
28        SUBROUTINE MNC_CW_ADD_GNAME(        SUBROUTINE MNC_CW_ADD_GNAME(
29       I     name,       I     name,
30       I     ndim,       I     ndim,
31       I     dlens,       I     dlens,
32       I     dnames,       I     dnames,
33       I     inds_beg, inds_end,       I     inds_beg, inds_end,
34       I     myThid )       I     myThid )
35    
36  C     !DESCRIPTION:  C     !DESCRIPTION:
37  C     Add a grid name to the MNC convenience wrapper layer.  C     Add a grid name to the MNC convenience wrapper layer.
38          
39  C     !USES:  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     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
# Line 44  C     Functions Line 61  C     Functions
61  C     Check that this name is not already defined  C     Check that this name is not already defined
62        CALL MNC_GET_IND(MNC_MAX_ID, name, mnc_cw_gname, indg, myThid)        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(MNC_MAX_ID, mnc_cw_gname,        CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID, mnc_cw_gname,
70       &     indg, myThid)       &     '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 70  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  CBOP 1
134  C     !ROUTINE: MNC_CW_DUMP  C     !ROUTINE: MNC_CW_DUMP
135    
# Line 79  C     !INTERFACE: Line 139  C     !INTERFACE:
139  C     !DESCRIPTION:  C     !DESCRIPTION:
140  C     Write a condensed view of the current state of the MNC look-up  C     Write a condensed view of the current state of the MNC look-up
141  C     tables for the convenience wrapper section.  C     tables for the convenience wrapper section.
142          
143  C     !USES:  C     !USES:
144        implicit none        implicit none
145  #include "mnc_common.h"  #include "MNC_COMMON.h"
146  #include "SIZE.h"  #include "SIZE.h"
147  #include "EEPARAMS.h"  #include "EEPARAMS.h"
148  #include "PARAMS.h"  #include "PARAMS.h"
# Line 98  C     !LOCAL VARIABLES: Line 158  C     !LOCAL VARIABLES:
158        character s1*(NBLNK), blnk*(NBLNK)        character s1*(NBLNK), blnk*(NBLNK)
159    
160        _BEGIN_MASTER(myThid)        _BEGIN_MASTER(myThid)
161          
162        DO i = 1,NBLNK        DO i = 1,NBLNK
163          blnk(i:i) = ' '          blnk(i:i) = ' '
164        ENDDO        ENDDO
165          
166        s1(1:NBLNK) = blnk(1:NBLNK)        s1(1:NBLNK) = blnk(1:NBLNK)
167        write(s1,'(a5,a)') 'MNC: ',        write(s1,'(a5,a)') 'MNC: ',
168       &     'The currently defined Grid Types are:'       &     'The currently defined Grid Types are:'
# Line 110  C     !LOCAL VARIABLES: Line 170  C     !LOCAL VARIABLES:
170       &     s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)       &     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            s1(1:NBLNK) = blnk(1:NBLNK)            s1(1:NBLNK) = blnk(1:NBLNK)
178            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)')
179       &         'MNC: ',       &         'MNC: ',
180       &         j, ntot, ' : ', mnc_cw_gname(j)(1:20), mnc_cw_ndim(j),       &         j, ntot, ' : ', mnc_cw_gname(j)(1:20), mnc_cw_ndim(j),
181       &         ' : ', (mnc_cw_dims(i,j), i=1,5),       &         ' : ', (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(            CALL PRINT_MESSAGE(
186       &         s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)       &         s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
187              
188          ENDIF          ENDIF
189        ENDDO        ENDDO
190          
191        s1(1:NBLNK) = blnk(1:NBLNK)        s1(1:NBLNK) = blnk(1:NBLNK)
192        write(s1,'(a5,a)') 'MNC: ',        write(s1,'(a5,a)') 'MNC: ',
193       &     'The currently defined Variable Types are:'       &     'The currently defined Variable Types are:'
# Line 135  C     !LOCAL VARIABLES: Line 195  C     !LOCAL VARIABLES:
195       &     s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)       &     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            s1(1:NBLNK) = blnk(1:NBLNK)            s1(1:NBLNK) = blnk(1:NBLNK)
203            write(s1,'(a5,2i5,a3,a25,a3,i4)') 'MNC: ',            write(s1,'(a5,2i5,a3,a25,a3,i4)') 'MNC: ',
204       &         j, ntot, ' | ',       &         j, ntot, ' | ',
205       &         mnc_cw_vname(j)(1:20), ' | ', mnc_cw_vgind(j)       &         mnc_cw_vname(j)(1:20), ' | ', mnc_cw_vgind(j)
206            CALL PRINT_MESSAGE(            CALL PRINT_MESSAGE(
207       &         s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)       &         s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
208              
209            DO i = 1,mnc_cw_vnat(1,j)            DO i = 1,mnc_cw_vnat(1,j)
210              s1(1:NBLNK) = blnk(1:NBLNK)              s1(1:NBLNK) = blnk(1:NBLNK)
211              write(s1,'(a5,a14,i4,a3,a25,a3,a55)')              write(s1,'(a5,a14,i4,a3,a25,a3,a55)')
212       &           'MNC: ','      text_at:',i,       &           '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:55)       &           mnc_cw_vtat(i,j)(1:MNC_MAX_CHAR)
215              CALL PRINT_MESSAGE(              CALL PRINT_MESSAGE(
216       &           s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)       &           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              s1(1:NBLNK) = blnk(1:NBLNK)              s1(1:NBLNK) = blnk(1:NBLNK)
220              write(s1,'(a5,a14,i4,a3,a25,a3,i20)')              write(s1,'(a5,a14,i4,a3,a25,a3,i20)')
221       &           'MNC: ','      int__at:',i,       &           '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(              CALL PRINT_MESSAGE(
# Line 166  C     !LOCAL VARIABLES: Line 226  C     !LOCAL VARIABLES:
226            ENDDO            ENDDO
227            DO i = 1,mnc_cw_vnat(3,j)            DO i = 1,mnc_cw_vnat(3,j)
228              s1(1:NBLNK) = blnk(1:NBLNK)              s1(1:NBLNK) = blnk(1:NBLNK)
229              write(s1,'(a5,a14,i4,a3,a25,a3,f25.10)')              write(s1,'(a5,a14,i4,a3,a25,a3,f25.10)')
230       &           'MNC: ','      dbl__at:',i,       &           '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              CALL PRINT_MESSAGE(              CALL PRINT_MESSAGE(
234       &           s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)       &           s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
235          ENDDO          ENDDO
236            
237          ENDIF          ENDIF
238        ENDDO        ENDDO
239        IF (ntot .EQ. 0) THEN        IF (ntot .EQ. 0) THEN
# Line 182  C     !LOCAL VARIABLES: Line 242  C     !LOCAL VARIABLES:
242          CALL PRINT_MESSAGE(          CALL PRINT_MESSAGE(
243       &       s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)       &       s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
244        ENDIF        ENDIF
245          
246        _END_MASTER(myThid)        _END_MASTER(myThid)
247    
248        RETURN        RETURN
# Line 190  C     !LOCAL VARIABLES: Line 250  C     !LOCAL VARIABLES:
250    
251  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
252  CBOP 0  CBOP 0
253  C     !ROUTINE: MNC_CW_INIT  C     !ROUTINE: MNC_CW_APPEND_VNAME
254    
255  C     !INTERFACE:  C     !INTERFACE:
256        SUBROUTINE MNC_CW_INIT(        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 )       I     myThid )
261    
262  C     !DESCRIPTION:  C     !DESCRIPTION:
263  C     Create the pre-defined grid types and variable types.  C     If it is not yet defined within the MNC CW layer, append a
264    C     variable type.  Calls MNC\_CW\_ADD\_VNAME().
 C     The grid type is a character string that encodes the presence and  
 C     types associated with the four possible dimensions.  The character  
 C     string follows the format  
 C     \begin{center}  
 C       \texttt{H0\_H1\_H2\_\_V\_\_T}  
 C     \end{center}  
 C     where the terms \textit{H0}, \textit{H1}, \textit{H2}, \textit{V},  
 C     \textit{T} can be almost any combination of the following:  
 C     \begin{center}  
 C       \begin{tabular}[h]{|ccc|c|c|}\hline  
 C         \multicolumn{3}{|c|}{Horizontal} & Vertical & Time \\  
 C         \textit{H0}: location & \textit{H1}: dimensions & \textit{H2}: halo  
 C               & \textit{V}: location & \textit{T}: level  \\\hline  
 C         \texttt{-} & xy & Hn & \texttt{-} & \texttt{-} \\  
 C         U  &  x  &  Hy  &  i  &  t  \\  
 C         V  &  y  &      &  c  &     \\  
 C         Cen  &   &      &     &     \\  
 C         Cor  &   &      &     &     \\\hline  
 C       \end{tabular}  
 C     \end{center}  
   
265    
266  C     !USES:  C     !USES:
267        implicit none        implicit none
268  #include "mnc_common.h"  #include "MNC_COMMON.h"
 #include "EEPARAMS.h"  
269    
270  C     !INPUT PARAMETERS:  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  CEOP
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     Functions  
       integer IFNBLNK, ILNBLNK  
   
 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(name, ndim,  C     Check whether vname is defined
279       &                 dim, dn, ib, ie, myThid)        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    
# Line 419  CBOP 0 Line 290  CBOP 0
290  C     !ROUTINE: MNC_CW_ADD_VNAME  C     !ROUTINE: MNC_CW_ADD_VNAME
291    
292  C     !INTERFACE:  C     !INTERFACE:
293        SUBROUTINE MNC_CW_ADD_VNAME(        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 )       I     myThid )
298    
299  C     !DESCRIPTION: Add a variable type to the MNC CW layer.  The  C     !DESCRIPTION:
300  C     variable type is an association between a variable type name and  C     Add a variable type to the MNC CW layer.  The variable type is an
301  C     the following items:  C     association between a variable type name and the following items:
302  C     \begin{center}  C     \begin{center}
303  C       \begin{tabular}[h]{|ll|}\hline  C       \begin{tabular}[h]{|ll|}\hline
304  C         \textbf{Item}  & \textbf{Purpose}  \\\hline  C         \textbf{Item}  & \textbf{Purpose}  \\\hline
# Line 435  C         grid type  &  defines the in-m Line 306  C         grid type  &  defines the in-m
306  C         \texttt{bi,bj} dimensions  &  tiling indices, if present  \\\hline  C         \texttt{bi,bj} dimensions  &  tiling indices, if present  \\\hline
307  C       \end{tabular}  C       \end{tabular}
308  C     \end{center}  C     \end{center}
309      
310  C     !USES:  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     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
# Line 461  C     Functions Line 332  C     Functions
332  C     Check that this vname is not already defined  C     Check that this vname is not already defined
333        CALL MNC_GET_IND(MNC_MAX_ID, vname, mnc_cw_vname, indv, myThid)        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(MNC_MAX_ID, mnc_cw_vname,        CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID, mnc_cw_vname,
341       &     indv, myThid)       &     'mnc_cw_vname', indv, myThid)
342    
343  C     Check that gname exists  C     Check that gname exists
344        CALL MNC_GET_IND(MNC_MAX_ID, gname, mnc_cw_gname, indg, myThid)        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 487  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    #ifdef MNC_DEBUG_GTYPE
362        CALL MNC_CW_ADD_VATTR_TEXT(vname,1,'mitgcm_grid',gname, myThid)        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  CBOP 0
370  C     !ROUTINE: MNC_CW_ADD_VATTR_TEXT  C     !ROUTINE: MNC_CW_DEL_VNAME
371    
372  C     !INTERFACE:  C     !INTERFACE:
373        SUBROUTINE MNC_CW_ADD_VATTR_TEXT(        SUBROUTINE MNC_CW_DEL_VNAME(
374       I     vname,       I     vname,
      I     ntat,  
      I     tnames,  
      I     tvals,  
375       I     myThid )       I     myThid )
376    
377  C     !DESCRIPTION:  C     !DESCRIPTION:
378  C     Add a text attribute  C     Delete a variable type from the MNC CW layer.
379          
380  C     !USES:  C     !USES:
381        implicit none        implicit none
382    #include "MNC_COMMON.h"
383    #include "EEPARAMS.h"
384    
385  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
386        integer myThid, ntat        integer myThid
387        character*(*) vname, tnames(*), tvals(*)        character*(*) vname
388  CEOP  CEOP
389    
390        CALL MNC_CW_ADD_VATTR_ANY(vname,  C     !LOCAL VARIABLES:
391       &     ntat, 0, 0,        integer i, indv
392       &     tnames, ' ', ' ',  
393       &     tvals, 0, 0.0D0, myThid )  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  CBOP
410  C     !ROUTINE: MNC_CW_ADD_VATTR_INT  C     !ROUTINE: MNC_CW_ADD_VATTR_TEXT
   
411  C     !INTERFACE:  C     !INTERFACE:
412        SUBROUTINE MNC_CW_ADD_VATTR_INT(        SUBROUTINE MNC_CW_ADD_VATTR_TEXT(
413       I     vname,       I     vname, tname, tval,
      I     niat,  
      I     inames,  
      I     ivals,  
414       I     myThid )       I     myThid )
415    
416  C     !DESCRIPTION:  C     !DESCRIPTION:
417    C     Add a text attribute
418    
419  C     !USES:  C     !USES:
420        implicit none        implicit none
421    
422  C     !INPUT PARAMETERS:  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  CEOP  CEOP
428          ival = 0
429          dval = 0.0D0
430          CALL MNC_CW_ADD_VATTR_ANY(vname, 1,
431         &     tname, ' ', ' ', tval, ival, dval, myThid )
432          RETURN
433          END
434    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        CALL MNC_CW_ADD_VATTR_ANY(vname,  C     !DESCRIPTION:
443       &     0, niat, 0,  C     Add integer attribute
      &     ' ', inames, ' ',  
      &     ' ', ivals, 0.0D0, myThid )  
444    
445    C     !USES:
446          implicit none
447    
448    C     !INPUT PARAMETERS:
449          integer myThid
450          character*(*) vname, iname
451          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        RETURN
458        END        END
   
459  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
460  CBOP 0  CBOP
461  C !ROUTINE: MNC_CW_ADD_VATTR_DBL  C !ROUTINE: MNC_CW_ADD_VATTR_DBL
   
462  C !INTERFACE:  C !INTERFACE:
463        SUBROUTINE MNC_CW_ADD_VATTR_DBL(        SUBROUTINE MNC_CW_ADD_VATTR_DBL(
464       I     vname,       I     vname, dname, dval,
      I     ndat,  
      I     dnames,  
      I     dvals,  
465       I     myThid )       I     myThid )
466    
467  C     !DESCRIPTION:  C     !DESCRIPTION:
468    C     Add double-precision real attribute
469    
470  C     !USES:  C     !USES:
471        implicit none        implicit none
472    
473  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
474        integer myThid, ndat        integer myThid
475        character*(*) vname, dnames(*)        character*(*) vname, dname
476        REAL*8 dvals(*)        integer ival
477          REAL*8 dval
478  CEOP  CEOP
479          ival = 0
480        CALL MNC_CW_ADD_VATTR_ANY(vname,        CALL MNC_CW_ADD_VATTR_ANY(vname, 3,
481       &     0, 0, ndat,       &     ' ', ' ', dname, ' ', ival, dval, myThid )
      &     ' ', ' ', dnames,  
      &     ' ', 0, dvals, 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  CBOP 1
486  C     !ROUTINE: MNC_CW_ADD_VATTR_ANY  C     !ROUTINE: MNC_CW_ADD_VATTR_ANY
487    
488  C     !INTERFACE:  C     !INTERFACE:
489        SUBROUTINE MNC_CW_ADD_VATTR_ANY(        SUBROUTINE MNC_CW_ADD_VATTR_ANY(
490       I     vname,       I     vname,
491       I     ntat,   niat,   ndat,       I     atype,
492       I     tnames, inames, dnames,       I     tname, iname, dname,
493       I     tvals,  ivals,  dvals,       I     tval,  ival,  dval,
494       I     myThid )       I     myThid )
495    
496  C     !DESCRIPTION:  C     !DESCRIPTION:
497    
498  C     !USES:  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     !INPUT PARAMETERS:  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  CEOP
512    
513  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
514        integer i, n, nvf,nvl, n1,n2, indv        integer n, nvf,nvl, n1,n2, indv, ic
515        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
516    
517  C     Functions  C     Functions
# Line 626  C     Functions Line 523  C     Functions
523  C     Check that vname is defined  C     Check that vname is defined
524        CALL MNC_GET_IND(MNC_MAX_ID, vname, mnc_cw_vname, indv, myThid)        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
# Line 672  CBOP 1 Line 602  CBOP 1
602  C     !ROUTINE: MNC_CW_GET_TILE_NUM  C     !ROUTINE: MNC_CW_GET_TILE_NUM
603    
604  C     !INTERFACE:  C     !INTERFACE:
605        SUBROUTINE MNC_CW_GET_TILE_NUM(        SUBROUTINE MNC_CW_GET_TILE_NUM(
606       I     bi, bj,       I     bi, bj,
607       O     uniq_tnum,       O     uniq_tnum,
608       I     myThid )       I     myThid )
609    
610  C     !DESCRIPTION:  C     !DESCRIPTION:
# Line 684  C     !USES: Line 614  C     !USES:
614  #include "EEPARAMS.h"  #include "EEPARAMS.h"
615  #include "SIZE.h"  #include "SIZE.h"
616  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
617    #include "W2_EXCH2_SIZE.h"
618  #include "W2_EXCH2_TOPOLOGY.h"  #include "W2_EXCH2_TOPOLOGY.h"
 #include "W2_EXCH2_PARAMS.h"  
619  #endif  #endif
620    
621  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
# Line 700  C     !LOCAL VARIABLES: Line 630  C     !LOCAL VARIABLES:
630    
631  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
632    
633        uniq_tnum = W2_myTileList(bi)        uniq_tnum = W2_myTileList(bi,bj)
634    
635  #else  #else
636    
# Line 719  CEH3      write(*,*) 'iG,jG,uniq_tnum :' Line 649  CEH3      write(*,*) 'iG,jG,uniq_tnum :'
649    
650  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
651  CBOP 1  CBOP 1
652    C     !ROUTINE: MNC_CW_GET_FACE_NUM
653    
654    C     !INTERFACE:
655          SUBROUTINE MNC_CW_GET_FACE_NUM(
656         I     bi, bj,
657         O     uniq_fnum,
658         I     myThid )
659    
660    C     !DESCRIPTION:
661    
662    C     !USES:
663          implicit none
664    #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    #endif
685    
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  C     !ROUTINE: MNC_CW_FILE_AORC
742          
743  C     !INTERFACE:  C     !INTERFACE:
744        SUBROUTINE MNC_CW_FILE_AORC(        SUBROUTINE MNC_CW_FILE_AORC(
745       I     fname,       I     fname,
746       O     indf,       O     indf,
747         I     lbi, lbj, uniq_tnum,
748       I     myThid )       I     myThid )
749    
750  C     !DESCRIPTION:  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:  C     !USES:
755        implicit none        implicit none
756  #include "netcdf.inc"  #include "MNC_COMMON.h"
 #include "mnc_common.h"  
757  #include "EEPARAMS.h"  #include "EEPARAMS.h"
758    #include "netcdf.inc"
759    
760  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
761        integer myThid, indf        integer myThid, indf, lbi, lbj, uniq_tnum
762        character*(*) fname        character*(*) fname
763  CEOP  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(MNC_MAX_ID, fname, mnc_f_names, indf, myThid)        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(fname, ierr, indf, myThid)        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(fname, 0, indf, myThid)        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.12  
changed lines
  Added in v.1.35
  ViewVC Help
Powered by ViewVC 1.1.22