/[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.3 by edhill, Sat Jan 31 04:13:09 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     !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    
33  C     Functions  C     !LOCAL VARIABLES:
       integer IFNBLNK, ILNBLNK  
   
 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_gname, 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_GNAME 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_GNAME'          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_gname,        CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID, mnc_cw_gname,
52       &     indg)       &     indg, myThid)
53    
54        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)
55        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 69  C     Check that this name is not alread
69        END        END
70    
71  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
72    CBOP
73    C     !ROUTINE: MNC_CW_DUMP
74    
75        SUBROUTINE MNC_CW_DUMP()  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        implicit none
84  #include "mnc_common.h"  #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  C     !LOCAL VARIABLES:
93        integer i,j, ntot        integer i,j, ntot
94          integer NBLNK
95          parameter ( NBLNK = 150 )
96          character s1*(NBLNK), blnk*(NBLNK)
97    CEOP
98    
99        write(*,'(a)') 'The currently defined Grid Types are:'        _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        ntot = 0
111        DO j = 1,MNC_MAX_ID        DO j = 1,MNC_MAX_ID
112          IF (mnc_cw_gname(j)(1:MNC_MAX_CHAR)          IF (mnc_cw_gname(j)(1:MNC_MAX_CHAR)
113       &       .NE. mnc_blank_name(1:MNC_MAX_CHAR)) THEN       &       .NE. mnc_blank_name(1:MNC_MAX_CHAR)) THEN
114                        
115            ntot = ntot + 1            ntot = ntot + 1
116            write(*,'(2i5,a3,a20,i3,a3,5i4,a4,5i4,a4,5i4,6a4)')            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),       &         j, ntot, ' : ', mnc_cw_gname(j)(1:20), mnc_cw_ndim(j),
120       &         ' : ', (mnc_cw_dims(i,j), i=1,5),       &         ' : ', (mnc_cw_dims(i,j), i=1,5),
121       &         '  | ', (mnc_cw_is(i,j), i=1,5),       &         '  | ', (mnc_cw_is(i,j), i=1,5),
122       &         '  | ', (mnc_cw_ie(i,j), i=1,5),       &         '  | ', (mnc_cw_ie(i,j), i=1,5),
123       &         '  | ', (mnc_cw_dn(i,j)(1:4), i=1,5)       &         '  | ', (mnc_cw_dn(i,j)(1:4), i=1,5)
124              CALL PRINT_MESSAGE(
125         &         s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
126              
127          ENDIF          ENDIF
128        ENDDO        ENDDO
129          
130        write(*,'(a)') 'The currently defined Variable Types are:'        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        ntot = 0
136        DO j = 1,MNC_MAX_ID        DO j = 1,MNC_MAX_ID
137          IF (mnc_cw_vname(j)(1:MNC_MAX_CHAR)          IF (mnc_cw_vname(j)(1:MNC_MAX_CHAR)
138       &       .NE. mnc_blank_name(1:MNC_MAX_CHAR)) THEN       &       .NE. mnc_blank_name(1:MNC_MAX_CHAR)) THEN
139              
140            ntot = ntot + 1            ntot = ntot + 1
141            write(*,'(2i5,a3,a25,a3,i4)') j, ntot, ' : ',            s1(1:NBLNK) = blnk(1:NBLNK)
142       &         mnc_cw_vname(j)(1:20), ' : ', mnc_cw_vgind(j)            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)            DO i = 1,mnc_cw_vnat(1,j)
149              write(*,'(a14,i4,a3,a25,a3,a25)') '      text_at:',i,              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), ' : ',       &           ' : ', mnc_cw_vtnm(i,j)(1:25), ' : ',
153       &           mnc_cw_vtat(i,j)(1:25)       &           mnc_cw_vtat(i,j)(1:55)
154                CALL PRINT_MESSAGE(
155         &           s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
156            ENDDO            ENDDO
157            DO i = 1,mnc_cw_vnat(2,j)            DO i = 1,mnc_cw_vnat(2,j)
158              write(*,'(a14,i4,a3,a25,a3,i20)') '      int__at:',i,              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), ' : ',       &           ' : ', mnc_cw_vinm(i,j)(1:25), ' : ',
162       &           mnc_cw_viat(i,j)       &           mnc_cw_viat(i,j)
163                CALL PRINT_MESSAGE(
164         &           s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
165            ENDDO            ENDDO
166            DO i = 1,mnc_cw_vnat(3,j)            DO i = 1,mnc_cw_vnat(3,j)
167              write(*,'(a14,i4,a3,a25,a3,f25.10)') '      dbl__at:',i,              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), ' : ',       &           ' : ', mnc_cw_vdnm(i,j)(1:25), ' : ',
171       &           mnc_cw_vdat(i,j)       &           mnc_cw_vdat(i,j)
172            ENDDO              CALL PRINT_MESSAGE(
173         &           s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
174            ENDDO
175            
176          ENDIF          ENDIF
177        ENDDO        ENDDO
178        IF (ntot .EQ. 0) THEN        IF (ntot .EQ. 0) THEN
179          write(*,'(a)') '   None defined!'          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        ENDIF
184          
185          _END_MASTER(myThid)
186    
187        RETURN        RETURN
188        END        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,ih, n,ntot        integer i, ihorz,ihsub,ivert,itime,ihalo, is,ih, n,ntot
# Line 153  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 /
# Line 305  C               Time dimension Line 375  C               Time dimension
375       &                 '  | ', (dn(i)(1:4), i=1,5)       &                 '  | ', (dn(i)(1:4), i=1,5)
376  #endif  #endif
377    
378                    CALL MNC_CW_ADD_GNAME(myThid, name, ndim,                    CALL MNC_CW_ADD_GNAME(name, ndim,
379       &                 dim, dn, ib, ie)       &                 dim, dn, ib, ie, myThid)
380                  ENDIF                  ENDIF
381    
382                ENDDO                ENDDO
# Line 321  C               Time dimension Line 391  C               Time dimension
391        END        END
392    
393  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  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(        SUBROUTINE MNC_CW_ADD_VNAME(
      I     myThid,  
399       I     vname,       I     vname,
400       I     gname )       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        implicit none
409  #include "mnc_common.h"  #include "mnc_common.h"
410  #include "EEPARAMS.h"  #include "EEPARAMS.h"
411    
412  C     Arguments  C     !INPUT PARAMETERS:
413        integer myThid        integer myThid, bi_dim, bj_dim
414        character*(*) vname, gname        character*(*) vname, gname
415    
416  C     Functions  C     !LOCAL VARIABLES:
       integer IFNBLNK, ILNBLNK  
   
 C     Local Variables  
417        integer i, nvf,nvl, ngf,ngl, indv,indg        integer i, nvf,nvl, ngf,ngl, indv,indg
418        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
419    CEOP
420    C     Functions
421          integer IFNBLNK, ILNBLNK
422    
423        nvf = IFNBLNK(vname)        nvf = IFNBLNK(vname)
424        nvl = ILNBLNK(vname)        nvl = ILNBLNK(vname)
# Line 348  C     Local Variables Line 426  C     Local Variables
426        ngl = ILNBLNK(gname)        ngl = ILNBLNK(gname)
427    
428  C     Check that this vname is not already defined  C     Check that this vname is not already defined
429        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)
430        IF (indv .GT. 0) THEN        IF (indv .GT. 0) THEN
431          write(msgbuf,'(3a)') 'MNC_CW_ADD_VNAME ERROR: ''',          write(msgbuf,'(3a)') 'MNC_CW_ADD_VNAME ERROR: ''',
432       &       vname(nvf:nvl), ''' is already defined'       &       vname(nvf:nvl), ''' is already defined'
433          CALL print_error(msgbuf, mythid)          CALL print_error(msgbuf, mythid)
434          stop 'ABNORMAL END: S/R MNC_CW_ADD_VNAME'          stop 'ABNORMAL END: S/R MNC_CW_ADD_VNAME'
435        ENDIF        ENDIF
436        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,
437       &     indv)       &     indv, myThid)
438    
439  C     Check that gname exists  C     Check that gname exists
440        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)
441        IF (indg .LT. 1) THEN        IF (indg .LT. 1) THEN
442          write(msgbuf,'(3a)') 'MNC_CW_ADD_VNAME ERROR: ''',          write(msgbuf,'(3a)') 'MNC_CW_ADD_VNAME ERROR: ''',
443       &       gname(ngf:ngl), ''' is not defined'       &       gname(ngf:ngl), ''' is not defined'
# Line 373  C     Check that gname exists Line 451  C     Check that gname exists
451        DO i = 1,3        DO i = 1,3
452          mnc_cw_vnat(i,indv) = 0          mnc_cw_vnat(i,indv) = 0
453        ENDDO        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        RETURN
460        END        END
461    
462  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  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(        SUBROUTINE MNC_CW_ADD_VATTR_TEXT(
      I     myThid,  
468       I     vname,       I     vname,
469       I     ntat,       I     ntat,
470       I     tnames,       I     tnames,
471       I     tvals )       I     tvals,
472         I     myThid )
473    
474    C     !DESCRIPTION:
475    C     Add a text attribute
476          
477    C     !USES:
478        implicit none        implicit none
479    
480  C     Arguments  C     !INPUT PARAMETERS:
481        integer myThid, ntat        integer myThid, ntat
482        character*(*) vname, tnames(*), tvals(*)        character*(*) vname, tnames(*), tvals(*)
483    CEOP
484    
485        CALL MNC_CW_ADD_VATTR_ANY(myThid, vname,        CALL MNC_CW_ADD_VATTR_ANY(vname,
486       &     ntat, 0, 0,       &     ntat, 0, 0,
487       &     tnames, ' ', ' ',       &     tnames, ' ', ' ',
488       &     tvals, 0, 0.0D0 )       &     tvals, 0, 0.0D0, myThid )
489    
490        RETURN        RETURN
491        END        END
492    
493  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  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(        SUBROUTINE MNC_CW_ADD_VATTR_INT(
      I     myThid,  
499       I     vname,       I     vname,
500       I     niat,       I     niat,
501       I     inames,       I     inames,
502       I     ivals )       I     ivals,
503         I     myThid )
504    
505    C     !DESCRIPTION:
506    
507    C     !USES:
508        implicit none        implicit none
509    
510  C     Arguments  C     !INPUT PARAMETERS:
511        integer myThid, niat        integer myThid, niat
512        character*(*) vname, inames(*)        character*(*) vname, inames(*)
513        integer ivals(*)        integer ivals(*)
514    CEOP
515    
516        CALL MNC_CW_ADD_VATTR_ANY(myThid, vname,        CALL MNC_CW_ADD_VATTR_ANY(vname,
517       &     0, niat, 0,       &     0, niat, 0,
518       &     ' ', inames, ' ',       &     ' ', inames, ' ',
519       &     ' ', ivals, 0.0D0 )       &     ' ', ivals, 0.0D0, myThid )
520    
521        RETURN        RETURN
522        END        END
523    
524  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  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(        SUBROUTINE MNC_CW_ADD_VATTR_DBL(
      I     myThid,  
530       I     vname,       I     vname,
531       I     ndat,       I     ndat,
532       I     dnames,       I     dnames,
533       I     dvals )       I     dvals,
534         I     myThid )
535    
536    C     !DESCRIPTION:
537    
538    C     !USES:
539        implicit none        implicit none
540    
541  C     Arguments  C     !INPUT PARAMETERS:
542        integer myThid, ndat        integer myThid, ndat
543        character*(*) vname, dnames(*)        character*(*) vname, dnames(*)
544        REAL*8 dvals(*)        REAL*8 dvals(*)
545    CEOP
546    
547        CALL MNC_CW_ADD_VATTR_ANY(myThid, vname,        CALL MNC_CW_ADD_VATTR_ANY(vname,
548       &     0, 0, ndat,       &     0, 0, ndat,
549       &     ' ', ' ', dnames,       &     ' ', ' ', dnames,
550       &     ' ', 0, dvals )       &     ' ', 0, dvals, myThid )
551    
552        RETURN        RETURN
553        END        END
554    
555  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  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(        SUBROUTINE MNC_CW_ADD_VATTR_ANY(
      I     myThid,  
561       I     vname,       I     vname,
562       I     ntat,   niat,   ndat,       I     ntat,   niat,   ndat,
563       I     tnames, inames, dnames,       I     tnames, inames, dnames,
564       I     tvals,  ivals,  dvals )       I     tvals,  ivals,  dvals,
565         I     myThid )
566    
567    C     !DESCRIPTION:
568    
569    C     !USES:
570        implicit none        implicit none
571  #include "mnc_common.h"  #include "mnc_common.h"
572  #include "EEPARAMS.h"  #include "EEPARAMS.h"
573    
574  C     Arguments  C     !INPUT PARAMETERS:
575        integer myThid, ntat, niat, ndat        integer myThid, ntat, niat, ndat
576        character*(*) vname        character*(*) vname
577        character*(*) tnames(*), inames(*), dnames(*)        character*(*) tnames(*), inames(*), dnames(*)
# Line 469  C     Arguments Line 579  C     Arguments
579        integer ivals(*)        integer ivals(*)
580        REAL*8 dvals(*)        REAL*8 dvals(*)
581    
582  C     Functions  C     !LOCAL VARIABLES:
       integer IFNBLNK, ILNBLNK  
   
 C     Local Variables  
