/[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.33 by jmc, Tue May 12 19:56:36 2009 UTC revision 1.34 by jmc, Sun Jun 28 01:08:25 2009 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2  C $Name$  C $Name$
3          
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  CBOP 0
8  C     !ROUTINE: MNC_CW_ADD_GNAME  C     !ROUTINE: MNC_CW_ADD_GNAME
9    
10  C     !INTERFACE:  C     !INTERFACE:
11        SUBROUTINE MNC_CW_ADD_GNAME(        SUBROUTINE MNC_CW_ADD_GNAME(
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 )       I     myThid )
18    
19  C     !DESCRIPTION:  C     !DESCRIPTION:
20  C     Add a grid name to the MNC convenience wrapper layer.  C     Add a grid name to the MNC convenience wrapper layer.
21          
22  C     !USES:  C     !USES:
23        implicit none        implicit none
24  #include "MNC_COMMON.h"  #include "MNC_COMMON.h"
# Line 44  C     Functions Line 44  C     Functions
44  C     Check that this name is not already defined  C     Check that this name is not already defined
45        CALL MNC_GET_IND(MNC_MAX_ID, name, mnc_cw_gname, indg, myThid)        CALL MNC_GET_IND(MNC_MAX_ID, name, mnc_cw_gname, indg, myThid)
46        IF (indg .GT. 0) THEN        IF (indg .GT. 0) THEN
47          write(msgbuf,'(3a)') 'MNC_CW_ADD_GNAME ERROR: ''', name,          write(msgbuf,'(3a)') 'MNC_CW_ADD_GNAME ERROR: ''', name,
48       &       ''' is already defined'       &       ''' is already defined'
49          CALL print_error(msgbuf, mythid)          CALL print_error(msgbuf, mythid)
50          stop 'ABNORMAL END: S/R MNC_CW_ADD_GNAME'          stop 'ABNORMAL END: S/R MNC_CW_ADD_GNAME'
51        ENDIF        ENDIF
52        CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID, mnc_cw_gname,        CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID, mnc_cw_gname,
53       &     'mnc_cw_gname', indg, myThid)       &     'mnc_cw_gname', indg, myThid)
54    
55        mnc_cw_gname(indg)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)        mnc_cw_gname(indg)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)
# Line 74  CBOP 0 Line 74  CBOP 0
74  C     !ROUTINE: MNC_CW_DEL_GNAME  C     !ROUTINE: MNC_CW_DEL_GNAME
75    
76  C     !INTERFACE:  C     !INTERFACE:
77        SUBROUTINE MNC_CW_DEL_GNAME(        SUBROUTINE MNC_CW_DEL_GNAME(
78       I     name,       I     name,
79       I     myThid )       I     myThid )
80    
81  C     !DESCRIPTION:  C     !DESCRIPTION:
82  C     Delete a grid name from the MNC convenience wrapper layer.  C     Delete a grid name from the MNC convenience wrapper layer.
83          
84  C     !USES:  C     !USES:
85        implicit none        implicit none
86  #include "MNC_COMMON.h"  #include "MNC_COMMON.h"
# Line 122  C     !INTERFACE: Line 122  C     !INTERFACE:
122  C     !DESCRIPTION:  C     !DESCRIPTION:
123  C     Write a condensed view of the current state of the MNC look-up  C     Write a condensed view of the current state of the MNC look-up
124  C     tables for the convenience wrapper section.  C     tables for the convenience wrapper section.
125          
126  C     !USES:  C     !USES:
127        implicit none        implicit none
128  #include "MNC_COMMON.h"  #include "MNC_COMMON.h"
# Line 141  C     !LOCAL VARIABLES: Line 141  C     !LOCAL VARIABLES:
141        character s1*(NBLNK), blnk*(NBLNK)        character s1*(NBLNK), blnk*(NBLNK)
142    
143        _BEGIN_MASTER(myThid)        _BEGIN_MASTER(myThid)
144          
145        DO i = 1,NBLNK        DO i = 1,NBLNK
146          blnk(i:i) = ' '          blnk(i:i) = ' '
147        ENDDO        ENDDO
148          
149        s1(1:NBLNK) = blnk(1:NBLNK)        s1(1:NBLNK) = blnk(1:NBLNK)
150        write(s1,'(a5,a)') 'MNC: ',        write(s1,'(a5,a)') 'MNC: ',
151       &     'The currently defined Grid Types are:'       &     'The currently defined Grid Types are:'
# Line 153  C     !LOCAL VARIABLES: Line 153  C     !LOCAL VARIABLES:
153       &     s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)       &     s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
154        ntot = 0        ntot = 0
155        DO j = 1,MNC_MAX_ID        DO j = 1,MNC_MAX_ID
156          IF (mnc_cw_gname(j)(1:MNC_MAX_CHAR)          IF (mnc_cw_gname(j)(1:MNC_MAX_CHAR)
157       &       .NE. mnc_blank_name(1:MNC_MAX_CHAR)) THEN       &       .NE. mnc_blank_name(1:MNC_MAX_CHAR)) THEN
158              
159            ntot = ntot + 1            ntot = ntot + 1
160            s1(1:NBLNK) = blnk(1:NBLNK)            s1(1:NBLNK) = blnk(1:NBLNK)
161            write(s1,'(a5,2i5,a3,a20,i3,a3,5i4,a4,5i4,a4,5i4,6a8)')            write(s1,'(a5,2i5,a3,a20,i3,a3,5i4,a4,5i4,a4,5i4,6a8)')
162       &         'MNC: ',       &         'MNC: ',
163       &         j, ntot, ' : ', mnc_cw_gname(j)(1:20), mnc_cw_ndim(j),       &         j, ntot, ' : ', mnc_cw_gname(j)(1:20), mnc_cw_ndim(j),
164       &         ' : ', (mnc_cw_dims(i,j), i=1,5),       &         ' : ', (mnc_cw_dims(i,j), i=1,5),
165       &         '  | ', (mnc_cw_is(i,j), i=1,5),       &         '  | ', (mnc_cw_is(i,j), i=1,5),
166       &         '  | ', (mnc_cw_ie(i,j), i=1,5),       &         '  | ', (mnc_cw_ie(i,j), i=1,5),
167       &         '  | ', (mnc_cw_dn(i,j)(1:7), i=1,5)       &         '  | ', (mnc_cw_dn(i,j)(1:7), i=1,5)
168            CALL PRINT_MESSAGE(            CALL PRINT_MESSAGE(
169       &         s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)       &         s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
170              
171          ENDIF          ENDIF
172        ENDDO        ENDDO
173          
174        s1(1:NBLNK) = blnk(1:NBLNK)        s1(1:NBLNK) = blnk(1:NBLNK)
175        write(s1,'(a5,a)') 'MNC: ',        write(s1,'(a5,a)') 'MNC: ',
176       &     'The currently defined Variable Types are:'       &     'The currently defined Variable Types are:'
# Line 178  C     !LOCAL VARIABLES: Line 178  C     !LOCAL VARIABLES:
178       &     s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)       &     s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
179        ntot = 0        ntot = 0
180        DO j = 1,MNC_MAX_ID        DO j = 1,MNC_MAX_ID
181          IF (mnc_cw_vname(j)(1:MNC_MAX_CHAR)          IF (mnc_cw_vname(j)(1:MNC_MAX_CHAR)
182       &       .NE. mnc_blank_name(1:MNC_MAX_CHAR)) THEN       &       .NE. mnc_blank_name(1:MNC_MAX_CHAR)) THEN
183              
184            ntot = ntot + 1            ntot = ntot + 1
185            s1(1:NBLNK) = blnk(1:NBLNK)            s1(1:NBLNK) = blnk(1:NBLNK)
186            write(s1,'(a5,2i5,a3,a25,a3,i4)') 'MNC: ',            write(s1,'(a5,2i5,a3,a25,a3,i4)') 'MNC: ',
187       &         j, ntot, ' | ',       &         j, ntot, ' | ',
188       &         mnc_cw_vname(j)(1:20), ' | ', mnc_cw_vgind(j)       &         mnc_cw_vname(j)(1:20), ' | ', mnc_cw_vgind(j)
189            CALL PRINT_MESSAGE(            CALL PRINT_MESSAGE(
190       &         s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)       &         s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
191              
192            DO i = 1,mnc_cw_vnat(1,j)            DO i = 1,mnc_cw_vnat(1,j)
193              s1(1:NBLNK) = blnk(1:NBLNK)              s1(1:NBLNK) = blnk(1:NBLNK)
194              write(s1,'(a5,a14,i4,a3,a25,a3,a55)')              write(s1,'(a5,a14,i4,a3,a25,a3,a55)')
195       &           'MNC: ','      text_at:',i,       &           'MNC: ','      text_at:',i,
196       &           ' : ', mnc_cw_vtnm(i,j)(1:25), ' : ',       &           ' : ', mnc_cw_vtnm(i,j)(1:25), ' : ',
197       &           mnc_cw_vtat(i,j)(1:MNC_MAX_CHAR)       &           mnc_cw_vtat(i,j)(1:MNC_MAX_CHAR)
198              CALL PRINT_MESSAGE(              CALL PRINT_MESSAGE(
# Line 200  C     !LOCAL VARIABLES: Line 200  C     !LOCAL VARIABLES:
200            ENDDO            ENDDO
201            DO i = 1,mnc_cw_vnat(2,j)            DO i = 1,mnc_cw_vnat(2,j)
202              s1(1:NBLNK) = blnk(1:NBLNK)              s1(1:NBLNK) = blnk(1:NBLNK)
203              write(s1,'(a5,a14,i4,a3,a25,a3,i20)')              write(s1,'(a5,a14,i4,a3,a25,a3,i20)')
204       &           'MNC: ','      int__at:',i,       &           'MNC: ','      int__at:',i,
205       &           ' : ', mnc_cw_vinm(i,j)(1:25), ' : ',       &           ' : ', mnc_cw_vinm(i,j)(1:25), ' : ',
206       &           mnc_cw_viat(i,j)       &           mnc_cw_viat(i,j)
207              CALL PRINT_MESSAGE(              CALL PRINT_MESSAGE(
# Line 209  C     !LOCAL VARIABLES: Line 209  C     !LOCAL VARIABLES:
209            ENDDO            ENDDO
210            DO i = 1,mnc_cw_vnat(3,j)            DO i = 1,mnc_cw_vnat(3,j)
211              s1(1:NBLNK) = blnk(1:NBLNK)              s1(1:NBLNK) = blnk(1:NBLNK)
212              write(s1,'(a5,a14,i4,a3,a25,a3,f25.10)')              write(s1,'(a5,a14,i4,a3,a25,a3,f25.10)')
213       &           'MNC: ','      dbl__at:',i,       &           'MNC: ','      dbl__at:',i,
214       &           ' : ', mnc_cw_vdnm(i,j)(1:25), ' : ',       &           ' : ', mnc_cw_vdnm(i,j)(1:25), ' : ',
215       &           mnc_cw_vdat(i,j)       &           mnc_cw_vdat(i,j)
216              CALL PRINT_MESSAGE(              CALL PRINT_MESSAGE(
217       &           s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)       &           s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
218          ENDDO          ENDDO
219            
220          ENDIF          ENDIF
221        ENDDO        ENDDO
222        IF (ntot .EQ. 0) THEN        IF (ntot .EQ. 0) THEN
# Line 225  C     !LOCAL VARIABLES: Line 225  C     !LOCAL VARIABLES:
225          CALL PRINT_MESSAGE(          CALL PRINT_MESSAGE(
226       &       s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)       &       s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
227        ENDIF        ENDIF
228          
229        _END_MASTER(myThid)        _END_MASTER(myThid)
230    
231        RETURN        RETURN
# Line 236  CBOP 0 Line 236  CBOP 0
236  C     !ROUTINE: MNC_CW_APPEND_VNAME  C     !ROUTINE: MNC_CW_APPEND_VNAME
237    
238  C     !INTERFACE:  C     !INTERFACE:
239        SUBROUTINE MNC_CW_APPEND_VNAME(        SUBROUTINE MNC_CW_APPEND_VNAME(
240       I     vname,       I     vname,
241       I     gname,       I     gname,
242       I     bi_dim, bj_dim,       I     bi_dim, bj_dim,
243       I     myThid )       I     myThid )
244    
245  C     !DESCRIPTION:  C     !DESCRIPTION:
246  C     If it is not yet defined within the MNC CW layer, append a  C     If it is not yet defined within the MNC CW layer, append a
247  C     variable type.  Calls MNC\_CW\_ADD\_VNAME().  C     variable type.  Calls MNC\_CW\_ADD\_VNAME().
248      
249  C     !USES:  C     !USES:
250        implicit none        implicit none
251  #include "MNC_COMMON.h"  #include "MNC_COMMON.h"
# Line 273  CBOP 0 Line 273  CBOP 0
273  C     !ROUTINE: MNC_CW_ADD_VNAME  C     !ROUTINE: MNC_CW_ADD_VNAME
274    
275  C     !INTERFACE:  C     !INTERFACE:
276        SUBROUTINE MNC_CW_ADD_VNAME(        SUBROUTINE MNC_CW_ADD_VNAME(
277       I     vname,       I     vname,
278       I     gname,       I     gname,
279       I     bi_dim, bj_dim,       I     bi_dim, bj_dim,
280       I     myThid )       I     myThid )
281    
282  C     !DESCRIPTION:  C     !DESCRIPTION:
283  C     Add a variable type to the MNC CW layer.  The variable type is an  C     Add a variable type to the MNC CW layer.  The variable type is an
284  C     association between a variable type name and the following items:  C     association between a variable type name and the following items:
285  C     \begin{center}  C     \begin{center}
# Line 289  C         grid type  &  defines the in-m Line 289  C         grid type  &  defines the in-m
289  C         \texttt{bi,bj} dimensions  &  tiling indices, if present  \\\hline  C         \texttt{bi,bj} dimensions  &  tiling indices, if present  \\\hline
290  C       \end{tabular}  C       \end{tabular}
291  C     \end{center}  C     \end{center}
292      
293  C     !USES:  C     !USES:
294        implicit none        implicit none
295  #include "MNC_COMMON.h"  #include "MNC_COMMON.h"
# Line 315  C     Functions Line 315  C     Functions
315  C     Check that this vname is not already defined  C     Check that this vname is not already defined
316        CALL MNC_GET_IND(MNC_MAX_ID, vname, mnc_cw_vname, indv, myThid)        CALL MNC_GET_IND(MNC_MAX_ID, vname, mnc_cw_vname, indv, myThid)
317        IF (indv .GT. 0) THEN        IF (indv .GT. 0) THEN
318          write(msgbuf,'(3a)') 'MNC_CW_ADD_VNAME ERROR: ''',          write(msgbuf,'(3a)') 'MNC_CW_ADD_VNAME ERROR: ''',
319       &       vname(nvf:nvl), ''' is already defined'       &       vname(nvf:nvl), ''' is already defined'
320          CALL print_error(msgbuf, mythid)          CALL print_error(msgbuf, mythid)
321          stop 'ABNORMAL END: S/R MNC_CW_ADD_VNAME'          stop 'ABNORMAL END: S/R MNC_CW_ADD_VNAME'
322        ENDIF        ENDIF
323        CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID, mnc_cw_vname,        CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID, mnc_cw_vname,
324       &     'mnc_cw_vname', indv, myThid)       &     'mnc_cw_vname', indv, myThid)
325    
326  C     Check that gname exists  C     Check that gname exists
327        CALL MNC_GET_IND(MNC_MAX_ID, gname, mnc_cw_gname, indg, myThid)        CALL MNC_GET_IND(MNC_MAX_ID, gname, mnc_cw_gname, indg, myThid)
328        IF (indg .LT. 1) THEN        IF (indg .LT. 1) THEN
329          write(msgbuf,'(3a)') 'MNC_CW_ADD_VNAME ERROR: ''',          write(msgbuf,'(3a)') 'MNC_CW_ADD_VNAME ERROR: ''',
330       &       gname(ngf:ngl), ''' is not defined'       &       gname(ngf:ngl), ''' is not defined'
331          CALL print_error(msgbuf, mythid)          CALL print_error(msgbuf, mythid)
332          stop 'ABNORMAL END: S/R MNC_CW_ADD_VNAME'          stop 'ABNORMAL END: S/R MNC_CW_ADD_VNAME'
# Line 353  CBOP 0 Line 353  CBOP 0
353  C     !ROUTINE: MNC_CW_DEL_VNAME  C     !ROUTINE: MNC_CW_DEL_VNAME
354    
355  C     !INTERFACE:  C     !INTERFACE:
356        SUBROUTINE MNC_CW_DEL_VNAME(        SUBROUTINE MNC_CW_DEL_VNAME(
357       I     vname,       I     vname,
358       I     myThid )       I     myThid )
359    
360  C     !DESCRIPTION:  C     !DESCRIPTION:
361  C     Delete a variable type from the MNC CW layer.  C     Delete a variable type from the MNC CW layer.
362      
363  C     !USES:  C     !USES:
364        implicit none        implicit none
365  #include "MNC_COMMON.h"  #include "MNC_COMMON.h"
# Line 392  C---+----1----+----2----+----3----+----4 Line 392  C---+----1----+----2----+----3----+----4
392  CBOP  CBOP
393  C     !ROUTINE: MNC_CW_ADD_VATTR_TEXT  C     !ROUTINE: MNC_CW_ADD_VATTR_TEXT
394  C     !INTERFACE:  C     !INTERFACE:
395        SUBROUTINE MNC_CW_ADD_VATTR_TEXT(        SUBROUTINE MNC_CW_ADD_VATTR_TEXT(
396       I     vname, tname, tval,       I     vname, tname, tval,
397       I     myThid )       I     myThid )
398    
399  C     !DESCRIPTION:  C     !DESCRIPTION:
400  C     Add a text attribute  C     Add a text attribute
401          
402  C     !USES:  C     !USES:
403        implicit none        implicit none
404    
# Line 418  C---+----1----+----2----+----3----+----4 Line 418  C---+----1----+----2----+----3----+----4
418  CBOP  CBOP
419  C     !ROUTINE: MNC_CW_ADD_VATTR_INT  C     !ROUTINE: MNC_CW_ADD_VATTR_INT
420  C     !INTERFACE:  C     !INTERFACE:
421        SUBROUTINE MNC_CW_ADD_VATTR_INT(        SUBROUTINE MNC_CW_ADD_VATTR_INT(
422       I     vname, iname, ival,       I     vname, iname, ival,
423       I     myThid )       I     myThid )
424    
425  C     !DESCRIPTION:  C     !DESCRIPTION:
# Line 443  C---+----1----+----2----+----3----+----4 Line 443  C---+----1----+----2----+----3----+----4
443  CBOP  CBOP
444  C !ROUTINE: MNC_CW_ADD_VATTR_DBL  C !ROUTINE: MNC_CW_ADD_VATTR_DBL
445  C !INTERFACE:  C !INTERFACE:
446        SUBROUTINE MNC_CW_ADD_VATTR_DBL(        SUBROUTINE MNC_CW_ADD_VATTR_DBL(
447       I     vname, dname, dval,       I     vname, dname, dval,
448       I     myThid )       I     myThid )
449    
450  C     !DESCRIPTION:  C     !DESCRIPTION:
451  C     Add double-precision real attribute  C     Add double-precision real attribute
452    
453  C     !USES:  C     !USES:
454        implicit none        implicit none
# Line 469  CBOP 1 Line 469  CBOP 1
469  C     !ROUTINE: MNC_CW_ADD_VATTR_ANY  C     !ROUTINE: MNC_CW_ADD_VATTR_ANY
470    
471  C     !INTERFACE:  C     !INTERFACE:
472        SUBROUTINE MNC_CW_ADD_VATTR_ANY(        SUBROUTINE MNC_CW_ADD_VATTR_ANY(
473       I     vname,       I     vname,
474       I     atype,       I     atype,
475       I     tname, iname, dname,       I     tname, iname, dname,
476       I     tval,  ival,  dval,       I     tval,  ival,  dval,
477       I     myThid )       I     myThid )
478    
479  C     !DESCRIPTION:  C     !DESCRIPTION:
# Line 506  C     Functions Line 506  C     Functions
506  C     Check that vname is defined  C     Check that vname is defined
507        CALL MNC_GET_IND(MNC_MAX_ID, vname, mnc_cw_vname, indv, myThid)        CALL MNC_GET_IND(MNC_MAX_ID, vname, mnc_cw_vname, indv, myThid)
508        IF (indv .LT. 1) THEN        IF (indv .LT. 1) THEN
509          write(msgbuf,'(3a)') 'MNC_CW_ADD_VATTR_ANY ERROR: ''',          write(msgbuf,'(3a)') 'MNC_CW_ADD_VATTR_ANY ERROR: ''',
510       &       vname(nvf:nvl), ''' is not defined'       &       vname(nvf:nvl), ''' is not defined'
511          CALL print_error(msgbuf, mythid)          CALL print_error(msgbuf, mythid)
512          stop 'ABNORMAL END: S/R MNC_CW_ADD_VATTR_ANY'          stop 'ABNORMAL END: S/R MNC_CW_ADD_VATTR_ANY'
# Line 518  C       Text Attribute Line 518  C       Text Attribute
518          n1 = IFNBLNK(tname)          n1 = IFNBLNK(tname)
519          n2 = ILNBLNK(tname)          n2 = ILNBLNK(tname)
520          IF ((n2-n1+1) .GT. MNC_MAX_CHAR) THEN          IF ((n2-n1+1) .GT. MNC_MAX_CHAR) THEN
521            write(msgbuf,'(3a,i6,2a)')            write(msgbuf,'(3a,i6,2a)')
522       &         'MNC_CW_ADD_VATTR_ANY WARNING: attribute name ''',       &         'MNC_CW_ADD_VATTR_ANY WARNING: attribute name ''',
523       &         tname(n1:n2), ''' has more than ', MNC_MAX_CHAR,       &         tname(n1:n2), ''' has more than ', MNC_MAX_CHAR,
524       &         ' characters and has been truncated to fit--please',       &         ' characters and has been truncated to fit--please',
# Line 536  C       write(*,*) atype,tname(n1:n2) Line 536  C       write(*,*) atype,tname(n1:n2)
536          n1 = IFNBLNK(tval)          n1 = IFNBLNK(tval)
537          n2 = ILNBLNK(tval)          n2 = ILNBLNK(tval)
538          IF ((n2-n1+1) .GT. MNC_MAX_CATT) THEN          IF ((n2-n1+1) .GT. MNC_MAX_CATT) THEN
539            write(msgbuf,'(3a,i6,2a)')            write(msgbuf,'(3a,i6,2a)')
540       &         'MNC_CW_ADD_VATTR_ANY WARNING: attribute value ''',       &         'MNC_CW_ADD_VATTR_ANY WARNING: attribute value ''',
541       &         tval(n1:n2), ''' has more than ', MNC_MAX_CATT,       &         tval(n1:n2), ''' has more than ', MNC_MAX_CATT,
542       &         ' characters and has been truncated to fit--please',       &         ' characters and has been truncated to fit--please',
# Line 545  C       write(*,*) atype,tname(n1:n2) Line 545  C       write(*,*) atype,tname(n1:n2)
545       &                        SQUEEZE_RIGHT , myThid)       &                        SQUEEZE_RIGHT , myThid)
546            n2 = MNC_MAX_CATT + n1 - 1            n2 = MNC_MAX_CATT + n1 - 1
547          ENDIF          ENDIF
548            
549          mnc_cw_vnat(1,indv) = n          mnc_cw_vnat(1,indv) = n
550          DO ic = 1,MNC_MAX_CATT          DO ic = 1,MNC_MAX_CATT
551            mnc_cw_vtat(n,indv)(ic:ic) = ' '            mnc_cw_vtat(n,indv)(ic:ic) = ' '
# Line 554  C       write(*,*) atype,tname(n1:n2) Line 554  C       write(*,*) atype,tname(n1:n2)
554            mnc_cw_vtat(n,indv)(1:(n2-n1+1)) = tval(n1:n2)            mnc_cw_vtat(n,indv)(1:(n2-n1+1)) = tval(n1:n2)
555          ENDIF          ENDIF
556        ENDIF        ENDIF
557            
558        IF (atype .EQ. 2) THEN        IF (atype .EQ. 2) THEN
559  C       Integer Attribute  C       Integer Attribute
560          n = mnc_cw_vnat(2,indv) + 1          n = mnc_cw_vnat(2,indv) + 1
# Line 576  C       write(*,*) atype,dname(n1:n2) Line 576  C       write(*,*) atype,dname(n1:n2)
576          mnc_cw_vdat(n,indv) = dval          mnc_cw_vdat(n,indv) = dval
577          mnc_cw_vnat(3,indv) = n          mnc_cw_vnat(3,indv) = n
578        ENDIF        ENDIF
579          
580        RETURN        RETURN
581        END        END
582    
# Line 585  CBOP 1 Line 585  CBOP 1
585  C     !ROUTINE: MNC_CW_GET_TILE_NUM  C     !ROUTINE: MNC_CW_GET_TILE_NUM
586    
587  C     !INTERFACE:  C     !INTERFACE:
588        SUBROUTINE MNC_CW_GET_TILE_NUM(        SUBROUTINE MNC_CW_GET_TILE_NUM(
589       I     bi, bj,       I     bi, bj,
590       O     uniq_tnum,       O     uniq_tnum,
591       I     myThid )       I     myThid )
592    
593  C     !DESCRIPTION:  C     !DESCRIPTION:
# Line 613  C     !LOCAL VARIABLES: Line 613  C     !LOCAL VARIABLES:
613    
614  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
615    
616        uniq_tnum = W2_myTileList(bi)        uniq_tnum = W2_myTileList(bi,bj)
617    
618  #else  #else
619    
# Line 635  CBOP 1 Line 635  CBOP 1
635  C     !ROUTINE: MNC_CW_GET_FACE_NUM  C     !ROUTINE: MNC_CW_GET_FACE_NUM
636    
637  C     !INTERFACE:  C     !INTERFACE:
638        SUBROUTINE MNC_CW_GET_FACE_NUM(        SUBROUTINE MNC_CW_GET_FACE_NUM(
639       I     bi, bj,       I     bi, bj,
640       O     uniq_fnum,       O     uniq_fnum,
641       I     myThid )       I     myThid )
642    
643  C     !DESCRIPTION:  C     !DESCRIPTION:
# Line 657  CEOP Line 657  CEOP
657    
658  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
659    
660        uniq_fnum = exch2_myFace( W2_myTileList(bi) )        uniq_fnum = exch2_myFace( W2_myTileList(bi,bj) )
661    
662  #else  #else
663    
# Line 674  CBOP 1 Line 674  CBOP 1
674  C     !ROUTINE: MNC_CW_GET_XYFO  C     !ROUTINE: MNC_CW_GET_XYFO
675    
676  C     !INTERFACE:  C     !INTERFACE:
677        SUBROUTINE MNC_CW_GET_XYFO(        SUBROUTINE MNC_CW_GET_XYFO(
678       I     bi, bj,       I     bi, bj,
679       O     ixoff, iyoff,       O     ixoff, iyoff,
680       I     myThid )       I     myThid )
681    
682  C     !DESCRIPTION:  C     !DESCRIPTION:
# Line 699  C     !LOCAL VARIABLES: Line 699  C     !LOCAL VARIABLES:
699    
700  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
701    
702        uniq_tnum = W2_myTileList(bi)        uniq_tnum = W2_myTileList(bi,bj)
703        ixoff = exch2_tbasex( uniq_tnum )        ixoff = exch2_tbasex( uniq_tnum )
704        iyoff = exch2_tbasey( uniq_tnum )        iyoff = exch2_tbasey( uniq_tnum )
705    
# Line 720  C     uniq_tnum = (jG - 1)*(nPx*nSx) + i Line 720  C     uniq_tnum = (jG - 1)*(nPx*nSx) + i
720  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
721  CBOP 1  CBOP 1
722  C     !ROUTINE: MNC_CW_FILE_AORC  C     !ROUTINE: MNC_CW_FILE_AORC
723          
724  C     !INTERFACE:  C     !INTERFACE:
725        SUBROUTINE MNC_CW_FILE_AORC(        SUBROUTINE MNC_CW_FILE_AORC(
726       I     fname,       I     fname,
727       O     indf,       O     indf,
728       I     lbi, lbj, uniq_tnum,       I     lbi, lbj, uniq_tnum,
729       I     myThid )       I     myThid )
730    
731  C     !DESCRIPTION:  C     !DESCRIPTION:
Legend:
Removed from v.1.33  
changed lines
  Added in v.1.34
  ViewVC Help
Powered by ViewVC 1.1.22