/[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.1 by edhill, Tue Jan 27 05:47:32 2004 UTC revision 1.19 by edhill, Wed Sep 22 21:19:44 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       SUBROUTINE MNC_CW_W_RL(  C     !INTERFACE:
11  C      I     myThid, myIter,        SUBROUTINE MNC_CW_ADD_GNAME(
 C      I     filebn,  
 C      I     bi,bj,  
 C      I     Gtype,  
 C      I     Rtype,  
 C      I     vname,  
 C      I     var )  
   
 C       implicit none  
 C #include "netcdf.inc"  
 C #include "mnc_common.h"  
 C #include "EEPARAMS.h"  
   
 C C     Arguments  
 C       integer myThid, myIter, bi,bj  
 C       character*(*) filebn, Gtype  
 C       character*(2) Rtype  
 C       _RL var*(*)  
   
         
   
 C       RETURN  
 C       END  
   
 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  
   
       SUBROUTINE MNC_CW_ADD_NAME(  
      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     Functions  C     !INPUT PARAMETERS:
       integer IFNBLNK, ILNBLNK  
   
 C     Arguments  
28        integer myThid, ndim        integer myThid, ndim
29        character*(*) name        character*(*) name
30        integer dlens(*), inds_beg(*), inds_end(*)        integer dlens(ndim), inds_beg(ndim), inds_end(ndim)
31        character*(*) dnames(*)        character*(*) dnames(ndim)
32    CEOP
33    
34  C     Local Variables  C     !LOCAL VARIABLES:
35        integer i, nnf,nnl, indg        integer i, nnf,nnl, indg
36        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
37    
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_names, 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_NAME 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_NAME'          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_names,        CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID, mnc_cw_gname,
53       &     indg)       &     indg, myThid)
54    
55        mnc_cw_names(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_names(indg)(1:(nnl-nnf+1)) = name(nnf:nnl)        mnc_cw_gname(indg)(1:(nnl-nnf+1)) = name(nnf:nnl)
57        mnc_cw_ndim(indg) = ndim        mnc_cw_ndim(indg) = ndim
58    
59        DO i = 1,ndim        DO i = 1,ndim
# Line 88  C     Check that this name is not alread Line 69  C     Check that this name is not alread
69        RETURN        RETURN
70        END        END
71    
   
72  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
73    CBOP 0
74    C     !ROUTINE: MNC_CW_DEL_GNAME
75    
76        SUBROUTINE MNC_CW_INIT(  C     !INTERFACE:
77       I     myThid,        SUBROUTINE MNC_CW_DEL_GNAME(
78       I     sNx,sNy, OLx,OLy, nSx,nSy, nPx,nPy, Nr )       I     name,
79         I     myThid )
80    
81    C     !DESCRIPTION:
82    C     Delete a grid name from the MNC convenience wrapper layer.
83          
84    C     !USES:
85        implicit none        implicit none
86  #include "mnc_common.h"  #include "mnc_common.h"
87  #include "EEPARAMS.h"  #include "EEPARAMS.h"
88    
89  C     Arguments  C     !INPUT PARAMETERS:
90        integer myThid        integer myThid
91        integer sNx,sNy, OLx,OLy, nSx,nSy, nPx,nPy, Nr        character*(*) name
92    CEOP
93    
94    C     !LOCAL VARIABLES:
95          integer nnf,nnl, indg
96    
97  C     Functions  C     Functions
98        integer IFNBLNK, ILNBLNK        integer IFNBLNK, ILNBLNK
99    
100  C     Local Variables        nnf = IFNBLNK(name)
101          nnl = ILNBLNK(name)
102    
103    C     Check that this name is not already defined
104          CALL MNC_GET_IND(MNC_MAX_ID, name, mnc_cw_gname, indg, myThid)
105          IF (indg .LT. 1) THEN
106            RETURN
107          ENDIF
108    
109          mnc_cw_gname(indg)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)
110          mnc_cw_ndim(indg) = 0
111    
112          RETURN
113          END
114    
115    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
116    CBOP 1
117    C     !ROUTINE: MNC_CW_DUMP
118    
119    C     !INTERFACE:
120          SUBROUTINE MNC_CW_DUMP( myThid )
121    
122    C     !DESCRIPTION:
123    C     Write a condensed view of the current state of the MNC look-up
124    C     tables for the convenience wrapper section.
125          
126    C     !USES:
127          implicit none
128    #include "mnc_common.h"
129    #include "SIZE.h"
130    #include "EEPARAMS.h"
131    #include "PARAMS.h"
132    
133    C     !INPUT PARAMETERS:
134          integer myThid
135    CEOP
136    
137    C     !LOCAL VARIABLES:
138          integer i,j, ntot
139          integer NBLNK
140          parameter ( NBLNK = 150 )
141          character s1*(NBLNK), blnk*(NBLNK)
142    
143          _BEGIN_MASTER(myThid)
144          
145          DO i = 1,NBLNK
146            blnk(i:i) = ' '
147          ENDDO
148          
149          s1(1:NBLNK) = blnk(1:NBLNK)
150          write(s1,'(a5,a)') 'MNC: ',
151         &     'The currently defined Grid Types are:'
152          CALL PRINT_MESSAGE(
153         &     s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
154          ntot = 0
155          DO j = 1,MNC_MAX_ID
156            IF (mnc_cw_gname(j)(1:MNC_MAX_CHAR)
157         &       .NE. mnc_blank_name(1:MNC_MAX_CHAR)) THEN
158              
159              ntot = ntot + 1
160              s1(1:NBLNK) = blnk(1:NBLNK)
161              write(s1,'(a5,2i5,a3,a20,i3,a3,5i4,a4,5i4,a4,5i4,6a8)')
162         &         'MNC: ',
163         &         j, ntot, ' : ', mnc_cw_gname(j)(1:20), mnc_cw_ndim(j),
164         &         ' : ', (mnc_cw_dims(i,j), i=1,5),
165         &         '  | ', (mnc_cw_is(i,j), i=1,5),
166         &         '  | ', (mnc_cw_ie(i,j), i=1,5),
167         &         '  | ', (mnc_cw_dn(i,j)(1:7), i=1,5)
168              CALL PRINT_MESSAGE(
169         &         s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
170              
171            ENDIF
172          ENDDO
173          
174          s1(1:NBLNK) = blnk(1:NBLNK)
175          write(s1,'(a5,a)') 'MNC: ',
176         &     'The currently defined Variable Types are:'
177          CALL PRINT_MESSAGE(
178         &     s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
179          ntot = 0
180          DO j = 1,MNC_MAX_ID
181            IF (mnc_cw_vname(j)(1:MNC_MAX_CHAR)
182         &       .NE. mnc_blank_name(1:MNC_MAX_CHAR)) THEN
183              
184              ntot = ntot + 1
185              s1(1:NBLNK) = blnk(1:NBLNK)
186              write(s1,'(a5,2i5,a3,a25,a3,i4)') 'MNC: ',
187         &         j, ntot, ' | ',
188         &         mnc_cw_vname(j)(1:20), ' | ', mnc_cw_vgind(j)
189              CALL PRINT_MESSAGE(
190         &         s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
191              
192              DO i = 1,mnc_cw_vnat(1,j)
193                s1(1:NBLNK) = blnk(1:NBLNK)
194                write(s1,'(a5,a14,i4,a3,a25,a3,a55)')
195         &           'MNC: ','      text_at:',i,
196         &           ' : ', mnc_cw_vtnm(i,j)(1:25), ' : ',
197         &           mnc_cw_vtat(i,j)(1:55)
198                CALL PRINT_MESSAGE(
199         &           s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
200              ENDDO
201              DO i = 1,mnc_cw_vnat(2,j)
202                s1(1:NBLNK) = blnk(1:NBLNK)
203                write(s1,'(a5,a14,i4,a3,a25,a3,i20)')
204         &           'MNC: ','      int__at:',i,
205         &           ' : ', mnc_cw_vinm(i,j)(1:25), ' : ',
206         &           mnc_cw_viat(i,j)
207                CALL PRINT_MESSAGE(
208         &           s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
209              ENDDO
210              DO i = 1,mnc_cw_vnat(3,j)
211                s1(1:NBLNK) = blnk(1:NBLNK)
212                write(s1,'(a5,a14,i4,a3,a25,a3,f25.10)')
213         &           'MNC: ','      dbl__at:',i,
214         &           ' : ', mnc_cw_vdnm(i,j)(1:25), ' : ',
215         &           mnc_cw_vdat(i,j)
216                CALL PRINT_MESSAGE(
217         &           s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
218            ENDDO
219            
220            ENDIF
221          ENDDO
222          IF (ntot .EQ. 0) THEN
223            s1(1:NBLNK) = blnk(1:NBLNK)
224            write(s1,'(a)') 'MNC:    None defined!'
225            CALL PRINT_MESSAGE(
226         &       s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
227          ENDIF
228          
229          _END_MASTER(myThid)
230    
231          RETURN
232          END
233    
234    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
235    CBOP 0
236    C     !ROUTINE: MNC_CW_INIT
237    
238    C     !INTERFACE:
239          SUBROUTINE MNC_CW_INIT(
240         I     sNx,sNy, OLx,OLy, nSx,nSy, nPx,nPy, Nr,
241         I     myThid )
242    
243    C     !DESCRIPTION:
244    C     Create the pre-defined grid types and variable types.
245    
246    C     The grid type is a character string that encodes the presence and
247    C     types associated with the four possible dimensions.  The character
248    C     string follows the format
249    C     \begin{center}
250    C       \texttt{H0\_H1\_H2\_\_V\_\_T}
251    C     \end{center}
252    C     where the terms \textit{H0}, \textit{H1}, \textit{H2}, \textit{V},
253    C     \textit{T} can be almost any combination of the following:
254    C     \begin{center}
255    C       \begin{tabular}[h]{|ccc|c|c|}\hline
256    C         \multicolumn{3}{|c|}{Horizontal} & Vertical & Time \\
257    C         \textit{H0}: location & \textit{H1}: dimensions & \textit{H2}: halo
258    C               & \textit{V}: location & \textit{T}: level  \\\hline
259    C         \texttt{-} & xy & Hn & \texttt{-} & \texttt{-} \\
260    C         U  &  x  &  Hy  &  i  &  t  \\
261    C         V  &  y  &      &  c  &     \\
262    C         Cen  &   &      &     &     \\
263    C         Cor  &   &      &     &     \\\hline
264    C       \end{tabular}
265    C     \end{center}
266    
267    
268    C     !USES:
269          implicit none
270    #include "mnc_common.h"
271    #include "EEPARAMS.h"
272    
273    C     !INPUT PARAMETERS:
274          integer myThid
275          integer sNx,sNy, OLx,OLy, nSx,nSy, nPx,nPy, Nr
276    CEOP
277    
278    C     !LOCAL VARIABLES:
279        integer CW_MAX_LOC        integer CW_MAX_LOC
280        parameter ( CW_MAX_LOC = 5 )        parameter ( CW_MAX_LOC = 5 )
281        integer i, ihorz,ihsub,ivert,itime,ihalo, is, n,ntot        integer i, ihorz,ihsub,ivert,itime,ihalo, is,ih, n,ntot
282        integer ndim        integer ndim, ncomb, nvch
       character*(MAX_LEN_MBUF) msgbuf  
283        character*(MNC_MAX_CHAR) name        character*(MNC_MAX_CHAR) name
284        character*(MNC_MAX_CHAR) dn(CW_MAX_LOC)        character*(MNC_MAX_CHAR) dn(CW_MAX_LOC)
285        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 119  C     Local Variables Line 287  C     Local Variables
287       &     halo_dat(CW_MAX_LOC)       &     halo_dat(CW_MAX_LOC)
288        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)
289    
290    C     Functions
291          integer ILNBLNK
292          external ILNBLNK
293    
294  C     ......12345....12345....12345....12345....12345...  C     ......12345....12345....12345....12345....12345...
295        data horz_dat /        data horz_dat /
296       &     '-    ', 'U    ', 'V    ', 'Cen  ', 'Cor  '  /       &     '-    ', 'U    ', 'V    ', 'Cen  ', 'Cor  '  /
297        data hsub_dat /        data hsub_dat /
298       &     'xy   ', 'x    ', 'y    ', '-    ', '     '  /       &     'xy   ', 'x    ', 'y    ', '-    ', '     '  /
299          data halo_dat /
300         &     'Hn   ', 'Hy   ', '--   ', '     ', '     '  /
301        data vert_dat /        data vert_dat /
302       &     '-    ', 'C    ', 'I    ', '     ', '     '  /       &     '-    ', 'C    ', 'I    ', '     ', '     '  /
303        data time_dat /        data time_dat /
304       &     '-    ', 't    ', '     ', '     ', '     '  /       &     '-    ', 't    ', '     ', '     ', '     '  /
       data halo_dat /  
      &     'Hn   ', 'Hy   ', '     ', '     ', '     '  /  
   
305    
306          ncomb = 0
307        DO ihorz = 1,5        DO ihorz = 1,5
308          DO is = 1,3          DO is = 1,3
309              DO ih = 1,2
310  C         Loop just ONCE if the Horiz component is "-"              
311            ihsub = is  C           Loop just ONCE if the Horiz component is "-"
312            IF (ihorz .EQ. 1) THEN              ihsub = is
313              IF (is .EQ. 1) THEN              ihalo = ih
314                ihsub = 4              IF (ihorz .EQ. 1) THEN
315              ELSE                IF ((is .EQ. 1) .AND. (ih .EQ. 1)) THEN
316                GOTO 10                  ihsub = 4
317                    ihalo = 3
318                  ELSE
319                    GOTO 10
320                  ENDIF
321              ENDIF              ENDIF
322            ENDIF              
323                DO ivert = 1,3
324            DO ivert = 1,3                DO itime = 1,2
325              DO itime = 1,2                  
               DO ihalo = 1,2  
   
326  C               horiz and hsub  C               horiz and hsub
327                  name(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)                  name(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)
328                  n = ILNBLNK(horz_dat(ihorz))                  n = ILNBLNK(horz_dat(ihorz))
# Line 159  C               horiz and hsub Line 333  C               horiz and hsub
333                  name((ntot+1):(ntot+n)) = hsub_dat(ihsub)(1:n)                  name((ntot+1):(ntot+n)) = hsub_dat(ihsub)(1:n)
334                  ntot = ntot + n                  ntot = ntot + n
335    
336  C               vert, time, and halo  C               halo, vert, and time
337                  write(name((ntot+1):(ntot+7)), '(5a1,a2)') '_',                  write(name((ntot+1):(ntot+5)), '(a1,2a2)')
338       &               vert_dat(ivert)(1:1), '_',       &               '_', halo_dat(ihalo)(1:2), '__'
339       &               time_dat(itime)(1:1), '_',                  nvch = ILNBLNK(vert_dat(ivert))
340       &               halo_dat(ihalo)(1:2)                  n = ntot+6+nvch-1
341                    name((ntot+6):(n)) = vert_dat(ivert)(1:nvch)
342                    write(name((n+1):(n+3)), '(a2,a1)')
343         &               '__', time_dat(itime)(1:1)
344    
345                  ndim = 0                  ndim = 0
346                  DO i = 1,CW_MAX_LOC                  DO i = 1,CW_MAX_LOC
347                    dn(i)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)                    dn(i)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)
348                    dim(i) = 0                    dim(i) = 0
349                      ib(i) = 0
350                      ie(i) = 0
351                  ENDDO                  ENDDO
352    
353  C               Horizontal dimensions  C               Horizontal dimensions
# Line 225  C               Horizontal dimensions Line 404  C               Horizontal dimensions
404                      dn(ndim)(1:3) = 'Ywh'                      dn(ndim)(1:3) = 'Ywh'
405                      dim(ndim) = sNy + 2*OLy                      dim(ndim) = sNy + 2*OLy
406                      ib(ndim)  = 1                      ib(ndim)  = 1
407                      ie(ndim)  = sNx + 2*OLx                      ie(ndim)  = sNy + 2*OLy
408                    ENDIF                    ENDIF
409    
410                  ENDIF                  ENDIF
# Line 255  C               Time dimension Line 434  C               Time dimension
434                    ie(ndim)  = 1                    ie(ndim)  = 1
435                  ENDIF                  ENDIF
436    
                 write(*,*) name(1:15), ndim, ' : ', (dim(i), i=1,5)  
   
437                  IF (ndim .GT. 0) THEN                  IF (ndim .GT. 0) THEN
438                    CALL MNC_CW_ADD_NAME(myThid, name, ndim,  #ifdef MNC_DEBUG
439       &                 dim, dn, ib, ie)                    ncomb = ncomb + 1
440                      write(*,'(i4,a3,a15,i3,a3,5i4,a4,5i4,a4,5i4,6a4)')
441         &                 ncomb, ' : ', name(1:15), ndim,
442         &                 ' : ', (dim(i), i=1,5),
443         &                 '  | ', (ib(i), i=1,5),
444         &                 '  | ', (ie(i), i=1,5),
445         &                 '  | ', (dn(i)(1:4), i=1,5)
446    #endif
447    
448                      CALL MNC_CW_ADD_GNAME(name, ndim,
449         &                 dim, dn, ib, ie, myThid)
450                  ENDIF                  ENDIF
451    
452                ENDDO                ENDDO
453              ENDDO              ENDDO
           ENDDO  
454    
455   10       CONTINUE   10         CONTINUE
456              ENDDO
457          ENDDO          ENDDO
458        ENDDO        ENDDO
459                
460        RETURN        RETURN
461        END        END
462    
463    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
464    CBOP 0
465    C     !ROUTINE: MNC_CW_APPEND_VNAME
466    
467    C     !INTERFACE:
468          SUBROUTINE MNC_CW_APPEND_VNAME(
469         I     vname,
470         I     gname,
471         I     bi_dim, bj_dim,
472         I     myThid )
473    
474    C     !DESCRIPTION:
475    C     If it is not yet defined within the MNC CW layer, append a
476    C     variable type.  Calls MNC\_CW\_ADD\_VNAME().
477      
478    C     !USES:
479          implicit none
480    #include "mnc_common.h"
481    
482    C     !INPUT PARAMETERS:
483          integer myThid, bi_dim, bj_dim
484          character*(*) vname, gname
485    CEOP
486    
487    C     !LOCAL VARIABLES:
488          integer indv
489    
490    C     Check whether vname is defined
491          CALL MNC_GET_IND(MNC_MAX_ID, vname, mnc_cw_vname, indv, myThid)
492          IF (indv .LT. 1) THEN
493            CALL MNC_CW_ADD_VNAME(vname, gname, bi_dim, bj_dim, myThid)
494          ENDIF
495    
496    
497          RETURN
498          END
499    
500    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
501    CBOP 0
502    C     !ROUTINE: MNC_CW_ADD_VNAME
503    
504    C     !INTERFACE:
505          SUBROUTINE MNC_CW_ADD_VNAME(
506         I     vname,
507         I     gname,
508         I     bi_dim, bj_dim,
509         I     myThid )
510    
511    C     !DESCRIPTION:
512    C     Add a variable type to the MNC CW layer.  The variable type is an
513    C     association between a variable type name and the following items:
514    C     \begin{center}
515    C       \begin{tabular}[h]{|ll|}\hline
516    C         \textbf{Item}  & \textbf{Purpose}  \\\hline
517    C         grid type  &  defines the in-memory arrangement  \\
518    C         \texttt{bi,bj} dimensions  &  tiling indices, if present  \\\hline
519    C       \end{tabular}
520    C     \end{center}
521      
522    C     !USES:
523          implicit none
524    #include "mnc_common.h"
525    #include "EEPARAMS.h"
526    
527    C     !INPUT PARAMETERS:
528          integer myThid, bi_dim, bj_dim
529          character*(*) vname, gname
530    CEOP
531    
532    C     !LOCAL VARIABLES:
533          integer i, nvf,nvl, ngf,ngl, indv,indg
534          character*(MAX_LEN_MBUF) msgbuf
535    
536    C     Functions
537          integer IFNBLNK, ILNBLNK
538    
539          nvf = IFNBLNK(vname)
540          nvl = ILNBLNK(vname)
541          ngf = IFNBLNK(gname)
542          ngl = ILNBLNK(gname)
543    
544    C     Check that this vname is not already defined
545          CALL MNC_GET_IND(MNC_MAX_ID, vname, mnc_cw_vname, indv, myThid)
546          IF (indv .GT. 0) THEN
547            write(msgbuf,'(3a)') 'MNC_CW_ADD_VNAME ERROR: ''',
548         &       vname(nvf:nvl), ''' is already defined'
549            CALL print_error(msgbuf, mythid)
550            stop 'ABNORMAL END: S/R MNC_CW_ADD_VNAME'
551          ENDIF
552          CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID, mnc_cw_vname,
553         &     indv, myThid)
554    
555    C     Check that gname exists
556          CALL MNC_GET_IND(MNC_MAX_ID, gname, mnc_cw_gname, indg, myThid)
557          IF (indg .LT. 1) THEN
558            write(msgbuf,'(3a)') 'MNC_CW_ADD_VNAME ERROR: ''',
559         &       gname(ngf:ngl), ''' is not defined'
560            CALL print_error(msgbuf, mythid)
561            stop 'ABNORMAL END: S/R MNC_CW_ADD_VNAME'
562          ENDIF
563    
564          mnc_cw_vname(indv)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)
565          mnc_cw_vname(indv)(1:(nvl-nvf+1)) = vname(nvf:nvl)
566          mnc_cw_vgind(indv) = indg
567          DO i = 1,3
568            mnc_cw_vnat(i,indv) = 0
569          ENDDO
570          mnc_cw_vbij(1,indv) = bi_dim
571          mnc_cw_vbij(2,indv) = bj_dim
572    
573    #ifdef MNC_DEBUG_GTYPE
574          CALL MNC_CW_ADD_VATTR_TEXT(vname,1,'mitgcm_grid',gname, myThid)
575    #endif
576    
577          RETURN
578          END
579    
580    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
581    CBOP 0
582    C     !ROUTINE: MNC_CW_DEL_VNAME
583    
584    C     !INTERFACE:
585          SUBROUTINE MNC_CW_DEL_VNAME(
586         I     vname,
587         I     myThid )
588    
589    C     !DESCRIPTION:
590    C     Delete a variable type from the MNC CW layer.
591      
592    C     !USES:
593          implicit none
594    #include "mnc_common.h"
595    #include "EEPARAMS.h"
596    
597    C     !INPUT PARAMETERS:
598          integer myThid
599          character*(*) vname
600    CEOP
601    
602    C     !LOCAL VARIABLES:
603          integer i, indv
604    
605    C     Check that this vname is not already defined
606          CALL MNC_GET_IND(MNC_MAX_ID, vname, mnc_cw_vname, indv, myThid)
607          IF (indv .LT. 1) THEN
608            RETURN
609          ENDIF
610    
611          mnc_cw_vname(indv)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)
612          mnc_cw_vgind(indv) = 0
613          DO i = 1,3
614            mnc_cw_vnat(i,indv) = 0
615          ENDDO
616    
617          RETURN
618          END
619    
620    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
621    CBOP 0
622    C     !ROUTINE: MNC_CW_ADD_VATTR_TEXT
623    
624    C     !INTERFACE:
625          SUBROUTINE MNC_CW_ADD_VATTR_TEXT(
626         I     vname,
627         I     tname,
628         I     tval,
629         I     myThid )
630    
631    C     !DESCRIPTION:
632    C     Add a text attribute
633          
634    C     !USES:
635          implicit none
636    
637    C     !INPUT PARAMETERS:
638          integer myThid
639          character*(*) vname, tname, tval
640    CEOP
641    
642          CALL MNC_CW_ADD_VATTR_ANY(vname,
643         &     tname, ' ', ' ',
644         &     tval, 0, 0.0D0, myThid )
645    
646          RETURN
647          END
648    
649    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
650    CBOP
651    C     !ROUTINE: MNC_CW_ADD_VATTR_INT
652    
653    C     !INTERFACE:
654          SUBROUTINE MNC_CW_ADD_VATTR_INT(
655         I     vname,
656         I     iname,
657         I     ival,
658         I     myThid )
659    
660    C     !DESCRIPTION:
661    
662    C     !USES:
663          implicit none
664    
665    C     !INPUT PARAMETERS:
666          integer myThid
667          character*(*) vname, iname
668          integer ival
669    CEOP
670    
671          CALL MNC_CW_ADD_VATTR_ANY(vname,
672         &     ' ', iname, ' ',
673         &     ' ', ival, 0.0D0, myThid )
674    
675          RETURN
676          END
677    
678    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
679    CBOP 0
680    C !ROUTINE: MNC_CW_ADD_VATTR_DBL
681    
682    C !INTERFACE:
683          SUBROUTINE MNC_CW_ADD_VATTR_DBL(
684         I     vname,
685         I     dname,
686         I     dval,
687         I     myThid )
688    
689    C     !DESCRIPTION:
690    
691    C     !USES:
692          implicit none
693    
694    C     !INPUT PARAMETERS:
695          integer myThid
696          character*(*) vname, dname
697          REAL*8 dval
698    CEOP
699    
700          CALL MNC_CW_ADD_VATTR_ANY(vname,
701         &     ' ', ' ', dname,
702         &     ' ', 0, dval, myThid )
703    
704          RETURN
705          END
706    
707    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
708    CBOP 1
709    C     !ROUTINE: MNC_CW_ADD_VATTR_ANY
710    
711    C     !INTERFACE:
712          SUBROUTINE MNC_CW_ADD_VATTR_ANY(
713         I     vname,
714         I     tname, iname, dname,
715         I     tval,  ival,  dval,
716         I     myThid )
717    
718    C     !DESCRIPTION:
719    
720    C     !USES:
721          implicit none
722    #include "mnc_common.h"
723    #include "EEPARAMS.h"
724    
725    C     !INPUT PARAMETERS:
726          integer myThid
727          character*(*) vname
728          character*(*) tname, iname, dname
729          character*(*) tval
730          integer ival
731          REAL*8 dval
732    CEOP
733    
734    C     !LOCAL VARIABLES:
735          integer n, nvf,nvl, n1,n2, indv
736          character*(MAX_LEN_MBUF) msgbuf
737    
738    C     Functions
739          integer IFNBLNK, ILNBLNK
740    
741          nvf = IFNBLNK(vname)
742          nvl = ILNBLNK(vname)
743    
744    C     Check that vname is defined
745          CALL MNC_GET_IND(MNC_MAX_ID, vname, mnc_cw_vname, indv, myThid)
746          IF (indv .LT. 1) THEN
747            write(msgbuf,'(3a)') 'MNC_CW_ADD_VATTR_ANY ERROR: ''',
748         &       vname(nvf:nvl), ''' is not defined'
749            CALL print_error(msgbuf, mythid)
750            stop 'ABNORMAL END: S/R MNC_CW_ADD_VATTR_ANY'
751          ENDIF
752    
753    C     Text Attributes
754          n = mnc_cw_vnat(1,indv)
755          n1 = IFNBLNK(tname)
756          n2 = ILNBLNK(tname)
757          mnc_cw_vtnm(n+1,indv)(1:MNC_MAX_CHAR) =
758         &     mnc_blank_name(1:MNC_MAX_CHAR)
759          mnc_cw_vtnm(n+1,indv)(1:(n2-n1+1)) = tname(n1:n2)
760          n1 = IFNBLNK(tval)
761          n2 = ILNBLNK(tval)
762          mnc_cw_vtat(n+1,indv)(1:MNC_MAX_CHAR) =
763         &       mnc_blank_name(1:MNC_MAX_CHAR)
764          mnc_cw_vtat(n+1,indv)(1:(n2-n1+1)) = tval(n1:n2)
765          mnc_cw_vnat(1,indv) = n + 1
766          
767    C     Integer Attributes
768          n = mnc_cw_vnat(2,indv)
769          n1 = IFNBLNK(iname)
770          n2 = ILNBLNK(iname)
771          mnc_cw_vinm(n+1,indv)(1:(n2-n1+1)) = iname(n1:n2)
772          mnc_cw_viat(n+1,indv) = ival
773          mnc_cw_vnat(2,indv) = n + 1
774    
775    C     Double Attributes
776          n = mnc_cw_vnat(3,indv)
777          n1 = IFNBLNK(dname)
778          n2 = ILNBLNK(dname)
779          mnc_cw_vdnm(n+1,indv)(1:(n2-n1+1)) = dname(n1:n2)
780          mnc_cw_vdat(n+1,indv) = dval
781          mnc_cw_vnat(3,indv) = n + 1
782          
783          RETURN
784          END
785    
786    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
787    CBOP 1
788    C     !ROUTINE: MNC_CW_GET_TILE_NUM
789    
790    C     !INTERFACE:
791          SUBROUTINE MNC_CW_GET_TILE_NUM(
792         I     bi, bj,
793         O     uniq_tnum,
794         I     myThid )
795    
796    C     !DESCRIPTION:
797    
798    C     !USES:
799          implicit none
800    #include "EEPARAMS.h"
801    #include "SIZE.h"
802    #ifdef ALLOW_EXCH2
803    #include "W2_EXCH2_TOPOLOGY.h"
804    #include "W2_EXCH2_PARAMS.h"
805    #endif
806    
807    C     !INPUT PARAMETERS:
808          integer myThid, bi,bj, uniq_tnum
809    CEOP
810    
811    C     !LOCAL VARIABLES:
812          integer iG,jG
813    
814          iG = 0
815          jG = 0
816    
817    #ifdef ALLOW_EXCH2
818    
819          uniq_tnum = W2_myTileList(bi)
820    
821    #else
822    
823    C     Global tile number for simple (non-cube) domains
824          iG = bi+(myXGlobalLo-1)/sNx
825          jG = bj+(myYGlobalLo-1)/sNy
826    
827          uniq_tnum = (jG - 1)*(nPx*nSx) + iG
828    
829    #endif
830    
831    CEH3      write(*,*) 'iG,jG,uniq_tnum :', iG,jG,uniq_tnum
832    
833          RETURN
834          END
835    
836    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
837    CBOP 1
838    C     !ROUTINE: MNC_CW_FILE_AORC
839          
840    C     !INTERFACE:
841          SUBROUTINE MNC_CW_FILE_AORC(
842         I     fname,
843         O     indf,
844         I     myThid )
845    
846    C     !DESCRIPTION:
847    C     Open a NetCDF file, appending to the file if it already exists
848    C     and, if not, creating a new file.
849    
850    C     !USES:
851          implicit none
852    #include "netcdf.inc"
853    #include "mnc_common.h"
854    #include "EEPARAMS.h"
855    
856    C     !INPUT PARAMETERS:
857          integer myThid, indf
858          character*(*) fname
859    CEOP
860    
861    C     !LOCAL VARIABLES:
862          integer ierr
863    
864    C     Check if the file is already open
865          CALL MNC_GET_IND(MNC_MAX_ID, fname, mnc_f_names, indf, myThid)
866          IF (indf .GT. 0) THEN
867            RETURN
868          ENDIF
869    
870    C     Try to open an existing file
871          CALL MNC_FILE_TRY_READ(fname, ierr, indf, myThid)
872          IF (ierr .EQ. NF_NOERR) THEN
873            RETURN
874          ENDIF
875    
876    C     Try to create a new one
877          CALL MNC_FILE_OPEN(fname, 0, indf, myThid)
878    
879          RETURN
880          END
881    
882  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
883    
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.19
  ViewVC Help
Powered by ViewVC 1.1.22