/[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.11 by edhill, Mon Mar 29 03:33:51 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
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(*), inds_beg(*), inds_end(*)
31        character*(*) dnames(*)        character*(*) dnames(*)
32    
33  C     Local Variables  C     !LOCAL VARIABLES:
34        integer i, nnf,nnl, indg        integer i, nnf,nnl, indg
35        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
36    CEOP
37    C     Functions
38          integer IFNBLNK, ILNBLNK
39    
40        nnf = IFNBLNK(name)        nnf = IFNBLNK(name)
41        nnl = ILNBLNK(name)        nnl = ILNBLNK(name)
42    
43  C     Check that this name is not already defined  C     Check that this name is not already defined
44        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)
45        IF (indg .GT. 0) THEN        IF (indg .GT. 0) THEN
46          write(msgbuf,'(3a)') 'MNC_CW_ADD_NAME ERROR: ''', name,          write(msgbuf,'(3a)') 'MNC_CW_ADD_GNAME ERROR: ''', name,
47       &       ''' is already defined'       &       ''' is already defined'
48          CALL print_error(msgbuf, mythid)          CALL print_error(msgbuf, mythid)
49          stop 'ABNORMAL END: S/R MNC_CW_ADD_NAME'          stop 'ABNORMAL END: S/R MNC_CW_ADD_GNAME'
50        ENDIF        ENDIF
51        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,
52       &     indg)       &     indg, myThid)
53    
54        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)
55        mnc_cw_names(indg)(1:(nnl-nnf+1)) = name(nnf:nnl)        mnc_cw_gname(indg)(1:(nnl-nnf+1)) = name(nnf:nnl)
56        mnc_cw_ndim(indg) = ndim        mnc_cw_ndim(indg) = ndim
57    
58        DO i = 1,ndim        DO i = 1,ndim
# Line 88  C     Check that this name is not alread Line 68  C     Check that this name is not alread
68        RETURN        RETURN
69        END        END
70    
71    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
72    CBOP
73    C     !ROUTINE: MNC_CW_DUMP
74    
75    C     !INTERFACE:
76          SUBROUTINE MNC_CW_DUMP( myThid )
77    
78    C     !DESCRIPTION:
79    C     Write a condensed view of the current state of the MNC look-up
80    C     tables for the convenience wrapper section.
81          
82    C     !USES:
83          implicit none
84    #include "mnc_common.h"
85    #include "SIZE.h"
86    #include "EEPARAMS.h"
87    #include "PARAMS.h"
88    
89    C     !INPUT PARAMETERS:
90          integer myThid
91    
92    C     !LOCAL VARIABLES:
93          integer i,j, ntot
94          integer NBLNK
95          parameter ( NBLNK = 150 )
96          character s1*(NBLNK), blnk*(NBLNK)
97    CEOP
98    
99          _BEGIN_MASTER(myThid)
100          
101          DO i = 1,NBLNK
102            blnk(i:i) = ' '
103          ENDDO
104          
105          s1(1:NBLNK) = blnk(1:NBLNK)
106          write(s1,'(a5,a)') 'MNC: ',
107         &     'The currently defined Grid Types are:'
108          CALL PRINT_MESSAGE(
109         &     s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
110          ntot = 0
111          DO j = 1,MNC_MAX_ID
112            IF (mnc_cw_gname(j)(1:MNC_MAX_CHAR)
113         &       .NE. mnc_blank_name(1:MNC_MAX_CHAR)) THEN
114              
115              ntot = ntot + 1
116              s1(1:NBLNK) = blnk(1:NBLNK)
117              write(s1,'(a5,2i5,a3,a20,i3,a3,5i4,a4,5i4,a4,5i4,6a4)')
118         &         'MNC: ',
119         &         j, ntot, ' : ', mnc_cw_gname(j)(1:20), mnc_cw_ndim(j),
120         &         ' : ', (mnc_cw_dims(i,j), i=1,5),
121         &         '  | ', (mnc_cw_is(i,j), i=1,5),
122         &         '  | ', (mnc_cw_ie(i,j), i=1,5),
123         &         '  | ', (mnc_cw_dn(i,j)(1:4), i=1,5)
124              CALL PRINT_MESSAGE(
125         &         s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
126              
127            ENDIF
128          ENDDO
129          
130          s1(1:NBLNK) = blnk(1:NBLNK)
131          write(s1,'(a5,a)') 'MNC: ',
132         &     'The currently defined Variable Types are:'
133          CALL PRINT_MESSAGE(
134         &     s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
135          ntot = 0
136          DO j = 1,MNC_MAX_ID
137            IF (mnc_cw_vname(j)(1:MNC_MAX_CHAR)
138         &       .NE. mnc_blank_name(1:MNC_MAX_CHAR)) THEN
139              
140              ntot = ntot + 1
141              s1(1:NBLNK) = blnk(1:NBLNK)
142              write(s1,'(a5,2i5,a3,a25,a3,i4)') 'MNC: ',
143         &         j, ntot, ' | ',
144         &         mnc_cw_vname(j)(1:20), ' | ', mnc_cw_vgind(j)
145              CALL PRINT_MESSAGE(
146         &         s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
147              
148              DO i = 1,mnc_cw_vnat(1,j)
149                s1(1:NBLNK) = blnk(1:NBLNK)
150                write(s1,'(a5,a14,i4,a3,a25,a3,a55)')
151         &           'MNC: ','      text_at:',i,
152         &           ' : ', mnc_cw_vtnm(i,j)(1:25), ' : ',
153         &           mnc_cw_vtat(i,j)(1:55)
154                CALL PRINT_MESSAGE(
155         &           s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
156              ENDDO
157              DO i = 1,mnc_cw_vnat(2,j)
158                s1(1:NBLNK) = blnk(1:NBLNK)
159                write(s1,'(a5,a14,i4,a3,a25,a3,i20)')
160         &           'MNC: ','      int__at:',i,
161         &           ' : ', mnc_cw_vinm(i,j)(1:25), ' : ',
162         &           mnc_cw_viat(i,j)
163                CALL PRINT_MESSAGE(
164         &           s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
165              ENDDO
166              DO i = 1,mnc_cw_vnat(3,j)
167                s1(1:NBLNK) = blnk(1:NBLNK)
168                write(s1,'(a5,a14,i4,a3,a25,a3,f25.10)')
169         &           'MNC: ','      dbl__at:',i,
170         &           ' : ', mnc_cw_vdnm(i,j)(1:25), ' : ',
171         &           mnc_cw_vdat(i,j)
172                CALL PRINT_MESSAGE(
173         &           s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
174            ENDDO
175            
176            ENDIF
177          ENDDO
178          IF (ntot .EQ. 0) THEN
179            s1(1:NBLNK) = blnk(1:NBLNK)
180            write(s1,'(a)') 'MNC:    None defined!'
181            CALL PRINT_MESSAGE(
182         &       s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
183          ENDIF
184          
185          _END_MASTER(myThid)
186    
187          RETURN
188          END
189    
190  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
191    CBOP
192    C     !ROUTINE: MNC_CW_INIT
193    
194    C     !INTERFACE:
195        SUBROUTINE MNC_CW_INIT(        SUBROUTINE MNC_CW_INIT(
196       I     myThid,       I     sNx,sNy, OLx,OLy, nSx,nSy, nPx,nPy, Nr,
197       I     sNx,sNy, OLx,OLy, nSx,nSy, nPx,nPy, Nr )       I     myThid )
198    
199    C     !DESCRIPTION:
200    C     Create the pre-defined grid types and variable types
201          
202    C     !USES:
203        implicit none        implicit none
204  #include "mnc_common.h"  #include "mnc_common.h"
205  #include "EEPARAMS.h"  #include "EEPARAMS.h"
206    
207  C     Arguments  C     !INPUT PARAMETERS:
208        integer myThid        integer myThid
209        integer sNx,sNy, OLx,OLy, nSx,nSy, nPx,nPy, Nr        integer sNx,sNy, OLx,OLy, nSx,nSy, nPx,nPy, Nr
210    
211  C     Functions  C     !LOCAL VARIABLES:
       integer IFNBLNK, ILNBLNK  
   
 C     Local Variables  
212        integer CW_MAX_LOC        integer CW_MAX_LOC
213        parameter ( CW_MAX_LOC = 5 )        parameter ( CW_MAX_LOC = 5 )
214        integer i, ihorz,ihsub,ivert,itime,ihalo, is, n,ntot        integer i, ihorz,ihsub,ivert,itime,ihalo, is,ih, n,ntot
215        integer ndim        integer ndim, ncomb
216        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
217        character*(MNC_MAX_CHAR) name        character*(MNC_MAX_CHAR) name
218        character*(MNC_MAX_CHAR) dn(CW_MAX_LOC)        character*(MNC_MAX_CHAR) dn(CW_MAX_LOC)
# Line 118  C     Local Variables Line 220  C     Local Variables
220       &     vert_dat(CW_MAX_LOC), time_dat(CW_MAX_LOC),       &     vert_dat(CW_MAX_LOC), time_dat(CW_MAX_LOC),
221       &     halo_dat(CW_MAX_LOC)       &     halo_dat(CW_MAX_LOC)
222        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)
223    CEOP
224    C     Functions
225          integer IFNBLNK, ILNBLNK
226    
227  C     ......12345....12345....12345....12345....12345...  C     ......12345....12345....12345....12345....12345...
228        data horz_dat /        data horz_dat /
229       &     '-    ', 'U    ', 'V    ', 'Cen  ', 'Cor  '  /       &     '-    ', 'U    ', 'V    ', 'Cen  ', 'Cor  '  /
230        data hsub_dat /        data hsub_dat /
231       &     'xy   ', 'x    ', 'y    ', '-    ', '     '  /       &     'xy   ', 'x    ', 'y    ', '-    ', '     '  /
232          data halo_dat /
233         &     'Hn   ', 'Hy   ', '--   ', '     ', '     '  /
234        data vert_dat /        data vert_dat /
235       &     '-    ', 'C    ', 'I    ', '     ', '     '  /       &     '-    ', 'C    ', 'I    ', '     ', '     '  /
236        data time_dat /        data time_dat /
237       &     '-    ', 't    ', '     ', '     ', '     '  /       &     '-    ', 't    ', '     ', '     ', '     '  /
       data halo_dat /  
      &     'Hn   ', 'Hy   ', '     ', '     ', '     '  /  
   
238    
239          ncomb = 0
240        DO ihorz = 1,5        DO ihorz = 1,5
241          DO is = 1,3          DO is = 1,3
242              DO ih = 1,2
243  C         Loop just ONCE if the Horiz component is "-"              
244            ihsub = is  C           Loop just ONCE if the Horiz component is "-"
245            IF (ihorz .EQ. 1) THEN              ihsub = is
246              IF (is .EQ. 1) THEN              ihalo = ih
247                ihsub = 4              IF (ihorz .EQ. 1) THEN
248              ELSE                IF ((is .EQ. 1) .AND. (ih .EQ. 1)) THEN
249                GOTO 10                  ihsub = 4
250                    ihalo = 3
251                  ELSE
252                    GOTO 10
253                  ENDIF
254              ENDIF              ENDIF
255            ENDIF              
256                DO ivert = 1,3
257            DO ivert = 1,3                DO itime = 1,2
258              DO itime = 1,2                  
               DO ihalo = 1,2  
   
259  C               horiz and hsub  C               horiz and hsub
260                  name(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)                  name(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)
261                  n = ILNBLNK(horz_dat(ihorz))                  n = ILNBLNK(horz_dat(ihorz))
# Line 160  C               horiz and hsub Line 267  C               horiz and hsub
267                  ntot = ntot + n                  ntot = ntot + n
268    
269  C               vert, time, and halo  C               vert, time, and halo
270                  write(name((ntot+1):(ntot+7)), '(5a1,a2)') '_',                  write(name((ntot+1):(ntot+9)), '(a1,2a2,a1,a2,a1)')
271       &               vert_dat(ivert)(1:1), '_',       &               '_', halo_dat(ihalo)(1:2), '__',
272       &               time_dat(itime)(1:1), '_',       &               vert_dat(ivert)(1:1), '__',
273       &               halo_dat(ihalo)(1:2)       &               time_dat(itime)(1:1)
274    
275                  ndim = 0                  ndim = 0
276                  DO i = 1,CW_MAX_LOC                  DO i = 1,CW_MAX_LOC
277                    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)
278                    dim(i) = 0                    dim(i) = 0
279                      ib(i) = 0
280                      ie(i) = 0
281                  ENDDO                  ENDDO
282    
283  C               Horizontal dimensions  C               Horizontal dimensions
# Line 225  C               Horizontal dimensions Line 334  C               Horizontal dimensions
334                      dn(ndim)(1:3) = 'Ywh'                      dn(ndim)(1:3) = 'Ywh'
335                      dim(ndim) = sNy + 2*OLy                      dim(ndim) = sNy + 2*OLy
336                      ib(ndim)  = 1                      ib(ndim)  = 1
337                      ie(ndim)  = sNx + 2*OLx                      ie(ndim)  = sNy + 2*OLy
338                    ENDIF                    ENDIF
339    
340                  ENDIF                  ENDIF
# Line 255  C               Time dimension Line 364  C               Time dimension
364                    ie(ndim)  = 1                    ie(ndim)  = 1
365                  ENDIF                  ENDIF
366    
                 write(*,*) name(1:15), ndim, ' : ', (dim(i), i=1,5)  
   
367                  IF (ndim .GT. 0) THEN                  IF (ndim .GT. 0) THEN
368                    CALL MNC_CW_ADD_NAME(myThid, name, ndim,  #ifdef MNC_DEBUG
369       &                 dim, dn, ib, ie)                    ncomb = ncomb + 1
370                      write(*,'(i4,a3,a15,i3,a3,5i4,a4,5i4,a4,5i4,6a4)')
371         &                 ncomb, ' : ', name(1:15), ndim,
372         &                 ' : ', (dim(i), i=1,5),
373         &                 '  | ', (ib(i), i=1,5),
374         &                 '  | ', (ie(i), i=1,5),
375         &                 '  | ', (dn(i)(1:4), i=1,5)
376    #endif
377    
378                      CALL MNC_CW_ADD_GNAME(name, ndim,
379         &                 dim, dn, ib, ie, myThid)
380                  ENDIF                  ENDIF
381    
382                ENDDO                ENDDO
383              ENDDO              ENDDO
           ENDDO  
384    
385   10       CONTINUE   10         CONTINUE
386              ENDDO
387          ENDDO          ENDDO
388        ENDDO        ENDDO
389                
390        RETURN        RETURN
391        END        END
392    
393    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
394    CBOP
395    C     !ROUTINE: MNC_CW_ADD_VNAME
396    
397    C     !INTERFACE:
398          SUBROUTINE MNC_CW_ADD_VNAME(
399         I     vname,
400         I     gname,
401         I     bi_dim, bj_dim,
402         I     myThid )
403    
404    C     !DESCRIPTION:
405    C     Add a variable type.
406          
407    C     !USES:
408          implicit none
409    #include "mnc_common.h"
410    #include "EEPARAMS.h"
411    
412    C     !INPUT PARAMETERS:
413          integer myThid, bi_dim, bj_dim
414          character*(*) vname, gname
415    
416    C     !LOCAL VARIABLES:
417          integer i, nvf,nvl, ngf,ngl, indv,indg
418          character*(MAX_LEN_MBUF) msgbuf
419    CEOP
420    C     Functions
421          integer IFNBLNK, ILNBLNK
422    
423          nvf = IFNBLNK(vname)
424          nvl = ILNBLNK(vname)
425          ngf = IFNBLNK(gname)
426          ngl = ILNBLNK(gname)
427    
428    C     Check that this vname is not already defined
429          CALL MNC_GET_IND(MNC_MAX_ID, vname, mnc_cw_vname, indv, myThid)
430          IF (indv .GT. 0) THEN
431            write(msgbuf,'(3a)') 'MNC_CW_ADD_VNAME ERROR: ''',
432         &       vname(nvf:nvl), ''' is already defined'
433            CALL print_error(msgbuf, mythid)
434            stop 'ABNORMAL END: S/R MNC_CW_ADD_VNAME'
435          ENDIF
436          CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID, mnc_cw_vname,
437         &     indv, myThid)
438    
439    C     Check that gname exists
440          CALL MNC_GET_IND(MNC_MAX_ID, gname, mnc_cw_gname, indg, myThid)
441          IF (indg .LT. 1) THEN
442            write(msgbuf,'(3a)') 'MNC_CW_ADD_VNAME ERROR: ''',
443         &       gname(ngf:ngl), ''' is not defined'
444            CALL print_error(msgbuf, mythid)
445            stop 'ABNORMAL END: S/R MNC_CW_ADD_VNAME'
446          ENDIF
447    
448          mnc_cw_vname(indv)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)
449          mnc_cw_vname(indv)(1:(nvl-nvf+1)) = vname(nvf:nvl)
450          mnc_cw_vgind(indv) = indg
451          DO i = 1,3
452            mnc_cw_vnat(i,indv) = 0
453          ENDDO
454          mnc_cw_vbij(1,indv) = bi_dim
455          mnc_cw_vbij(2,indv) = bj_dim
456    
457          CALL MNC_CW_ADD_VATTR_TEXT(vname,1,'mitgcm_grid',gname, myThid)
458    
459          RETURN
460          END
461    
462    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
463    CBOP
464    C     !ROUTINE: MNC_CW_ADD_VATTR_TEXT
465    
466    C     !INTERFACE:
467          SUBROUTINE MNC_CW_ADD_VATTR_TEXT(
468         I     vname,
469         I     ntat,
470         I     tnames,
471         I     tvals,
472         I     myThid )
473    
474    C     !DESCRIPTION:
475    C     Add a text attribute
476          
477    C     !USES:
478          implicit none
479    
480    C     !INPUT PARAMETERS:
481          integer myThid, ntat
482          character*(*) vname, tnames(*), tvals(*)
483    CEOP
484    
485          CALL MNC_CW_ADD_VATTR_ANY(vname,
486         &     ntat, 0, 0,
487         &     tnames, ' ', ' ',
488         &     tvals, 0, 0.0D0, myThid )
489    
490          RETURN
491          END
492    
493    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
494    CBOP
495    C     !ROUTINE: MNC_CW_ADD_VATTR_INT
496    
497    C     !INTERFACE:
498          SUBROUTINE MNC_CW_ADD_VATTR_INT(
499         I     vname,
500         I     niat,
501         I     inames,
502         I     ivals,
503         I     myThid )
504    
505    C     !DESCRIPTION:
506    
507    C     !USES:
508          implicit none
509    
510    C     !INPUT PARAMETERS:
511          integer myThid, niat
512          character*(*) vname, inames(*)
513          integer ivals(*)
514    CEOP
515    
516          CALL MNC_CW_ADD_VATTR_ANY(vname,
517         &     0, niat, 0,
518         &     ' ', inames, ' ',
519         &     ' ', ivals, 0.0D0, myThid )
520    
521          RETURN
522          END
523    
524    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
525    CBOP
526    C !ROUTINE: MNC_CW_ADD_VATTR_DBL
527    
528    C !INTERFACE:
529          SUBROUTINE MNC_CW_ADD_VATTR_DBL(
530         I     vname,
531         I     ndat,
532         I     dnames,
533         I     dvals,
534         I     myThid )
535    
536    C     !DESCRIPTION:
537    
538    C     !USES:
539          implicit none
540    
541    C     !INPUT PARAMETERS:
542          integer myThid, ndat
543          character*(*) vname, dnames(*)
544          REAL*8 dvals(*)
545    CEOP
546    
547          CALL MNC_CW_ADD_VATTR_ANY(vname,
548         &     0, 0, ndat,
549         &     ' ', ' ', dnames,
550         &     ' ', 0, dvals, myThid )
551    
552          RETURN
553          END
554    
555    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
556    CBOP
557    C     !ROUTINE: MNC_CW_ADD_VATTR_ANY
558    
559    C     !INTERFACE:
560          SUBROUTINE MNC_CW_ADD_VATTR_ANY(
561         I     vname,
562         I     ntat,   niat,   ndat,
563         I     tnames, inames, dnames,
564         I     tvals,  ivals,  dvals,
565         I     myThid )
566    
567    C     !DESCRIPTION:
568    
569    C     !USES:
570          implicit none
571    #include "mnc_common.h"
572    #include "EEPARAMS.h"
573    
574    C     !INPUT PARAMETERS:
575          integer myThid, ntat, niat, ndat
576          character*(*) vname
577          character*(*) tnames(*), inames(*), dnames(*)
578          character*(*) tvals(*)
579          integer ivals(*)
580          REAL*8 dvals(*)
581    
582    C     !LOCAL VARIABLES:
583          integer i, n, nvf,nvl, n1,n2, indv
584          character*(MAX_LEN_MBUF) msgbuf
585    CEOP
586    C     Functions
587          integer IFNBLNK, ILNBLNK
588    
589          nvf = IFNBLNK(vname)
590          nvl = ILNBLNK(vname)
591    
592    C     Check that vname is defined
593          CALL MNC_GET_IND(MNC_MAX_ID, vname, mnc_cw_vname, indv, myThid)
594          IF (indv .LT. 1) THEN
595            write(msgbuf,'(3a)') 'MNC_CW_ADD_VATTR_ANY ERROR: ''',
596         &       vname(nvf:nvl), ''' is not defined'
597            CALL print_error(msgbuf, mythid)
598            stop 'ABNORMAL END: S/R MNC_CW_ADD_VATTR_ANY'
599          ENDIF
600    
601    C     Text Attributes
602          n = mnc_cw_vnat(1,indv)
603          DO i = 1,ntat
604            n1 = IFNBLNK(tnames(i))
605            n2 = ILNBLNK(tnames(i))
606            mnc_cw_vtnm(n+i,indv)(1:(n2-n1+1)) = tnames(i)(n1:n2)
607            n1 = IFNBLNK(tvals(i))
608            n2 = ILNBLNK(tvals(i))
609            mnc_cw_vtat(n+i,indv)(1:(n2-n1+1)) = tvals(i)(n1:n2)
610          ENDDO
611          mnc_cw_vnat(1,indv) = n + ntat
612    
613    C     Integer Attributes
614          n = mnc_cw_vnat(2,indv)
615          DO i = 1,niat
616            n1 = IFNBLNK(inames(i))
617            n2 = ILNBLNK(inames(i))
618            mnc_cw_vinm(n+i,indv)(1:(n2-n1+1)) = inames(i)(n1:n2)
619            mnc_cw_viat(n+i,indv) = ivals(i)
620          ENDDO
621          mnc_cw_vnat(2,indv) = n + niat
622    
623    C     Double Attributes
624          n = mnc_cw_vnat(3,indv)
625          DO i = 1,ndat
626            n1 = IFNBLNK(dnames(i))
627            n2 = ILNBLNK(dnames(i))
628            mnc_cw_vdnm(n+i,indv)(1:(n2-n1+1)) = dnames(i)(n1:n2)
629            mnc_cw_vdat(n+i,indv) = dvals(i)
630          ENDDO
631          mnc_cw_vnat(3,indv) = n + ndat
632    
633          RETURN
634          END
635    
636    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
637    CBOP
638    C     !ROUTINE: MNC_CW_GET_TILE_NUM
639    
640    C     !INTERFACE:
641          SUBROUTINE MNC_CW_GET_TILE_NUM(
642         I     bi, bj,
643         O     uniq_tnum,
644         I     myThid )
645    
646    C     !DESCRIPTION:
647    
648    C     !USES:
649          implicit none
650    #include "EEPARAMS.h"
651    #include "SIZE.h"
652    #ifdef ALLOW_EXCH2
653    #include "W2_EXCH2_TOPOLOGY.h"
654    #include "W2_EXCH2_PARAMS.h"
655    #endif
656    
657    C     !INPUT PARAMETERS:
658          integer myThid, bi,bj, uniq_tnum
659    
660    C     !LOCAL VARIABLES:
661          integer iG,jG
662    CEOP
663    
664          iG = 0
665          jG = 0
666    
667    #ifdef ALLOW_EXCH2
668    
669          uniq_tnum = W2_myTileList(bi)
670    
671    #else
672    
673    C     Global tile number for simple (non-cube) domains
674          iG = bi+(myXGlobalLo-1)/sNx
675          jG = bj+(myYGlobalLo-1)/sNy
676    
677          uniq_tnum = (jG - 1)*(nPx*nSx) + iG
678    
679    #endif
680    
681    CEH3      write(*,*) 'iG,jG,uniq_tnum :', iG,jG,uniq_tnum
682    
683          RETURN
684          END
685    
686    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
687    CBOP
688    C     !ROUTINE: MNC_CW_FILE_AORC
689          
690    C     !INTERFACE:
691          SUBROUTINE MNC_CW_FILE_AORC(
692         I     fname,
693         O     indf,
694         I     myThid )
695    
696    C     !DESCRIPTION:
697    
698    C     !USES:
699          implicit none
700    #include "netcdf.inc"
701    #include "mnc_common.h"
702    #include "EEPARAMS.h"
703    
704    C     !INPUT PARAMETERS:
705          integer myThid, indf
706          character*(*) fname
707    
708    C     !LOCAL VARIABLES:
709          integer i, ierr
710          character*(MAX_LEN_MBUF) msgbuf
711    CEOP
712    
713    C     Check if the file is already open
714          CALL MNC_GET_IND(MNC_MAX_ID, fname, mnc_f_names, indf, myThid)
715          IF (indf .GT. 0) THEN
716            RETURN
717          ENDIF
718    
719    C     Try to open an existing file
720          CALL MNC_FILE_TRY_READ(fname, ierr, indf, myThid)
721          IF (ierr .EQ. NF_NOERR) THEN
722            RETURN
723          ENDIF
724    
725    C     Try to create a new one
726          CALL MNC_FILE_OPEN(fname, 0, indf, myThid)
727    
728          RETURN
729          END
730    
731  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
732    
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.11
  ViewVC Help
Powered by ViewVC 1.1.22