/[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.4 by edhill, Wed Feb 4 05:45:09 2004 UTC revision 1.14 by edhill, Tue Jul 6 03:55:53 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 0
8    C     !ROUTINE: MNC_CW_ADD_GNAME
9    
10    C     !INTERFACE:
11        SUBROUTINE MNC_CW_ADD_GNAME(        SUBROUTINE MNC_CW_ADD_GNAME(
      I     myThid,  
12       I     name,       I     name,
13       I     ndim,       I     ndim,
14       I     dlens,       I     dlens,
15       I     dnames,       I     dnames,
16       I     inds_beg, inds_end )       I     inds_beg, inds_end,
17         I     myThid )
18    
19    C     !DESCRIPTION:
20    C     Add a grid name to the MNC convenience wrapper layer.
21          
22    C     !USES:
23        implicit none        implicit none
24  #include "mnc_common.h"  #include "mnc_common.h"
25  #include "EEPARAMS.h"  #include "EEPARAMS.h"
26    
27  C     Arguments  C     !INPUT PARAMETERS:
28        integer myThid, ndim        integer myThid, ndim
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     Functions  C     !LOCAL VARIABLES:
       integer IFNBLNK, ILNBLNK  
   
 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    
38    C     Functions
39          integer IFNBLNK, ILNBLNK
40    
41        nnf = IFNBLNK(name)        nnf = IFNBLNK(name)
42        nnl = ILNBLNK(name)        nnl = ILNBLNK(name)
43    
44  C     Check that this name is not already defined  C     Check that this name is not already defined
45        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)
46        IF (indg .GT. 0) THEN        IF (indg .GT. 0) THEN
47          write(msgbuf,'(3a)') 'MNC_CW_ADD_GNAME ERROR: ''', name,          write(msgbuf,'(3a)') 'MNC_CW_ADD_GNAME ERROR: ''', name,
48       &       ''' is already defined'       &       ''' is already defined'
49          CALL print_error(msgbuf, mythid)          CALL print_error(msgbuf, mythid)
50          stop 'ABNORMAL END: S/R MNC_CW_ADD_GNAME'          stop 'ABNORMAL END: S/R MNC_CW_ADD_GNAME'
51        ENDIF        ENDIF
52        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,
53       &     indg)       &     indg, myThid)
54    
55        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)
56        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 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 1
74    C     !ROUTINE: MNC_CW_DUMP
75    
76        SUBROUTINE MNC_CW_DUMP()  C     !INTERFACE:
77          SUBROUTINE MNC_CW_DUMP( myThid )
78    
79    C     !DESCRIPTION:
80    C     Write a condensed view of the current state of the MNC look-up
81    C     tables for the convenience wrapper section.
82          
83    C     !USES:
84        implicit none        implicit none
85  #include "mnc_common.h"  #include "mnc_common.h"
86    #include "SIZE.h"
87    #include "EEPARAMS.h"
88    #include "PARAMS.h"
89    
90    C     !INPUT PARAMETERS:
91          integer myThid
92    CEOP
93    
94  C     Local Variables  C     !LOCAL VARIABLES:
95        integer i,j, ntot        integer i,j, ntot
96          integer NBLNK
97          parameter ( NBLNK = 150 )
98          character s1*(NBLNK), blnk*(NBLNK)
99    
100        write(*,'(a)') 'The currently defined Grid Types are:'        _BEGIN_MASTER(myThid)
101          
102          DO i = 1,NBLNK
103            blnk(i:i) = ' '
104          ENDDO
105          
106          s1(1:NBLNK) = blnk(1:NBLNK)
107          write(s1,'(a5,a)') 'MNC: ',
108         &     'The currently defined Grid Types are:'
109          CALL PRINT_MESSAGE(
110         &     s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
111        ntot = 0        ntot = 0
112        DO j = 1,MNC_MAX_ID        DO j = 1,MNC_MAX_ID
113          IF (mnc_cw_gname(j)(1:MNC_MAX_CHAR)          IF (mnc_cw_gname(j)(1:MNC_MAX_CHAR)
114       &       .NE. mnc_blank_name(1:MNC_MAX_CHAR)) THEN       &       .NE. mnc_blank_name(1:MNC_MAX_CHAR)) THEN
115                        
116            ntot = ntot + 1            ntot = ntot + 1
117            write(*,'(2i5,a3,a20,i3,a3,5i4,a4,5i4,a4,5i4,6a4)')            s1(1:NBLNK) = blnk(1:NBLNK)
118              write(s1,'(a5,2i5,a3,a20,i3,a3,5i4,a4,5i4,a4,5i4,6a8)')
119         &         'MNC: ',
120       &         j, ntot, ' : ', mnc_cw_gname(j)(1:20), mnc_cw_ndim(j),       &         j, ntot, ' : ', mnc_cw_gname(j)(1:20), mnc_cw_ndim(j),
121       &         ' : ', (mnc_cw_dims(i,j), i=1,5),       &         ' : ', (mnc_cw_dims(i,j), i=1,5),
122       &         '  | ', (mnc_cw_is(i,j), i=1,5),       &         '  | ', (mnc_cw_is(i,j), i=1,5),
123       &         '  | ', (mnc_cw_ie(i,j), i=1,5),       &         '  | ', (mnc_cw_ie(i,j), i=1,5),
124       &         '  | ', (mnc_cw_dn(i,j)(1:4), i=1,5)       &         '  | ', (mnc_cw_dn(i,j)(1:7), i=1,5)
125              CALL PRINT_MESSAGE(
126         &         s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
127              
128          ENDIF          ENDIF
129        ENDDO        ENDDO
130          
131        write(*,'(a)') 'The currently defined Variable Types are:'        s1(1:NBLNK) = blnk(1:NBLNK)
132          write(s1,'(a5,a)') 'MNC: ',
133         &     'The currently defined Variable Types are:'
134          CALL PRINT_MESSAGE(
135         &     s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
136        ntot = 0        ntot = 0
137        DO j = 1,MNC_MAX_ID        DO j = 1,MNC_MAX_ID
138          IF (mnc_cw_vname(j)(1:MNC_MAX_CHAR)          IF (mnc_cw_vname(j)(1:MNC_MAX_CHAR)
139       &       .NE. mnc_blank_name(1:MNC_MAX_CHAR)) THEN       &       .NE. mnc_blank_name(1:MNC_MAX_CHAR)) THEN
140              
141            ntot = ntot + 1            ntot = ntot + 1
142            write(*,'(2i5,a3,a25,a3,i4)') j, ntot, ' : ',            s1(1:NBLNK) = blnk(1:NBLNK)
143       &         mnc_cw_vname(j)(1:20), ' : ', mnc_cw_vgind(j)            write(s1,'(a5,2i5,a3,a25,a3,i4)') 'MNC: ',
144         &         j, ntot, ' | ',
145         &         mnc_cw_vname(j)(1:20), ' | ', mnc_cw_vgind(j)
146              CALL PRINT_MESSAGE(
147         &         s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
148              
149            DO i = 1,mnc_cw_vnat(1,j)            DO i = 1,mnc_cw_vnat(1,j)
150              write(*,'(a14,i4,a3,a25,a3,a25)') '      text_at:',i,              s1(1:NBLNK) = blnk(1:NBLNK)
151                write(s1,'(a5,a14,i4,a3,a25,a3,a55)')
152         &           'MNC: ','      text_at:',i,
153       &           ' : ', mnc_cw_vtnm(i,j)(1:25), ' : ',       &           ' : ', mnc_cw_vtnm(i,j)(1:25), ' : ',
154       &           mnc_cw_vtat(i,j)(1:25)       &           mnc_cw_vtat(i,j)(1:55)
155                CALL PRINT_MESSAGE(
156         &           s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
157            ENDDO            ENDDO
158            DO i = 1,mnc_cw_vnat(2,j)            DO i = 1,mnc_cw_vnat(2,j)
159              write(*,'(a14,i4,a3,a25,a3,i20)') '      int__at:',i,              s1(1:NBLNK) = blnk(1:NBLNK)
160                write(s1,'(a5,a14,i4,a3,a25,a3,i20)')
161         &           'MNC: ','      int__at:',i,
162       &           ' : ', mnc_cw_vinm(i,j)(1:25), ' : ',       &           ' : ', mnc_cw_vinm(i,j)(1:25), ' : ',
163       &           mnc_cw_viat(i,j)       &           mnc_cw_viat(i,j)
164                CALL PRINT_MESSAGE(
165         &           s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
166            ENDDO            ENDDO
167            DO i = 1,mnc_cw_vnat(3,j)            DO i = 1,mnc_cw_vnat(3,j)
168              write(*,'(a14,i4,a3,a25,a3,f25.10)') '      dbl__at:',i,              s1(1:NBLNK) = blnk(1:NBLNK)
169                write(s1,'(a5,a14,i4,a3,a25,a3,f25.10)')
170         &           'MNC: ','      dbl__at:',i,
171       &           ' : ', mnc_cw_vdnm(i,j)(1:25), ' : ',       &           ' : ', mnc_cw_vdnm(i,j)(1:25), ' : ',
172       &           mnc_cw_vdat(i,j)       &           mnc_cw_vdat(i,j)
173            ENDDO              CALL PRINT_MESSAGE(
174         &           s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
175            ENDDO
176            
177          ENDIF          ENDIF
178        ENDDO        ENDDO
179        IF (ntot .EQ. 0) THEN        IF (ntot .EQ. 0) THEN
180          write(*,'(a)') '   None defined!'          s1(1:NBLNK) = blnk(1:NBLNK)
181            write(s1,'(a)') 'MNC:    None defined!'
182            CALL PRINT_MESSAGE(
183         &       s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
184        ENDIF        ENDIF
185          
186          _END_MASTER(myThid)
187    
188        RETURN        RETURN
189        END        END
190    
191  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
192    CBOP 0
193    C     !ROUTINE: MNC_CW_INIT
194    
195    C     !INTERFACE:
196        SUBROUTINE MNC_CW_INIT(        SUBROUTINE MNC_CW_INIT(
197       I     myThid,       I     sNx,sNy, OLx,OLy, nSx,nSy, nPx,nPy, Nr, NrPhys,
198       I     sNx,sNy, OLx,OLy, nSx,nSy, nPx,nPy, Nr )       I     myThid )
199    
200    C     !DESCRIPTION:
201    C     Create the pre-defined grid types and variable types.
202    
203    C     The grid type is a character string that encodes the presence and
204    C     types associated with the four possible dimensions.  The character
205    C     string follows the format
206    C     \begin{center}
207    C       \texttt{H0\_H1\_H2\_\_V\_\_T}
208    C     \end{center}
209    C     where the terms \textit{H0}, \textit{H1}, \textit{H2}, \textit{V},
210    C     \textit{T} can be almost any combination of the following:
211    C     \begin{center}
212    C       \begin{tabular}[h]{|ccc|c|c|}\hline
213    C         \multicolumn{3}{|c|}{Horizontal} & Vertical & Time \\
214    C         \textit{H0}: location & \textit{H1}: dimensions & \textit{H2}: halo
215    C               & \textit{V}: location & \textit{T}: level  \\\hline
216    C         \texttt{-} & xy & Hn & \texttt{-} & \texttt{-} \\
217    C         U  &  x  &  Hy  &  i  &  t  \\
218    C         V  &  y  &      &  c  &     \\
219    C         Cen  &   &      &     &     \\
220    C         Cor  &   &      &     &     \\\hline
221    C       \end{tabular}
222    C     \end{center}
223    
224    
225    C     !USES:
226        implicit none        implicit none
227  #include "mnc_common.h"  #include "mnc_common.h"
228  #include "EEPARAMS.h"  #include "EEPARAMS.h"
229    
230  C     Arguments  C     !INPUT PARAMETERS:
231        integer myThid        integer myThid
232        integer sNx,sNy, OLx,OLy, nSx,nSy, nPx,nPy, Nr        integer sNx,sNy, OLx,OLy, nSx,nSy, nPx,nPy, Nr
233          integer NrPhys
234    CEOP
235    
236  C     Functions  C     !LOCAL VARIABLES:
       integer IFNBLNK, ILNBLNK  
   
 C     Local Variables  
237        integer CW_MAX_LOC        integer CW_MAX_LOC
238        parameter ( CW_MAX_LOC = 5 )        parameter ( CW_MAX_LOC = 5 )
239        integer i, ihorz,ihsub,ivert,itime,ihalo, is,ih, n,ntot        integer i, ihorz,ihsub,ivert,itime,ihalo, is,ih, n,ntot
240        integer ndim, ncomb        integer ndim, ncomb, nvch, NrPh
       character*(MAX_LEN_MBUF) msgbuf  
241        character*(MNC_MAX_CHAR) name        character*(MNC_MAX_CHAR) name
242        character*(MNC_MAX_CHAR) dn(CW_MAX_LOC)        character*(MNC_MAX_CHAR) dn(CW_MAX_LOC)
243        character*(5) horz_dat(CW_MAX_LOC), hsub_dat(CW_MAX_LOC),        character*(5) horz_dat(CW_MAX_LOC), hsub_dat(CW_MAX_LOC),
# Line 154  C     Local Variables Line 245  C     Local Variables
245       &     halo_dat(CW_MAX_LOC)       &     halo_dat(CW_MAX_LOC)
246        integer dim(CW_MAX_LOC), ib(CW_MAX_LOC), ie(CW_MAX_LOC)        integer dim(CW_MAX_LOC), ib(CW_MAX_LOC), ie(CW_MAX_LOC)
247    
248    C     Functions
249          integer ILNBLNK
250          external ILNBLNK
251    
252  C     ......12345....12345....12345....12345....12345...  C     ......12345....12345....12345....12345....12345...
253        data horz_dat /        data horz_dat /
254       &     '-    ', 'U    ', 'V    ', 'Cen  ', 'Cor  '  /       &     '-    ', 'U    ', 'V    ', 'Cen  ', 'Cor  '  /
# Line 162  C     ......12345....12345....12345....1 Line 257  C     ......12345....12345....12345....1
257        data halo_dat /        data halo_dat /
258       &     'Hn   ', 'Hy   ', '--   ', '     ', '     '  /       &     'Hn   ', 'Hy   ', '--   ', '     ', '     '  /
259        data vert_dat /        data vert_dat /
260       &     '-    ', 'C    ', 'I    ', '     ', '     '  /       &     '-    ', 'C    ', 'I    ', 'Phys ', 'PhysI'  /
261        data time_dat /        data time_dat /
262       &     '-    ', 't    ', '     ', '     ', '     '  /       &     '-    ', 't    ', '     ', '     ', '     '  /
263    
264          if (NrPhys .lt. 1) then
265            NrPh = Nr
266          else
267            NrPh = NrPhys
268          endif
269    
270        ncomb = 0        ncomb = 0
271        DO ihorz = 1,5        DO ihorz = 1,5
272          DO is = 1,3          DO is = 1,3
# Line 183  C           Loop just ONCE if the Horiz Line 284  C           Loop just ONCE if the Horiz
284                ENDIF                ENDIF
285              ENDIF              ENDIF
286                            
287              DO ivert = 1,3              DO ivert = 1,5
288                DO itime = 1,2                DO itime = 1,2
289                                    
290  C               horiz and hsub  C               horiz and hsub
# Line 196  C               horiz and hsub Line 297  C               horiz and hsub
297                  name((ntot+1):(ntot+n)) = hsub_dat(ihsub)(1:n)                  name((ntot+1):(ntot+n)) = hsub_dat(ihsub)(1:n)
298                  ntot = ntot + n                  ntot = ntot + n
299    
300  C               vert, time, and halo  C               halo, vert, and time
301                  write(name((ntot+1):(ntot+9)), '(a1,2a2,a1,a2,a1)')                  write(name((ntot+1):(ntot+5)), '(a1,2a2)')
302       &               '_', halo_dat(ihalo)(1:2), '__',       &               '_', halo_dat(ihalo)(1:2), '__'
303       &               vert_dat(ivert)(1:1), '__',                  nvch = ILNBLNK(vert_dat(ivert))
304       &               time_dat(itime)(1:1)                  n = ntot+6+nvch-1
305                    name((ntot+6):(n)) = vert_dat(ivert)(1:nvch)
306                    write(name((n+1):(n+3)), '(a2,a1)')
307         &               '__', time_dat(itime)(1:1)
308    
309                  ndim = 0                  ndim = 0
310                  DO i = 1,CW_MAX_LOC                  DO i = 1,CW_MAX_LOC
# Line 284  C               Vertical dimension Line 388  C               Vertical dimension
388                    ib(ndim)  = 1                    ib(ndim)  = 1
389                    ie(ndim)  = Nr + 1                    ie(ndim)  = Nr + 1
390                  ENDIF                  ENDIF
391                    IF (vert_dat(ivert)(1:5) .EQ. 'Phys ') THEN
392                      ndim = ndim + 1
393                      dn(ndim)(1:5) = 'Zphys'
394                      dim(ndim) = NrPh
395                      ib(ndim)  = 1
396                      ie(ndim)  = NrPh
397                    ENDIF
398                    IF (vert_dat(ivert)(1:5) .EQ. 'PhysI') THEN
399                      ndim = ndim + 1
400                      dn(ndim)(1:7) = 'Zphysm1'
401                      dim(ndim) = NrPh - 1
402                      ib(ndim)  = 1
403                      ie(ndim)  = NrPh - 1
404                    ENDIF
405    
406  C               Time dimension  C               Time dimension
407                  IF (time_dat(itime)(1:1) .EQ. 't') THEN                  IF (time_dat(itime)(1:1) .EQ. 't') THEN
# Line 305  C               Time dimension Line 423  C               Time dimension
423       &                 '  | ', (dn(i)(1:4), i=1,5)       &                 '  | ', (dn(i)(1:4), i=1,5)
424  #endif  #endif
425    
426                    CALL MNC_CW_ADD_GNAME(myThid, name, ndim,                    CALL MNC_CW_ADD_GNAME(name, ndim,
427       &                 dim, dn, ib, ie)       &                 dim, dn, ib, ie, myThid)
428                  ENDIF                  ENDIF
429    
430                ENDDO                ENDDO
# Line 321  C               Time dimension Line 439  C               Time dimension
439        END        END
440    
441  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
442    CBOP 0
443    C     !ROUTINE: MNC_CW_APPEND_VNAME
444    
445        SUBROUTINE MNC_CW_ADD_VNAME(  C     !INTERFACE:
446       I     myThid,        SUBROUTINE MNC_CW_APPEND_VNAME(
447       I     vname,       I     vname,
448       I     gname )       I     gname,
449         I     bi_dim, bj_dim,
450         I     myThid )
451    
452    C     !DESCRIPTION:
453    C     If it is not yet defined within the MNC CW layer, append a
454    C     variable type.  Calls MNC\_CW\_ADD\_VNAME().
455      
456    C     !USES:
457          implicit none
458    #include "mnc_common.h"
459    
460    C     !INPUT PARAMETERS:
461          integer myThid, bi_dim, bj_dim
462          character*(*) vname, gname
463    CEOP
464    
465    C     !LOCAL VARIABLES:
466          integer indv
467    
468    C     Check whether vname is defined
469          CALL MNC_GET_IND(MNC_MAX_ID, vname, mnc_cw_vname, indv, myThid)
470          IF (indv .LT. 1) THEN
471            CALL MNC_CW_ADD_VNAME(vname, gname, bi_dim, bj_dim, myThid)
472          ENDIF
473    
474    
475          RETURN
476          END
477    
478    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
479    CBOP 0
480    C     !ROUTINE: MNC_CW_ADD_VNAME
481    
482    C     !INTERFACE:
483          SUBROUTINE MNC_CW_ADD_VNAME(
484         I     vname,
485         I     gname,
486         I     bi_dim, bj_dim,
487         I     myThid )
488    
489    C     !DESCRIPTION:
490    C     Add a variable type to the MNC CW layer.  The variable type is an
491    C     association between a variable type name and the following items:
492    C     \begin{center}
493    C       \begin{tabular}[h]{|ll|}\hline
494    C         \textbf{Item}  & \textbf{Purpose}  \\\hline
495    C         grid type  &  defines the in-memory arrangement  \\
496    C         \texttt{bi,bj} dimensions  &  tiling indices, if present  \\\hline
497    C       \end{tabular}
498    C     \end{center}
499      
500    C     !USES:
501        implicit none        implicit none
502  #include "mnc_common.h"  #include "mnc_common.h"
503  #include "EEPARAMS.h"  #include "EEPARAMS.h"
504    
505  C     Arguments  C     !INPUT PARAMETERS:
506        integer myThid        integer myThid, bi_dim, bj_dim
507        character*(*) vname, gname        character*(*) vname, gname
508    CEOP
509    
510  C     Functions  C     !LOCAL VARIABLES:
       integer IFNBLNK, ILNBLNK  
   
 C     Local Variables  
511        integer i, nvf,nvl, ngf,ngl, indv,indg        integer i, nvf,nvl, ngf,ngl, indv,indg
512        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
513    
514    C     Functions
515          integer IFNBLNK, ILNBLNK
516    
517        nvf = IFNBLNK(vname)        nvf = IFNBLNK(vname)
518        nvl = ILNBLNK(vname)        nvl = ILNBLNK(vname)
519        ngf = IFNBLNK(gname)        ngf = IFNBLNK(gname)
520        ngl = ILNBLNK(gname)        ngl = ILNBLNK(gname)
521    
522  C     Check that this vname is not already defined  C     Check that this vname is not already defined
523        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)
524        IF (indv .GT. 0) THEN        IF (indv .GT. 0) THEN
525          write(msgbuf,'(3a)') 'MNC_CW_ADD_VNAME ERROR: ''',          write(msgbuf,'(3a)') 'MNC_CW_ADD_VNAME ERROR: ''',
526       &       vname(nvf:nvl), ''' is already defined'       &       vname(nvf:nvl), ''' is already defined'
527          CALL print_error(msgbuf, mythid)          CALL print_error(msgbuf, mythid)
528          stop 'ABNORMAL END: S/R MNC_CW_ADD_VNAME'          stop 'ABNORMAL END: S/R MNC_CW_ADD_VNAME'
529        ENDIF        ENDIF
530        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,
531       &     indv)       &     indv, myThid)
532    
533  C     Check that gname exists  C     Check that gname exists
534        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)
535        IF (indg .LT. 1) THEN        IF (indg .LT. 1) THEN
536          write(msgbuf,'(3a)') 'MNC_CW_ADD_VNAME ERROR: ''',          write(msgbuf,'(3a)') 'MNC_CW_ADD_VNAME ERROR: ''',
537       &       gname(ngf:ngl), ''' is not defined'       &       gname(ngf:ngl), ''' is not defined'
# Line 373  C     Check that gname exists Line 545  C     Check that gname exists
545        DO i = 1,3        DO i = 1,3
546          mnc_cw_vnat(i,indv) = 0          mnc_cw_vnat(i,indv) = 0
547        ENDDO        ENDDO
548          mnc_cw_vbij(1,indv) = bi_dim
549          mnc_cw_vbij(2,indv) = bj_dim
550    
551          CALL MNC_CW_ADD_VATTR_TEXT(vname,1,'mitgcm_grid',gname, myThid)
552    
553        RETURN        RETURN
554        END        END
555    
556  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
557    CBOP 0
558    C     !ROUTINE: MNC_CW_ADD_VATTR_TEXT
559    
560    C     !INTERFACE:
561        SUBROUTINE MNC_CW_ADD_VATTR_TEXT(        SUBROUTINE MNC_CW_ADD_VATTR_TEXT(
      I     myThid,  
562       I     vname,       I     vname,
563       I     ntat,       I     ntat,
564       I     tnames,       I     tnames,
565       I     tvals )       I     tvals,
566         I     myThid )
567    
568    C     !DESCRIPTION:
569    C     Add a text attribute
570          
571    C     !USES:
572        implicit none        implicit none
573    
574  C     Arguments  C     !INPUT PARAMETERS:
575        integer myThid, ntat        integer myThid, ntat
576        character*(*) vname, tnames(*), tvals(*)        character*(*) vname, tnames(*), tvals(*)
577    CEOP
578    
579        CALL MNC_CW_ADD_VATTR_ANY(myThid, vname,        CALL MNC_CW_ADD_VATTR_ANY(vname,
580       &     ntat, 0, 0,       &     ntat, 0, 0,
581       &     tnames, ' ', ' ',       &     tnames, ' ', ' ',
582       &     tvals, 0, 0.0D0 )       &     tvals, 0, 0.0D0, myThid )
583    
584        RETURN        RETURN
585        END        END
586    
587  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
588    CBOP
589    C     !ROUTINE: MNC_CW_ADD_VATTR_INT
590    
591    C     !INTERFACE:
592        SUBROUTINE MNC_CW_ADD_VATTR_INT(        SUBROUTINE MNC_CW_ADD_VATTR_INT(
      I     myThid,  
593       I     vname,       I     vname,
594       I     niat,       I     niat,
595       I     inames,       I     inames,
596       I     ivals )       I     ivals,
597         I     myThid )
598    
599    C     !DESCRIPTION:
600    
601    C     !USES:
602        implicit none        implicit none
603    
604  C     Arguments  C     !INPUT PARAMETERS:
605        integer myThid, niat        integer myThid, niat
606        character*(*) vname, inames(*)        character*(*) vname, inames(*)
607        integer ivals(*)        integer ivals(*)
608    CEOP
609    
610        CALL MNC_CW_ADD_VATTR_ANY(myThid, vname,        CALL MNC_CW_ADD_VATTR_ANY(vname,
611       &     0, niat, 0,       &     0, niat, 0,
612       &     ' ', inames, ' ',       &     ' ', inames, ' ',
613       &     ' ', ivals, 0.0D0 )       &     ' ', ivals, 0.0D0, myThid )
614    
615        RETURN        RETURN
616        END        END
617    
618  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
619    CBOP 0
620    C !ROUTINE: MNC_CW_ADD_VATTR_DBL
621    
622    C !INTERFACE:
623        SUBROUTINE MNC_CW_ADD_VATTR_DBL(        SUBROUTINE MNC_CW_ADD_VATTR_DBL(
      I     myThid,  
624       I     vname,       I     vname,
625       I     ndat,       I     ndat,
626       I     dnames,       I     dnames,
627       I     dvals )       I     dvals,
628         I     myThid )
629    
630    C     !DESCRIPTION:
631    
632    C     !USES:
633        implicit none        implicit none
634    
635  C     Arguments  C     !INPUT PARAMETERS:
636        integer myThid, ndat        integer myThid, ndat
637        character*(*) vname, dnames(*)        character*(*) vname, dnames(*)
638        REAL*8 dvals(*)        REAL*8 dvals(*)
639    CEOP
640    
641        CALL MNC_CW_ADD_VATTR_ANY(myThid, vname,        CALL MNC_CW_ADD_VATTR_ANY(vname,
642       &     0, 0, ndat,       &     0, 0, ndat,
643       &     ' ', ' ', dnames,       &     ' ', ' ', dnames,
644       &     ' ', 0, dvals )       &     ' ', 0, dvals, myThid )
645    
646        RETURN        RETURN
647        END        END
648    
649  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
650    CBOP 1
651    C     !ROUTINE: MNC_CW_ADD_VATTR_ANY
652    
653    C     !INTERFACE:
654        SUBROUTINE MNC_CW_ADD_VATTR_ANY(        SUBROUTINE MNC_CW_ADD_VATTR_ANY(
      I     myThid,  
655       I     vname,       I     vname,
656       I     ntat,   niat,   ndat,       I     ntat,   niat,   ndat,
657       I     tnames, inames, dnames,       I     tnames, inames, dnames,
658       I     tvals,  ivals,  dvals )       I     tvals,  ivals,  dvals,
659         I     myThid )
660    
661    C     !DESCRIPTION:
662    
663    C     !USES:
664        implicit none        implicit none
665  #include "mnc_common.h"  #include "mnc_common.h"
666  #include "EEPARAMS.h"  #include "EEPARAMS.h"
667    
668  C     Arguments  C     !INPUT PARAMETERS:
669        integer myThid, ntat, niat, ndat        integer myThid, ntat, niat, ndat
670        character*(*) vname        character*(*) vname
671        character*(*) tnames(*), inames(*), dnames(*)        character*(*) tnames(*), inames(*), dnames(*)
672        character*(*) tvals(*)        character*(*) tvals(*)
673        integer ivals(*)        integer ivals(*)
674        REAL*8 dvals(*)        REAL*8 dvals(*)
675    CEOP
676    
677  C     Functions  C     !LOCAL VARIABLES:
       integer IFNBLNK, ILNBLNK  
   
 C     Local Variables  
678        integer i, n, nvf,nvl, n1,n2, indv        integer i, n, nvf,nvl, n1,n2, indv
679        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
680    
681    C     Functions
682          integer IFNBLNK, ILNBLNK
683    
684        nvf = IFNBLNK(vname)        nvf = IFNBLNK(vname)
685        nvl = ILNBLNK(vname)        nvl = ILNBLNK(vname)
686    
687  C     Check that vname is defined  C     Check that vname is defined
688        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)
689        IF (indv .LT. 1) THEN        IF (indv .LT. 1) THEN
690          write(msgbuf,'(3a)') 'MNC_CW_ADD_VATTR_ANY ERROR: ''',          write(msgbuf,'(3a)') 'MNC_CW_ADD_VATTR_ANY ERROR: ''',
691       &       vname(nvf:nvl), ''' is not defined'       &       vname(nvf:nvl), ''' is not defined'
# Line 524  C     Double Attributes Line 729  C     Double Attributes
729        END        END
730    
731  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
732    CBOP 1
733    C     !ROUTINE: MNC_CW_GET_TILE_NUM
734    
735    C     !INTERFACE:
736        SUBROUTINE MNC_CW_GET_TILE_NUM(        SUBROUTINE MNC_CW_GET_TILE_NUM(
      I     myThid,  
737       I     bi, bj,       I     bi, bj,
738       O     uniq_tnum )       O     uniq_tnum,
739         I     myThid )
740    
741    C     !DESCRIPTION:
742    
743    C     !USES:
744        implicit none        implicit none
745  #include "EEPARAMS.h"  #include "EEPARAMS.h"
746  #include "SIZE.h"  #include "SIZE.h"
747    #ifdef ALLOW_EXCH2
748    #include "W2_EXCH2_TOPOLOGY.h"
749    #include "W2_EXCH2_PARAMS.h"
750    #endif
751    
752  C     Arguments  C     !INPUT PARAMETERS:
753        integer myThid, bi,bj, uniq_tnum        integer myThid, bi,bj, uniq_tnum
754    CEOP
755    
756  C     Local Variables  C     !LOCAL VARIABLES:
757        integer iG,jG        integer iG,jG
758    
759        iG = 0        iG = 0
# Line 545  C     Local Variables Line 761  C     Local Variables
761    
762  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
763    
 #include "W2_EXCH2_PARAMS.h"  
764        uniq_tnum = W2_myTileList(bi)        uniq_tnum = W2_myTileList(bi)
765    
766  #else  #else
# Line 564  CEH3      write(*,*) 'iG,jG,uniq_tnum :' Line 779  CEH3      write(*,*) 'iG,jG,uniq_tnum :'
779        END        END
780    
781  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
782    CBOP 1
783    C     !ROUTINE: MNC_CW_FILE_AORC
784          
785    C     !INTERFACE:
786        SUBROUTINE MNC_CW_FILE_AORC(        SUBROUTINE MNC_CW_FILE_AORC(
      I     myThid,  
787       I     fname,       I     fname,
788       O     indf )       O     indf,
789         I     myThid )
790    
791    C     !DESCRIPTION:
792    C     Open a NetCDF file, appending to the file if it already exists
793    C     and, if not, creating a new file.
794    
795    C     !USES:
796        implicit none        implicit none
797  #include "netcdf.inc"  #include "netcdf.inc"
798  #include "mnc_common.h"  #include "mnc_common.h"
799  #include "EEPARAMS.h"  #include "EEPARAMS.h"
800    
801  C     Arguments  C     !INPUT PARAMETERS:
802        integer myThid, indf        integer myThid, indf
803        character*(*) fname        character*(*) fname
804    CEOP
805    
806  C     Local Variables  C     !LOCAL VARIABLES:
807        integer i, ierr        integer ierr
       character*(MAX_LEN_MBUF) msgbuf  
808    
809  C     Check if the file is already open  C     Check if the file is already open
810        CALL MNC_GET_IND(myThid, MNC_MAX_ID, fname, mnc_f_names, indf)        CALL MNC_GET_IND(MNC_MAX_ID, fname, mnc_f_names, indf, myThid)
811        IF (indf .GT. 0) THEN        IF (indf .GT. 0) THEN
812          RETURN          RETURN
813        ENDIF        ENDIF
814    
815  C     Try to open an existing file  C     Try to open an existing file
816        CALL MNC_FILE_TRY_READ(myThid, fname, ierr, indf)        CALL MNC_FILE_TRY_READ(fname, ierr, indf, myThid)
817        IF (ierr .EQ. NF_NOERR) THEN        IF (ierr .EQ. NF_NOERR) THEN
818          RETURN          RETURN
819        ENDIF        ENDIF
820    
821  C     Try to create a new one  C     Try to create a new one
822        CALL MNC_FILE_OPEN(myThid, fname, 0, indf)        CALL MNC_FILE_OPEN(fname, 0, indf, myThid)
823    
824        RETURN        RETURN
825        END        END
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.14
  ViewVC Help
Powered by ViewVC 1.1.22