583        integer i, n, nvf,nvl, n1,n2, indv        integer i, n, nvf,nvl, n1,n2, indv
584        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
585    CEOP
586    C     Functions
587          integer IFNBLNK, ILNBLNK
588    
589        nvf = IFNBLNK(vname)        nvf = IFNBLNK(vname)
590        nvl = ILNBLNK(vname)        nvl = ILNBLNK(vname)
591    
592  C     Check that vname is defined  C     Check that vname is defined
593        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)
594        IF (indv .LT. 1) THEN        IF (indv .LT. 1) THEN
595          write(msgbuf,'(3a)') 'MNC_CW_ADD_VATTR_ANY ERROR: ''',          write(msgbuf,'(3a)') 'MNC_CW_ADD_VATTR_ANY ERROR: ''',
596       &       vname(nvf:nvl), ''' is not defined'       &       vname(nvf:nvl), ''' is not defined'
# Line 524  C     Double Attributes Line 634  C     Double Attributes
634        END        END
635    
636  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  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(        SUBROUTINE MNC_CW_GET_TILE_NUM(
      I     myThid,  
642       I     bi, bj,       I     bi, bj,
643       O     uniq_tnum )       O     uniq_tnum,
644         I     myThid )
645    
646    C     !DESCRIPTION:
647    
648    C     !USES:
649        implicit none        implicit none
650  #include "EEPARAMS.h"  #include "EEPARAMS.h"
651  #include "SIZE.h"  #include "SIZE.h"
652    #ifdef ALLOW_EXCH2
653    #include "W2_EXCH2_TOPOLOGY.h"
654    #include "W2_EXCH2_PARAMS.h"
655    #endif
656    
657  C     Arguments  C     !INPUT PARAMETERS:
658        integer myThid, bi,bj, uniq_tnum        integer myThid, bi,bj, uniq_tnum
659    
660  C     Local Variables  C     !LOCAL VARIABLES:
661        integer iG,jG        integer iG,jG
662    CEOP
663    
664          iG = 0
665          jG = 0
666    
667  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
668    
 #include "W2_EXCH2_PARAMS.h"  
