/[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.10 by edhill, Sat Mar 20 23:51:23 2004 UTC
# Line 6  C $Name$ Line 6  C $Name$
6  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7    
8        SUBROUTINE MNC_CW_ADD_GNAME(        SUBROUTINE MNC_CW_ADD_GNAME(
      I     myThid,  
9       I     name,       I     name,
10       I     ndim,       I     ndim,
11       I     dlens,       I     dlens,
12       I     dnames,       I     dnames,
13       I     inds_beg, inds_end )       I     inds_beg, inds_end,
14         I     myThid )
15    
16        implicit none        implicit none
17  #include "mnc_common.h"  #include "mnc_common.h"
# Line 34  C     Local Variables Line 34  C     Local Variables
34        nnl = ILNBLNK(name)        nnl = ILNBLNK(name)
35    
36  C     Check that this name is not already defined  C     Check that this name is not already defined
37        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)
38        IF (indg .GT. 0) THEN        IF (indg .GT. 0) THEN
39          write(msgbuf,'(3a)') 'MNC_CW_ADD_GNAME ERROR: ''', name,          write(msgbuf,'(3a)') 'MNC_CW_ADD_GNAME ERROR: ''', name,
40       &       ''' is already defined'       &       ''' is already defined'
41          CALL print_error(msgbuf, mythid)          CALL print_error(msgbuf, mythid)
42          stop 'ABNORMAL END: S/R MNC_CW_ADD_GNAME'          stop 'ABNORMAL END: S/R MNC_CW_ADD_GNAME'
43        ENDIF        ENDIF
44        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,
45       &     indg)       &     indg, myThid)
46    
47        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)
48        mnc_cw_gname(indg)(1:(nnl-nnf+1)) = name(nnf:nnl)        mnc_cw_gname(indg)(1:(nnl-nnf+1)) = name(nnf:nnl)
# Line 63  C     Check that this name is not alread Line 63  C     Check that this name is not alread
63    
64  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
65    
66        SUBROUTINE MNC_CW_DUMP()        SUBROUTINE MNC_CW_DUMP( myThid )
67    
68        implicit none        implicit none
69  #include "mnc_common.h"  #include "mnc_common.h"
70    #include "SIZE.h"
71    #include "EEPARAMS.h"
72    #include "PARAMS.h"
73    
74    C     Arguments
75          integer myThid
76    
77  C     Local Variables  C     Local Variables
78        integer i,j, ntot        integer i,j, ntot
79          integer NBLNK
80          parameter ( NBLNK = 150 )
81          character s1*(NBLNK), blnk*(NBLNK)
82    
83    
84        write(*,'(a)') 'The currently defined Grid Types are:'        _BEGIN_MASTER(myThid)
85          
86          DO i = 1,NBLNK
87            blnk(i:i) = ' '
88          ENDDO
89          
90          s1(1:NBLNK) = blnk(1:NBLNK)
91          write(s1,'(a5,a)') 'MNC: ',
92         &     'The currently defined Grid Types are:'
93          CALL PRINT_MESSAGE(
94         &     s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
95        ntot = 0        ntot = 0
96        DO j = 1,MNC_MAX_ID        DO j = 1,MNC_MAX_ID
97          IF (mnc_cw_gname(j)(1:MNC_MAX_CHAR)          IF (mnc_cw_gname(j)(1:MNC_MAX_CHAR)
98       &       .NE. mnc_blank_name(1:MNC_MAX_CHAR)) THEN       &       .NE. mnc_blank_name(1:MNC_MAX_CHAR)) THEN
99                        
100            ntot = ntot + 1            ntot = ntot + 1
101            write(*,'(2i5,a3,a20,i3,a3,5i4,a4,5i4,a4,5i4,6a4)')            s1(1:NBLNK) = blnk(1:NBLNK)
102              write(s1,'(a5,2i5,a3,a20,i3,a3,5i4,a4,5i4,a4,5i4,6a4)')
103         &         'MNC: ',
104       &         j, ntot, ' : ', mnc_cw_gname(j)(1:20), mnc_cw_ndim(j),       &         j, ntot, ' : ', mnc_cw_gname(j)(1:20), mnc_cw_ndim(j),
105       &         ' : ', (mnc_cw_dims(i,j), i=1,5),       &         ' : ', (mnc_cw_dims(i,j), i=1,5),
106       &         '  | ', (mnc_cw_is(i,j), i=1,5),       &         '  | ', (mnc_cw_is(i,j), i=1,5),
107       &         '  | ', (mnc_cw_ie(i,j), i=1,5),       &         '  | ', (mnc_cw_ie(i,j), i=1,5),
108       &         '  | ', (mnc_cw_dn(i,j)(1:4), i=1,5)       &         '  | ', (mnc_cw_dn(i,j)(1:4), i=1,5)
109              CALL PRINT_MESSAGE(
110         &         s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
111              
112          ENDIF          ENDIF
113        ENDDO        ENDDO
114          
115        write(*,'(a)') 'The currently defined Variable Types are:'        s1(1:NBLNK) = blnk(1:NBLNK)
116          write(s1,'(a5,a)') 'MNC: ',
117         &     'The currently defined Variable Types are:'
118          CALL PRINT_MESSAGE(
119         &     s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
120        ntot = 0        ntot = 0
121        DO j = 1,MNC_MAX_ID        DO j = 1,MNC_MAX_ID
122          IF (mnc_cw_vname(j)(1:MNC_MAX_CHAR)          IF (mnc_cw_vname(j)(1:MNC_MAX_CHAR)
123       &       .NE. mnc_blank_name(1:MNC_MAX_CHAR)) THEN       &       .NE. mnc_blank_name(1:MNC_MAX_CHAR)) THEN
124              
125            ntot = ntot + 1            ntot = ntot + 1
126            write(*,'(2i5,a3,a25,a3,i4)') j, ntot, ' : ',            s1(1:NBLNK) = blnk(1:NBLNK)
127       &         mnc_cw_vname(j)(1:20), ' : ', mnc_cw_vgind(j)            write(s1,'(a5,2i5,a3,a25,a3,i4)') 'MNC: ',
128         &         j, ntot, ' | ',
129         &         mnc_cw_vname(j)(1:20), ' | ', mnc_cw_vgind(j)
130              CALL PRINT_MESSAGE(
131         &         s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
132              
133            DO i = 1,mnc_cw_vnat(1,j)            DO i = 1,mnc_cw_vnat(1,j)
134              write(*,'(a14,i4,a3,a25,a3,a25)') '      text_at:',i,              s1(1:NBLNK) = blnk(1:NBLNK)
135                write(s1,'(a5,a14,i4,a3,a25,a3,a55)')
136         &           'MNC: ','      text_at:',i,
137       &           ' : ', mnc_cw_vtnm(i,j)(1:25), ' : ',       &           ' : ', mnc_cw_vtnm(i,j)(1:25), ' : ',
138       &           mnc_cw_vtat(i,j)(1:25)       &           mnc_cw_vtat(i,j)(1:55)
139                CALL PRINT_MESSAGE(
140         &           s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
141            ENDDO            ENDDO
142            DO i = 1,mnc_cw_vnat(2,j)            DO i = 1,mnc_cw_vnat(2,j)
143              write(*,'(a14,i4,a3,a25,a3,i20)') '      int__at:',i,              s1(1:NBLNK) = blnk(1:NBLNK)
144                write(s1,'(a5,a14,i4,a3,a25,a3,i20)')
145         &           'MNC: ','      int__at:',i,
146       &           ' : ', mnc_cw_vinm(i,j)(1:25), ' : ',       &           ' : ', mnc_cw_vinm(i,j)(1:25), ' : ',
147       &           mnc_cw_viat(i,j)       &           mnc_cw_viat(i,j)
148                CALL PRINT_MESSAGE(
149         &           s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
150            ENDDO            ENDDO
151            DO i = 1,mnc_cw_vnat(3,j)            DO i = 1,mnc_cw_vnat(3,j)
152              write(*,'(a14,i4,a3,a25,a3,f25.10)') '      dbl__at:',i,              s1(1:NBLNK) = blnk(1:NBLNK)
153                write(s1,'(a5,a14,i4,a3,a25,a3,f25.10)')
154         &           'MNC: ','      dbl__at:',i,
155       &           ' : ', mnc_cw_vdnm(i,j)(1:25), ' : ',       &           ' : ', mnc_cw_vdnm(i,j)(1:25), ' : ',
156       &           mnc_cw_vdat(i,j)       &           mnc_cw_vdat(i,j)
157            ENDDO              CALL PRINT_MESSAGE(
158         &           s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
159            ENDDO
160            
161          ENDIF          ENDIF
162        ENDDO        ENDDO
163        IF (ntot .EQ. 0) THEN        IF (ntot .EQ. 0) THEN
164          write(*,'(a)') '   None defined!'          s1(1:NBLNK) = blnk(1:NBLNK)
165            write(s1,'(a)') 'MNC:    None defined!'
166            CALL PRINT_MESSAGE(
167         &       s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
168        ENDIF        ENDIF
169          
170          _END_MASTER(myThid)
171    
172        RETURN        RETURN
173        END        END
# Line 127  C     Local Variables Line 175  C     Local Variables
175  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
176    
177        SUBROUTINE MNC_CW_INIT(        SUBROUTINE MNC_CW_INIT(
178       I     myThid,       I     sNx,sNy, OLx,OLy, nSx,nSy, nPx,nPy, Nr,
179       I     sNx,sNy, OLx,OLy, nSx,nSy, nPx,nPy, Nr )       I     myThid )
180    
181        implicit none        implicit none
182  #include "mnc_common.h"  #include "mnc_common.h"
# Line 305  C               Time dimension Line 353  C               Time dimension
353       &                 '  | ', (dn(i)(1:4), i=1,5)       &                 '  | ', (dn(i)(1:4), i=1,5)
354  #endif  #endif
355    
356                    CALL MNC_CW_ADD_GNAME(myThid, name, ndim,                    CALL MNC_CW_ADD_GNAME(name, ndim,
357       &                 dim, dn, ib, ie)       &                 dim, dn, ib, ie, myThid)
358                  ENDIF                  ENDIF
359    
360                ENDDO                ENDDO
# Line 323  C               Time dimension Line 371  C               Time dimension
371  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
372    
373        SUBROUTINE MNC_CW_ADD_VNAME(        SUBROUTINE MNC_CW_ADD_VNAME(
      I     myThid,  
374       I     vname,       I     vname,
375       I     gname )       I     gname,
376         I     bi_dim, bj_dim,
377         I     myThid )
378    
379        implicit none        implicit none
380  #include "mnc_common.h"  #include "mnc_common.h"
381  #include "EEPARAMS.h"  #include "EEPARAMS.h"
382    
383  C     Arguments  C     Arguments
384        integer myThid        integer myThid, bi_dim, bj_dim
385        character*(*) vname, gname        character*(*) vname, gname
386    
387  C     Functions  C     Functions
# Line 348  C     Local Variables Line 397  C     Local Variables
397        ngl = ILNBLNK(gname)        ngl = ILNBLNK(gname)
398    
399  C     Check that this vname is not already defined  C     Check that this vname is not already defined
400        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)
401        IF (indv .GT. 0) THEN        IF (indv .GT. 0) THEN
402          write(msgbuf,'(3a)') 'MNC_CW_ADD_VNAME ERROR: ''',          write(msgbuf,'(3a)') 'MNC_CW_ADD_VNAME ERROR: ''',
403       &       vname(nvf:nvl), ''' is already defined'       &       vname(nvf:nvl), ''' is already defined'
404          CALL print_error(msgbuf, mythid)          CALL print_error(msgbuf, mythid)
405          stop 'ABNORMAL END: S/R MNC_CW_ADD_VNAME'          stop 'ABNORMAL END: S/R MNC_CW_ADD_VNAME'
406        ENDIF        ENDIF
407        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,
408       &     indv)       &     indv, myThid)
409    
410  C     Check that gname exists  C     Check that gname exists
411        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)
412        IF (indg .LT. 1) THEN        IF (indg .LT. 1) THEN
413          write(msgbuf,'(3a)') 'MNC_CW_ADD_VNAME ERROR: ''',          write(msgbuf,'(3a)') 'MNC_CW_ADD_VNAME ERROR: ''',
414       &       gname(ngf:ngl), ''' is not defined'       &       gname(ngf:ngl), ''' is not defined'
# Line 373  C     Check that gname exists Line 422  C     Check that gname exists
422        DO i = 1,3        DO i = 1,3
423          mnc_cw_vnat(i,indv) = 0          mnc_cw_vnat(i,indv) = 0
424        ENDDO        ENDDO
425          mnc_cw_vbij(1,indv) = bi_dim
426          mnc_cw_vbij(2,indv) = bj_dim
427    
428          CALL MNC_CW_ADD_VATTR_TEXT(vname,1,'mitgcm_grid',gname, myThid)
429    
430        RETURN        RETURN
431        END        END
# Line 380  C     Check that gname exists Line 433  C     Check that gname exists
433  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
434    
435        SUBROUTINE MNC_CW_ADD_VATTR_TEXT(        SUBROUTINE MNC_CW_ADD_VATTR_TEXT(
      I     myThid,  
436       I     vname,       I     vname,
437       I     ntat,       I     ntat,
438       I     tnames,       I     tnames,
439       I     tvals )       I     tvals,
440         I     myThid )
441    
442        implicit none        implicit none
443    
# Line 392  C     Arguments Line 445  C     Arguments
445        integer myThid, ntat        integer myThid, ntat
446        character*(*) vname, tnames(*), tvals(*)        character*(*) vname, tnames(*), tvals(*)
447    
448        CALL MNC_CW_ADD_VATTR_ANY(myThid, vname,        CALL MNC_CW_ADD_VATTR_ANY(vname,
449       &     ntat, 0, 0,       &     ntat, 0, 0,
450       &     tnames, ' ', ' ',       &     tnames, ' ', ' ',
451       &     tvals, 0, 0.0D0 )       &     tvals, 0, 0.0D0, myThid )
452    
453        RETURN        RETURN
454        END        END
# Line 403  C     Arguments Line 456  C     Arguments
456  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
457    
458        SUBROUTINE MNC_CW_ADD_VATTR_INT(        SUBROUTINE MNC_CW_ADD_VATTR_INT(
      I     myThid,  
459       I     vname,       I     vname,
460       I     niat,       I     niat,
461       I     inames,       I     inames,
462       I     ivals )       I     ivals,
463         I     myThid )
464    
465        implicit none        implicit none
466    
# Line 416  C     Arguments Line 469  C     Arguments
469        character*(*) vname, inames(*)        character*(*) vname, inames(*)
470        integer ivals(*)        integer ivals(*)
471    
472        CALL MNC_CW_ADD_VATTR_ANY(myThid, vname,        CALL MNC_CW_ADD_VATTR_ANY(vname,
473       &     0, niat, 0,       &     0, niat, 0,
474       &     ' ', inames, ' ',       &     ' ', inames, ' ',
475       &     ' ', ivals, 0.0D0 )       &     ' ', ivals, 0.0D0, myThid )
476    
477        RETURN        RETURN
478        END        END
# Line 427  C     Arguments Line 480  C     Arguments
480  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
481    
482        SUBROUTINE MNC_CW_ADD_VATTR_DBL(        SUBROUTINE MNC_CW_ADD_VATTR_DBL(
      I     myThid,  
483       I     vname,       I     vname,
484       I     ndat,       I     ndat,
485       I     dnames,       I     dnames,
486       I     dvals )       I     dvals,
487         I     myThid )
488    
489        implicit none        implicit none
490    
# Line 440  C     Arguments Line 493  C     Arguments
493        character*(*) vname, dnames(*)        character*(*) vname, dnames(*)
494        REAL*8 dvals(*)        REAL*8 dvals(*)
495    
496        CALL MNC_CW_ADD_VATTR_ANY(myThid, vname,        CALL MNC_CW_ADD_VATTR_ANY(vname,
497       &     0, 0, ndat,       &     0, 0, ndat,
498       &     ' ', ' ', dnames,       &     ' ', ' ', dnames,
499       &     ' ', 0, dvals )       &     ' ', 0, dvals, myThid )
500    
501        RETURN        RETURN
502        END        END
# Line 451  C     Arguments Line 504  C     Arguments
504  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
505    
506        SUBROUTINE MNC_CW_ADD_VATTR_ANY(        SUBROUTINE MNC_CW_ADD_VATTR_ANY(
      I     myThid,  
507       I     vname,       I     vname,
508       I     ntat,   niat,   ndat,       I     ntat,   niat,   ndat,
509       I     tnames, inames, dnames,       I     tnames, inames, dnames,
510       I     tvals,  ivals,  dvals )       I     tvals,  ivals,  dvals,
511         I     myThid )
512    
513        implicit none        implicit none
514  #include "mnc_common.h"  #include "mnc_common.h"
# Line 480  C     Local Variables Line 533  C     Local Variables
533        nvl = ILNBLNK(vname)        nvl = ILNBLNK(vname)
534    
535  C     Check that vname is defined  C     Check that vname is defined
536        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)
537        IF (indv .LT. 1) THEN        IF (indv .LT. 1) THEN
538          write(msgbuf,'(3a)') 'MNC_CW_ADD_VATTR_ANY ERROR: ''',          write(msgbuf,'(3a)') 'MNC_CW_ADD_VATTR_ANY ERROR: ''',
539       &       vname(nvf:nvl), ''' is not defined'       &       vname(nvf:nvl), ''' is not defined'
# Line 526  C     Double Attributes Line 579  C     Double Attributes
579  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
580    
581        SUBROUTINE MNC_CW_GET_TILE_NUM(        SUBROUTINE MNC_CW_GET_TILE_NUM(
      I     myThid,  
582       I     bi, bj,       I     bi, bj,
583       O     uniq_tnum )       O     uniq_tnum,
584         I     myThid )
585    
586        implicit none        implicit none
587  #include "EEPARAMS.h"  #include "EEPARAMS.h"
588  #include "SIZE.h"  #include "SIZE.h"
589    #ifdef ALLOW_EXCH2
590    #include "W2_EXCH2_TOPOLOGY.h"
591    #include "W2_EXCH2_PARAMS.h"
592    #endif
593    
594  C     Arguments  C     Arguments
595        integer myThid, bi,bj, uniq_tnum        integer myThid, bi,bj, uniq_tnum
# Line 545  C     Local Variables Line 602  C     Local Variables
602    
603  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
604    
 #include "W2_EXCH2_PARAMS.h"  
605        uniq_tnum = W2_myTileList(bi)        uniq_tnum = W2_myTileList(bi)
606    
607  #else  #else
# Line 566  CEH3      write(*,*) 'iG,jG,uniq_tnum :' Line 622  CEH3      write(*,*) 'iG,jG,uniq_tnum :'
622  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
623    
624        SUBROUTINE MNC_CW_FILE_AORC(        SUBROUTINE MNC_CW_FILE_AORC(
      I     myThid,  
625       I     fname,       I     fname,
626       O     indf )       O     indf,
627         I     myThid )
628    
629        implicit none        implicit none
630  #include "netcdf.inc"  #include "netcdf.inc"
# Line 584  C     Local Variables Line 640  C     Local Variables
640        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
641    
642  C     Check if the file is already open  C     Check if the file is already open
643        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)
644        IF (indf .GT. 0) THEN        IF (indf .GT. 0) THEN
645          RETURN          RETURN
646        ENDIF        ENDIF
647    
648  C     Try to open an existing file  C     Try to open an existing file
649        CALL MNC_FILE_TRY_READ(myThid, fname, ierr, indf)        CALL MNC_FILE_TRY_READ(fname, ierr, indf, myThid)
650        IF (ierr .EQ. NF_NOERR) THEN        IF (ierr .EQ. NF_NOERR) THEN
651          RETURN          RETURN
652        ENDIF        ENDIF
653    
654  C     Try to create a new one  C     Try to create a new one
655        CALL MNC_FILE_OPEN(myThid, fname, 0, indf)        CALL MNC_FILE_OPEN(fname, 0, indf, myThid)
656    
657        RETURN        RETURN
658        END        END
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.10
  ViewVC Help
Powered by ViewVC 1.1.22