/[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.27 by edhill, Fri Mar 10 22:01:53 2006 UTC revision 1.35 by jmc, Thu Jan 21 01:48:05 2010 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--  File mnc_cwrapper.F:
7    C--   Contents
8    C--   o MNC_CW_ADD_GNAME
9    C--   o MNC_CW_DEL_GNAME
10    C--   o MNC_CW_DUMP
11    C--   o MNC_CW_APPEND_VNAME
12    C--   o MNC_CW_ADD_VNAME
13    C--   o MNC_CW_DEL_VNAME
14    C--   o MNC_CW_ADD_VATTR_TEXT
15    C--   o MNC_CW_ADD_VATTR_INT
16    C--   o MNC_CW_ADD_VATTR_DBL
17    C--   o MNC_CW_ADD_VATTR_ANY
18    C--   o MNC_CW_GET_TILE_NUM
19    C--   o MNC_CW_GET_FACE_NUM
20    C--   o MNC_CW_GET_XYFO
21    C--   o MNC_CW_FILE_AORC
22    
23  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
24  CBOP 0  CBOP 0
25  C     !ROUTINE: MNC_CW_ADD_GNAME  C     !ROUTINE: MNC_CW_ADD_GNAME
26    
27  C     !INTERFACE:  C     !INTERFACE:
28        SUBROUTINE MNC_CW_ADD_GNAME(        SUBROUTINE MNC_CW_ADD_GNAME(
29       I     name,       I     name,
30       I     ndim,       I     ndim,
31       I     dlens,       I     dlens,
32       I     dnames,       I     dnames,
33       I     inds_beg, inds_end,       I     inds_beg, inds_end,
34       I     myThid )       I     myThid )
35    
36  C     !DESCRIPTION:  C     !DESCRIPTION:
37  C     Add a grid name to the MNC convenience wrapper layer.  C     Add a grid name to the MNC convenience wrapper layer.
38          
39  C     !USES:  C     !USES:
40        implicit none        implicit none
41  #include "mnc_common.h"  #include "MNC_COMMON.h"
42  #include "EEPARAMS.h"  #include "EEPARAMS.h"
43    
44  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
# Line 44  C     Functions Line 61  C     Functions
61  C     Check that this name is not already defined  C     Check that this name is not already defined
62        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)
63        IF (indg .GT. 0) THEN        IF (indg .GT. 0) THEN
64          write(msgbuf,'(3a)') 'MNC_CW_ADD_GNAME ERROR: ''', name,          write(msgbuf,'(3a)') 'MNC_CW_ADD_GNAME ERROR: ''', name,
65       &       ''' is already defined'       &       ''' is already defined'
66          CALL print_error(msgbuf, mythid)          CALL print_error(msgbuf, mythid)
67          stop 'ABNORMAL END: S/R MNC_CW_ADD_GNAME'          stop 'ABNORMAL END: S/R MNC_CW_ADD_GNAME'
68        ENDIF        ENDIF
69        CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID, mnc_cw_gname,        CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID, mnc_cw_gname,
70       &     'mnc_cw_gname', indg, myThid)       &     'mnc_cw_gname', indg, myThid)
71    
72        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 91  CBOP 0
91  C     !ROUTINE: MNC_CW_DEL_GNAME  C     !ROUTINE: MNC_CW_DEL_GNAME
92    
93  C     !INTERFACE:  C     !INTERFACE:
94        SUBROUTINE MNC_CW_DEL_GNAME(        SUBROUTINE MNC_CW_DEL_GNAME(
95       I     name,       I     name,
96       I     myThid )       I     myThid )
97    
98  C     !DESCRIPTION:  C     !DESCRIPTION:
99  C     Delete a grid name from the MNC convenience wrapper layer.  C     Delete a grid name from the MNC convenience wrapper layer.
100          
101  C     !USES:  C     !USES:
102        implicit none        implicit none
103  #include "mnc_common.h"  #include "MNC_COMMON.h"
104  #include "EEPARAMS.h"  #include "EEPARAMS.h"
105    
106  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
# Line 122  C     !INTERFACE: Line 139  C     !INTERFACE:
139  C     !DESCRIPTION:  C     !DESCRIPTION:
140  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
141  C     tables for the convenience wrapper section.  C     tables for the convenience wrapper section.
142          
143  C     !USES:  C     !USES:
144        implicit none        implicit none
145  #include "mnc_common.h"  #include "MNC_COMMON.h"
146  #include "SIZE.h"  #include "SIZE.h"
147  #include "EEPARAMS.h"  #include "EEPARAMS.h"
148  #include "PARAMS.h"  #include "PARAMS.h"
# Line 141  C     !LOCAL VARIABLES: Line 158  C     !LOCAL VARIABLES:
158        character s1*(NBLNK), blnk*(NBLNK)        character s1*(NBLNK), blnk*(NBLNK)
159    
160        _BEGIN_MASTER(myThid)        _BEGIN_MASTER(myThid)
161          
162        DO i = 1,NBLNK        DO i = 1,NBLNK
163          blnk(i:i) = ' '          blnk(i:i) = ' '
164        ENDDO        ENDDO
165          
166        s1(1:NBLNK) = blnk(1:NBLNK)        s1(1:NBLNK) = blnk(1:NBLNK)
167        write(s1,'(a5,a)') 'MNC: ',        write(s1,'(a5,a)') 'MNC: ',
168       &     'The currently defined Grid Types are:'       &     'The currently defined Grid Types are:'
# Line 153  C     !LOCAL VARIABLES: Line 170  C     !LOCAL VARIABLES:
170       &     s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)       &     s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
171        ntot = 0        ntot = 0
172        DO j = 1,MNC_MAX_ID        DO j = 1,MNC_MAX_ID
173          IF (mnc_cw_gname(j)(1:MNC_MAX_CHAR)          IF (mnc_cw_gname(j)(1:MNC_MAX_CHAR)
174       &       .NE. mnc_blank_name(1:MNC_MAX_CHAR)) THEN       &       .NE. mnc_blank_name(1:MNC_MAX_CHAR)) THEN
175              
176            ntot = ntot + 1            ntot = ntot + 1
177            s1(1:NBLNK) = blnk(1:NBLNK)            s1(1:NBLNK) = blnk(1:NBLNK)
178            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)')
179       &         'MNC: ',       &         'MNC: ',
180       &         j, ntot, ' : ', mnc_cw_gname(j)(1:20), mnc_cw_ndim(j),       &         j, ntot, ' : ', mnc_cw_gname(j)(1:20), mnc_cw_ndim(j),
181       &         ' : ', (mnc_cw_dims(i,j), i=1,5),       &         ' : ', (mnc_cw_dims(i,j), i=1,5),
182       &         '  | ', (mnc_cw_is(i,j), i=1,5),       &         '  | ', (mnc_cw_is(i,j), i=1,5),
183       &         '  | ', (mnc_cw_ie(i,j), i=1,5),       &         '  | ', (mnc_cw_ie(i,j), i=1,5),
184       &         '  | ', (mnc_cw_dn(i,j)(1:7), i=1,5)       &         '  | ', (mnc_cw_dn(i,j)(1:7), i=1,5)
185            CALL PRINT_MESSAGE(            CALL PRINT_MESSAGE(
186       &         s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)       &         s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
187              
188          ENDIF          ENDIF
189        ENDDO        ENDDO
190          
191        s1(1:NBLNK) = blnk(1:NBLNK)        s1(1:NBLNK) = blnk(1:NBLNK)
192        write(s1,'(a5,a)') 'MNC: ',        write(s1,'(a5,a)') 'MNC: ',
193       &     'The currently defined Variable Types are:'       &     'The currently defined Variable Types are:'
# Line 178  C     !LOCAL VARIABLES: Line 195  C     !LOCAL VARIABLES:
195       &     s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)       &     s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
196        ntot = 0        ntot = 0
197        DO j = 1,MNC_MAX_ID        DO j = 1,MNC_MAX_ID
198          IF (mnc_cw_vname(j)(1:MNC_MAX_CHAR)          IF (mnc_cw_vname(j)(1:MNC_MAX_CHAR)
199       &       .NE. mnc_blank_name(1:MNC_MAX_CHAR)) THEN       &       .NE. mnc_blank_name(1:MNC_MAX_CHAR)) THEN
200              
201            ntot = ntot + 1            ntot = ntot + 1
202            s1(1:NBLNK) = blnk(1:NBLNK)            s1(1:NBLNK) = blnk(1:NBLNK)
203            write(s1,'(a5,2i5,a3,a25,a3,i4)') 'MNC: ',            write(s1,'(a5,2i5,a3,a25,a3,i4)') 'MNC: ',
204       &         j, ntot, ' | ',       &         j, ntot, ' | ',
205       &         mnc_cw_vname(j)(1:20), ' | ', mnc_cw_vgind(j)       &         mnc_cw_vname(j)(1:20), ' | ', mnc_cw_vgind(j)
206            CALL PRINT_MESSAGE(            CALL PRINT_MESSAGE(
207       &         s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)       &         s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
208              
209            DO i = 1,mnc_cw_vnat(1,j)            DO i = 1,mnc_cw_vnat(1,j)
210              s1(1:NBLNK) = blnk(1:NBLNK)              s1(1:NBLNK) = blnk(1:NBLNK)
211              write(s1,'(a5,a14,i4,a3,a25,a3,a55)')              write(s1,'(a5,a14,i4,a3,a25,a3,a55)')
212       &           'MNC: ','      text_at:',i,       &           'MNC: ','      text_at:',i,
213       &           ' : ', mnc_cw_vtnm(i,j)(1:25), ' : ',       &           ' : ', mnc_cw_vtnm(i,j)(1:25), ' : ',
214       &           mnc_cw_vtat(i,j)(1:MNC_MAX_CHAR)       &           mnc_cw_vtat(i,j)(1:MNC_MAX_CHAR)
215              CALL PRINT_MESSAGE(              CALL PRINT_MESSAGE(
# Line 200  C     !LOCAL VARIABLES: Line 217  C     !LOCAL VARIABLES:
217            ENDDO            ENDDO
218            DO i = 1,mnc_cw_vnat(2,j)            DO i = 1,mnc_cw_vnat(2,j)
219              s1(1:NBLNK) = blnk(1:NBLNK)              s1(1:NBLNK) = blnk(1:NBLNK)
220              write(s1,'(a5,a14,i4,a3,a25,a3,i20)')              write(s1,'(a5,a14,i4,a3,a25,a3,i20)')
221       &           'MNC: ','      int__at:',i,       &           'MNC: ','      int__at:',i,
222       &           ' : ', mnc_cw_vinm(i,j)(1:25), ' : ',       &           ' : ', mnc_cw_vinm(i,j)(1:25), ' : ',
223       &           mnc_cw_viat(i,j)       &           mnc_cw_viat(i,j)
224              CALL PRINT_MESSAGE(              CALL PRINT_MESSAGE(
# Line 209  C     !LOCAL VARIABLES: Line 226  C     !LOCAL VARIABLES:
226            ENDDO            ENDDO
227            DO i = 1,mnc_cw_vnat(3,j)            DO i = 1,mnc_cw_vnat(3,j)
228              s1(1:NBLNK) = blnk(1:NBLNK)              s1(1:NBLNK) = blnk(1:NBLNK)
229              write(s1,'(a5,a14,i4,a3,a25,a3,f25.10)')              write(s1,'(a5,a14,i4,a3,a25,a3,f25.10)')
230       &           'MNC: ','      dbl__at:',i,       &           'MNC: ','      dbl__at:',i,
231       &           ' : ', mnc_cw_vdnm(i,j)(1:25), ' : ',       &           ' : ', mnc_cw_vdnm(i,j)(1:25), ' : ',
232       &           mnc_cw_vdat(i,j)       &           mnc_cw_vdat(i,j)
233              CALL PRINT_MESSAGE(              CALL PRINT_MESSAGE(
234       &           s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)       &           s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
235          ENDDO          ENDDO
236            
237          ENDIF          ENDIF
238        ENDDO        ENDDO
239        IF (ntot .EQ. 0) THEN        IF (ntot .EQ. 0) THEN
# Line 225  C     !LOCAL VARIABLES: Line 242  C     !LOCAL VARIABLES:
242          CALL PRINT_MESSAGE(          CALL PRINT_MESSAGE(
243       &       s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)       &       s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
244        ENDIF        ENDIF
245          
246        _END_MASTER(myThid)        _END_MASTER(myThid)
247    
248        RETURN        RETURN
# Line 236  CBOP 0 Line 253  CBOP 0
253  C     !ROUTINE: MNC_CW_APPEND_VNAME  C     !ROUTINE: MNC_CW_APPEND_VNAME
254    
255  C     !INTERFACE:  C     !INTERFACE:
256        SUBROUTINE MNC_CW_APPEND_VNAME(        SUBROUTINE MNC_CW_APPEND_VNAME(
257       I     vname,       I     vname,
258       I     gname,       I     gname,
259       I     bi_dim, bj_dim,       I     bi_dim, bj_dim,
260       I     myThid )       I     myThid )
261    
262  C     !DESCRIPTION:  C     !DESCRIPTION:
263  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
264  C     variable type.  Calls MNC\_CW\_ADD\_VNAME().  C     variable type.  Calls MNC\_CW\_ADD\_VNAME().
265      
266  C     !USES:  C     !USES:
267        implicit none        implicit none
268  #include "mnc_common.h"  #include "MNC_COMMON.h"
269    
270  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
271        integer myThid, bi_dim, bj_dim        integer myThid, bi_dim, bj_dim
# Line 273  CBOP 0 Line 290  CBOP 0
290  C     !ROUTINE: MNC_CW_ADD_VNAME  C     !ROUTINE: MNC_CW_ADD_VNAME
291    
292  C     !INTERFACE:  C     !INTERFACE:
293        SUBROUTINE MNC_CW_ADD_VNAME(        SUBROUTINE MNC_CW_ADD_VNAME(
294       I     vname,       I     vname,
295       I     gname,       I     gname,
296       I     bi_dim, bj_dim,       I     bi_dim, bj_dim,
297       I     myThid )       I     myThid )
298    
299  C     !DESCRIPTION:  C     !DESCRIPTION:
300  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
301  C     association between a variable type name and the following items:  C     association between a variable type name and the following items:
302  C     \begin{center}  C     \begin{center}
# Line 289  C         grid type  &  defines the in-m Line 306  C         grid type  &  defines the in-m
306  C         \texttt{bi,bj} dimensions  &  tiling indices, if present  \\\hline  C         \texttt{bi,bj} dimensions  &  tiling indices, if present  \\\hline
307  C       \end{tabular}  C       \end{tabular}
308  C     \end{center}  C     \end{center}
309      
310  C     !USES:  C     !USES:
311        implicit none        implicit none
312  #include "mnc_common.h"  #include "MNC_COMMON.h"
313  #include "EEPARAMS.h"  #include "EEPARAMS.h"
314    
315  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
# Line 315  C     Functions Line 332  C     Functions
332  C     Check that this vname is not already defined  C     Check that this vname is not already defined
333        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)
334        IF (indv .GT. 0) THEN        IF (indv .GT. 0) THEN
335          write(msgbuf,'(3a)') 'MNC_CW_ADD_VNAME ERROR: ''',          write(msgbuf,'(3a)') 'MNC_CW_ADD_VNAME ERROR: ''',
336       &       vname(nvf:nvl), ''' is already defined'       &       vname(nvf:nvl), ''' is already defined'
337          CALL print_error(msgbuf, mythid)          CALL print_error(msgbuf, mythid)
338          stop 'ABNORMAL END: S/R MNC_CW_ADD_VNAME'          stop 'ABNORMAL END: S/R MNC_CW_ADD_VNAME'
339        ENDIF        ENDIF
340        CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID, mnc_cw_vname,        CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID, mnc_cw_vname,
341       &     'mnc_cw_vname', indv, myThid)       &     'mnc_cw_vname', indv, myThid)
342    
343  C     Check that gname exists  C     Check that gname exists
344        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)
345        IF (indg .LT. 1) THEN        IF (indg .LT. 1) THEN
346          write(msgbuf,'(3a)') 'MNC_CW_ADD_VNAME ERROR: ''',          write(msgbuf,'(3a)') 'MNC_CW_ADD_VNAME ERROR: ''',
347       &       gname(ngf:ngl), ''' is not defined'       &       gname(ngf:ngl), ''' is not defined'
348          CALL print_error(msgbuf, mythid)          CALL print_error(msgbuf, mythid)
349          stop 'ABNORMAL END: S/R MNC_CW_ADD_VNAME'          stop 'ABNORMAL END: S/R MNC_CW_ADD_VNAME'
# Line 353  CBOP 0 Line 370  CBOP 0
370  C     !ROUTINE: MNC_CW_DEL_VNAME  C     !ROUTINE: MNC_CW_DEL_VNAME
371    
372  C     !INTERFACE:  C     !INTERFACE:
373        SUBROUTINE MNC_CW_DEL_VNAME(        SUBROUTINE MNC_CW_DEL_VNAME(
374       I     vname,       I     vname,
375       I     myThid )       I     myThid )
376    
377  C     !DESCRIPTION:  C     !DESCRIPTION:
378  C     Delete a variable type from the MNC CW layer.  C     Delete a variable type from the MNC CW layer.
379      
380  C     !USES:  C     !USES:
381        implicit none        implicit none
382  #include "mnc_common.h"  #include "MNC_COMMON.h"
383  #include "EEPARAMS.h"  #include "EEPARAMS.h"
384    
385  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
# Line 392  C---+----1----+----2----+----3----+----4 Line 409  C---+----1----+----2----+----3----+----4
409  CBOP  CBOP
410  C     !ROUTINE: MNC_CW_ADD_VATTR_TEXT  C     !ROUTINE: MNC_CW_ADD_VATTR_TEXT
411  C     !INTERFACE:  C     !INTERFACE:
412        SUBROUTINE MNC_CW_ADD_VATTR_TEXT(        SUBROUTINE MNC_CW_ADD_VATTR_TEXT(
413       I     vname, tname, tval,       I     vname, tname, tval,
414       I     myThid )       I     myThid )
415    
416  C     !DESCRIPTION:  C     !DESCRIPTION:
417  C     Add a text attribute  C     Add a text attribute
418          
419  C     !USES:  C     !USES:
420        implicit none        implicit none
421    
# Line 418  C---+----1----+----2----+----3----+----4 Line 435  C---+----1----+----2----+----3----+----4
435  CBOP  CBOP
436  C     !ROUTINE: MNC_CW_ADD_VATTR_INT  C     !ROUTINE: MNC_CW_ADD_VATTR_INT
437  C     !INTERFACE:  C     !INTERFACE:
438        SUBROUTINE MNC_CW_ADD_VATTR_INT(        SUBROUTINE MNC_CW_ADD_VATTR_INT(
439       I     vname, iname, ival,       I     vname, iname, ival,
440       I     myThid )       I     myThid )
441    
442  C     !DESCRIPTION:  C     !DESCRIPTION:
# Line 443  C---+----1----+----2----+----3----+----4 Line 460  C---+----1----+----2----+----3----+----4
460  CBOP  CBOP
461  C !ROUTINE: MNC_CW_ADD_VATTR_DBL  C !ROUTINE: MNC_CW_ADD_VATTR_DBL
462  C !INTERFACE:  C !INTERFACE:
463        SUBROUTINE MNC_CW_ADD_VATTR_DBL(        SUBROUTINE MNC_CW_ADD_VATTR_DBL(
464       I     vname, dname, dval,       I     vname, dname, dval,
465       I     myThid )       I     myThid )
466    
467  C     !DESCRIPTION:  C     !DESCRIPTION:
468  C     Add double-precision real attribute  C     Add double-precision real attribute
469    
470  C     !USES:  C     !USES:
471        implicit none        implicit none
# Line 469  CBOP 1 Line 486  CBOP 1
486  C     !ROUTINE: MNC_CW_ADD_VATTR_ANY  C     !ROUTINE: MNC_CW_ADD_VATTR_ANY
487    
488  C     !INTERFACE:  C     !INTERFACE:
489        SUBROUTINE MNC_CW_ADD_VATTR_ANY(        SUBROUTINE MNC_CW_ADD_VATTR_ANY(
490       I     vname,       I     vname,
491       I     atype,       I     atype,
492       I     tname, iname, dname,       I     tname, iname, dname,
493       I     tval,  ival,  dval,       I     tval,  ival,  dval,
494       I     myThid )       I     myThid )
495    
496  C     !DESCRIPTION:  C     !DESCRIPTION:
497    
498  C     !USES:  C     !USES:
499        implicit none        implicit none
500  #include "mnc_common.h"  #include "MNC_COMMON.h"
501  #include "EEPARAMS.h"  #include "EEPARAMS.h"
502    
503  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
# Line 494  C     !INPUT PARAMETERS: Line 511  C     !INPUT PARAMETERS:
511  CEOP  CEOP
512    
513  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
514        integer n, nvf,nvl, n1,n2, indv        integer n, nvf,nvl, n1,n2, indv, ic
515        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
516    
517  C     Functions  C     Functions
# Line 506  C     Functions Line 523  C     Functions
523  C     Check that vname is defined  C     Check that vname is defined
524        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)
525        IF (indv .LT. 1) THEN        IF (indv .LT. 1) THEN
526          write(msgbuf,'(3a)') 'MNC_CW_ADD_VATTR_ANY ERROR: ''',          write(msgbuf,'(3a)') 'MNC_CW_ADD_VATTR_ANY ERROR: ''',
527       &       vname(nvf:nvl), ''' is not defined'       &       vname(nvf:nvl), ''' is not defined'
528          CALL print_error(msgbuf, mythid)          CALL print_error(msgbuf, mythid)
529          stop 'ABNORMAL END: S/R MNC_CW_ADD_VATTR_ANY'          stop 'ABNORMAL END: S/R MNC_CW_ADD_VATTR_ANY'
# Line 517  C       Text Attribute Line 534  C       Text Attribute
534          n = mnc_cw_vnat(1,indv) + 1          n = mnc_cw_vnat(1,indv) + 1
535          n1 = IFNBLNK(tname)          n1 = IFNBLNK(tname)
536          n2 = ILNBLNK(tname)          n2 = ILNBLNK(tname)
537            IF ((n2-n1+1) .GT. MNC_MAX_CHAR) THEN
538              write(msgbuf,'(3a,i6,2a)')
539         &         'MNC_CW_ADD_VATTR_ANY WARNING: attribute name ''',
540         &         tname(n1:n2), ''' has more than ', MNC_MAX_CHAR,
541         &         ' characters and has been truncated to fit--please',
542         &         'use a smaller name or increase MNC_MAX_CHAR'
543              CALL PRINT_MESSAGE( msgbuf, errorMessageUnit,
544         &                        SQUEEZE_RIGHT , myThid)
545    C         MNC_MAX_CHAR = n2 - n1 + 1
546              n2 = MNC_MAX_CHAR + n1 - 1
547            ENDIF
548  C       write(*,*) atype,tname(n1:n2)  C       write(*,*) atype,tname(n1:n2)
549          mnc_cw_vtnm(n,indv)(1:MNC_MAX_CHAR) =          mnc_cw_vtnm(n,indv)(1:MNC_MAX_CHAR) =
550       &       mnc_blank_name(1:MNC_MAX_CHAR)       &       mnc_blank_name(1:MNC_MAX_CHAR)
551          mnc_cw_vtnm(n,indv)(1:(n2-n1+1)) = tname(n1:n2)          mnc_cw_vtnm(n,indv)(1:(n2-n1+1)) = tname(n1:n2)
552    
553          n1 = IFNBLNK(tval)          n1 = IFNBLNK(tval)
554          n2 = ILNBLNK(tval)          n2 = ILNBLNK(tval)
555          IF ((n1 .EQ. 0) .OR. (n2 .EQ. 0)) THEN          IF ((n2-n1+1) .GT. MNC_MAX_CATT) THEN
556            mnc_cw_vtat(n,indv)(1:MNC_MAX_CHAR) =            write(msgbuf,'(3a,i6,2a)')
557       &         mnc_blank_name(1:MNC_MAX_CHAR)                 &         'MNC_CW_ADD_VATTR_ANY WARNING: attribute value ''',
558            mnc_cw_vnat(1,indv) = n       &         tval(n1:n2), ''' has more than ', MNC_MAX_CATT,
559          ELSE       &         ' characters and has been truncated to fit--please',
560            mnc_cw_vtat(n,indv)(1:MNC_MAX_CHAR) =       &         'use a smaller name or increase MNC_MAX_CATT'
561       &         mnc_blank_name(1:MNC_MAX_CHAR)            CALL PRINT_MESSAGE( msgbuf, errorMessageUnit,
562         &                        SQUEEZE_RIGHT , myThid)
563              n2 = MNC_MAX_CATT + n1 - 1
564            ENDIF
565    
566            mnc_cw_vnat(1,indv) = n
567            DO ic = 1,MNC_MAX_CATT
568              mnc_cw_vtat(n,indv)(ic:ic) = ' '
569            ENDDO
570            IF ((n1 .NE. 0) .AND. (n2 .NE. 0)) THEN
571            mnc_cw_vtat(n,indv)(1:(n2-n1+1)) = tval(n1:n2)            mnc_cw_vtat(n,indv)(1:(n2-n1+1)) = tval(n1:n2)
           mnc_cw_vnat(1,indv) = n  
572          ENDIF          ENDIF
573        ENDIF        ENDIF
574            
575        IF (atype .EQ. 2) THEN        IF (atype .EQ. 2) THEN
576  C       Integer Attribute  C       Integer Attribute
577          n = mnc_cw_vnat(2,indv) + 1          n = mnc_cw_vnat(2,indv) + 1
# Line 556  C       write(*,*) atype,dname(n1:n2) Line 593  C       write(*,*) atype,dname(n1:n2)
593          mnc_cw_vdat(n,indv) = dval          mnc_cw_vdat(n,indv) = dval
594          mnc_cw_vnat(3,indv) = n          mnc_cw_vnat(3,indv) = n
595        ENDIF        ENDIF
596          
597        RETURN        RETURN
598        END        END
599    
# Line 565  CBOP 1 Line 602  CBOP 1
602  C     !ROUTINE: MNC_CW_GET_TILE_NUM  C     !ROUTINE: MNC_CW_GET_TILE_NUM
603    
604  C     !INTERFACE:  C     !INTERFACE:
605        SUBROUTINE MNC_CW_GET_TILE_NUM(        SUBROUTINE MNC_CW_GET_TILE_NUM(
606       I     bi, bj,       I     bi, bj,
607       O     uniq_tnum,       O     uniq_tnum,
608       I     myThid )       I     myThid )
609    
610  C     !DESCRIPTION:  C     !DESCRIPTION:
# Line 577  C     !USES: Line 614  C     !USES:
614  #include "EEPARAMS.h"  #include "EEPARAMS.h"
615  #include "SIZE.h"  #include "SIZE.h"
616  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
617    #include "W2_EXCH2_SIZE.h"
618  #include "W2_EXCH2_TOPOLOGY.h"  #include "W2_EXCH2_TOPOLOGY.h"
 #include "W2_EXCH2_PARAMS.h"  
619  #endif  #endif
620    
621  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
# Line 593  C     !LOCAL VARIABLES: Line 630  C     !LOCAL VARIABLES:
630    
631  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
632    
633        uniq_tnum = W2_myTileList(bi)        uniq_tnum = W2_myTileList(bi,bj)
634    
635  #else  #else
636    
# Line 615  CBOP 1 Line 652  CBOP 1
652  C     !ROUTINE: MNC_CW_GET_FACE_NUM  C     !ROUTINE: MNC_CW_GET_FACE_NUM
653    
654  C     !INTERFACE:  C     !INTERFACE:
655        SUBROUTINE MNC_CW_GET_FACE_NUM(        SUBROUTINE MNC_CW_GET_FACE_NUM(
656       I     bi, bj,       I     bi, bj,
657       O     uniq_fnum,       O     uniq_fnum,
658       I     myThid )       I     myThid )
659    
660  C     !DESCRIPTION:  C     !DESCRIPTION:
# Line 627  C     !USES: Line 664  C     !USES:
664  #include "EEPARAMS.h"  #include "EEPARAMS.h"
665  #include "SIZE.h"  #include "SIZE.h"
666  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
667    #include "W2_EXCH2_SIZE.h"
668  #include "W2_EXCH2_TOPOLOGY.h"  #include "W2_EXCH2_TOPOLOGY.h"
 #include "W2_EXCH2_PARAMS.h"  
669  #endif  #endif
670    
671  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
# Line 637  CEOP Line 674  CEOP
674    
675  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
676    
677        uniq_fnum = exch2_myFace( W2_myTileList(bi) )        uniq_fnum = exch2_myFace( W2_myTileList(bi,bj) )
678    
679  #else  #else
680    
# Line 654  CBOP 1 Line 691  CBOP 1
691  C     !ROUTINE: MNC_CW_GET_XYFO  C     !ROUTINE: MNC_CW_GET_XYFO
692    
693  C     !INTERFACE:  C     !INTERFACE:
694        SUBROUTINE MNC_CW_GET_XYFO(        SUBROUTINE MNC_CW_GET_XYFO(
695       I     bi, bj,       I     bi, bj,
696       O     ixoff, iyoff,       O     ixoff, iyoff,
697       I     myThid )       I     myThid )
698    
699  C     !DESCRIPTION:  C     !DESCRIPTION:
# Line 666  C     !USES: Line 703  C     !USES:
703  #include "EEPARAMS.h"  #include "EEPARAMS.h"
704  #include "SIZE.h"  #include "SIZE.h"
705  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
706    #include "W2_EXCH2_SIZE.h"
707  #include "W2_EXCH2_TOPOLOGY.h"  #include "W2_EXCH2_TOPOLOGY.h"
 #include "W2_EXCH2_PARAMS.h"  
708  #endif  #endif
709    
710  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
# Line 675  C     !INPUT PARAMETERS: Line 712  C     !INPUT PARAMETERS:
712  CEOP  CEOP
713    
714  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
715    #ifdef ALLOW_EXCH2
716        integer uniq_tnum        integer uniq_tnum
717    #endif
718    
719  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
720    
721        uniq_tnum = W2_myTileList(bi)        uniq_tnum = W2_myTileList(bi,bj)
722        ixoff = exch2_tbasex( uniq_tnum )        ixoff = exch2_tbasex( uniq_tnum )
723        iyoff = exch2_tbasey( uniq_tnum )        iyoff = exch2_tbasey( uniq_tnum )
724    
# Line 700  C     uniq_tnum = (jG - 1)*(nPx*nSx) + i Line 739  C     uniq_tnum = (jG - 1)*(nPx*nSx) + i
739  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
740  CBOP 1  CBOP 1
741  C     !ROUTINE: MNC_CW_FILE_AORC  C     !ROUTINE: MNC_CW_FILE_AORC
742          
743  C     !INTERFACE:  C     !INTERFACE:
744        SUBROUTINE MNC_CW_FILE_AORC(        SUBROUTINE MNC_CW_FILE_AORC(
745       I     fname,       I     fname,
746       O     indf,       O     indf,
747       I     lbi, lbj, uniq_tnum,       I     lbi, lbj, uniq_tnum,
748       I     myThid )       I     myThid )
749    
750  C     !DESCRIPTION:  C     !DESCRIPTION:
# Line 714  C     and, if not, creating a new file. Line 753  C     and, if not, creating a new file.
753    
754  C     !USES:  C     !USES:
755        implicit none        implicit none
756  #include "netcdf.inc"  #include "MNC_COMMON.h"
 #include "mnc_common.h"  
757  #include "EEPARAMS.h"  #include "EEPARAMS.h"
758    #include "netcdf.inc"
759    
760  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
761        integer myThid, indf, lbi, lbj, uniq_tnum        integer myThid, indf, lbi, lbj, uniq_tnum
Legend:
Removed from v.1.27  
changed lines
  Added in v.1.35
  ViewVC Help
Powered by ViewVC 1.1.22