669        uniq_tnum = W2_myTileList(bi)        uniq_tnum = W2_myTileList(bi)
670    
671  #else  #else
# Line 550  C     Local Variables Line 673  C     Local Variables
673  C     Global tile number for simple (non-cube) domains  C     Global tile number for simple (non-cube) domains
674        iG = bi+(myXGlobalLo-1)/sNx        iG = bi+(myXGlobalLo-1)/sNx
675        jG = bj+(myYGlobalLo-1)/sNy        jG = bj+(myYGlobalLo-1)/sNy
676  C     .          full rows                partial rows  
677        uniq_tnum = (jG - 1)*nPx*(nSx*nSy) + (iG - 1)*(nSx*nSy)        uniq_tnum = (jG - 1)*(nPx*nSx) + iG
678    
679  #endif  #endif
680    
681    CEH3      write(*,*) 'iG,jG,uniq_tnum :', iG,jG,uniq_tnum
682    
683        RETURN        RETURN
684        END        END
685    
686  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  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(        SUBROUTINE MNC_CW_FILE_AORC(
692       I     myThid,       I     fname,
693       I     fname )       O     indf,
694         I     myThid )
695    
696    C     !DESCRIPTION:
697    
698    C     !USES:
699        implicit none        implicit none
700  #include "netcdf.inc"  #include "netcdf.inc"
701  #include "mnc_common.h"  #include "mnc_common.h"
702  #include "EEPARAMS.h"  #include "EEPARAMS.h"
703    
704  C     Arguments  C     !INPUT PARAMETERS:
705        integer myThid        integer myThid, indf
706        character*(*) fname        character*(*) fname
707    
708  C     Local Variables  C     !LOCAL VARIABLES:
709        integer i, ierr, indf        integer i, ierr
710        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
711    CEOP
712    
713  C     Check if the file is already open  C     Check if the file is already open
714        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)
715        IF (indf .GT. 0) THEN        IF (indf .GT. 0) THEN
716          RETURN          RETURN
717        ENDIF        ENDIF
718    
719  C     Try to open an existing file  C     Try to open an existing file
720        CALL MNC_FILE_TRY_READ(myThid, fname, ierr)        CALL MNC_FILE_TRY_READ(fname, ierr, indf, myThid)
721        IF (ierr .EQ. NF_NOERR) THEN        IF (ierr .EQ. NF_NOERR) THEN
722          RETURN          RETURN
723        ENDIF        ENDIF
724    
725  C     Try to create a new one  C     Try to create a new one
726                CALL MNC_FILE_OPEN(fname, 0, indf, myThid)
727    
728        RETURN        RETURN
729        END        END
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.11
  ViewVC Help
Powered by ViewVC 1.1.22