/[MITgcm]/MITgcm/pkg/diagnostics/diagnostics_out.F
ViewVC logotype

Diff of /MITgcm/pkg/diagnostics/diagnostics_out.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.14 by edhill, Wed May 25 04:03:09 2005 UTC revision 1.21 by edhill, Tue Sep 6 17:45:19 2005 UTC
# Line 9  C     !ROUTINE: DIAGNOSTICS_OUT Line 9  C     !ROUTINE: DIAGNOSTICS_OUT
9    
10  C     !INTERFACE:  C     !INTERFACE:
11        SUBROUTINE  DIAGNOSTICS_OUT(        SUBROUTINE  DIAGNOSTICS_OUT(
12       I     listnum,       I     listId,
13       I     myIter,       I     myIter,
14       I     myTime,       I     myTime,
15       I     myThid )       I     myThid )
16    
17  C     !DESCRIPTION:  C     !DESCRIPTION:
18  C     Write output for diagnostics fields.  C     Write output for diagnostics fields.
19          
20  C     !USES:  C     !USES:
21        IMPLICIT NONE        IMPLICIT NONE
22  #include "SIZE.h"  #include "SIZE.h"
# Line 35  C     !USES: Line 35  C     !USES:
35    
36    
37  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
38  C     listnum :: Diagnostics list number being written  C     listId  :: Diagnostics list number being written
39  C     myIter  :: current iteration number  C     myIter  :: current iteration number
40    C     myTime  :: current time of simulation (s)
41  C     myThid  :: my Thread Id number  C     myThid  :: my Thread Id number
42        _RL     myTime        _RL     myTime
43        INTEGER listnum, myIter, myThid        INTEGER listId, myIter, myThid
44  CEOP  CEOP
45    
46  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
47        INTEGER i, j, k, m, n, bi, bj  C     i,j,k :: loop indices
48    C     md    :: field number in the list "listId".
49    C     ndId  :: diagnostics  Id number (in available diagnostics list)
50    C     mate  :: counter mate Id number (in available diagnostics list)
51    C     ip    :: diagnostics  pointer to storage array
52    C     im    :: counter-mate pointer to storage array
53          INTEGER i, j, k
54          INTEGER bi, bj
55          INTEGER md, ndId, ip, im
56          INTEGER mate, mVec
57        CHARACTER*8 parms1        CHARACTER*8 parms1
58        CHARACTER*3 mate_index        CHARACTER*3 mate_index
       INTEGER mate, mVec  
59        _RL qtmp1(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr+Nrphys,nSx,nSy)        _RL qtmp1(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr+Nrphys,nSx,nSy)
60        _RL undef, getcon        _RL undef, getcon
61        EXTERNAL getcon        EXTERNAL getcon
62        INTEGER ILNBLNK        INTEGER ILNBLNK
63        EXTERNAL ILNBLNK        EXTERNAL ILNBLNK
64        INTEGER ilen        INTEGER ilen
65          INTEGER nlevsout
66    
67        INTEGER ioUnit        INTEGER ioUnit
68        CHARACTER*(MAX_LEN_FNAM) fn        CHARACTER*(MAX_LEN_FNAM) fn
# Line 62  C     !LOCAL VARIABLES: Line 72  C     !LOCAL VARIABLES:
72  #ifdef ALLOW_MNC  #ifdef ALLOW_MNC
73        INTEGER ii        INTEGER ii
74        CHARACTER*(MAX_LEN_FNAM) diag_mnc_bn        CHARACTER*(MAX_LEN_FNAM) diag_mnc_bn
       CHARACTER*(5) ctmp  
75        INTEGER CW_DIMS, NLEN        INTEGER CW_DIMS, NLEN
76        PARAMETER ( CW_DIMS = 10 )        PARAMETER ( CW_DIMS = 10 )
77        PARAMETER ( NLEN    = 80 )        PARAMETER ( NLEN    = 80 )
# Line 70  C     !LOCAL VARIABLES: Line 79  C     !LOCAL VARIABLES:
79        CHARACTER*(NLEN) dn(CW_DIMS)        CHARACTER*(NLEN) dn(CW_DIMS)
80        CHARACTER*(NLEN) d_cw_name        CHARACTER*(NLEN) d_cw_name
81        CHARACTER*(NLEN) dn_blnk        CHARACTER*(NLEN) dn_blnk
82    #ifdef DIAG_MNC_COORD_NEEDSWORK
83          CHARACTER*(5) ctmp
84        _RS ztmp(Nr+Nrphys)        _RS ztmp(Nr+Nrphys)
85    #endif
86  #endif /*  ALLOW_MNC  */  #endif /*  ALLOW_MNC  */
87    
88  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
# Line 79  C---+----1----+----2----+----3----+----4 Line 91  C---+----1----+----2----+----3----+----4
91        undef = getcon('UNDEF')        undef = getcon('UNDEF')
92        glf = globalFiles        glf = globalFiles
93        WRITE(suff,'(I10.10)') myIter        WRITE(suff,'(I10.10)') myIter
94        ilen = ILNBLNK(fnames(listnum))        ilen = ILNBLNK(fnames(listId))
95        WRITE( fn, '(A,A,A)' ) fnames(listnum)(1:ilen),'.',suff(1:10)        WRITE( fn, '(A,A,A)' ) fnames(listId)(1:ilen),'.',suff(1:10)
96    
97  #ifdef ALLOW_MNC  #ifdef ALLOW_MNC
98        IF (useMNC .AND. diag_mnc) THEN        IF (useMNC .AND. diag_mnc) THEN
# Line 90  C---+----1----+----2----+----3----+----4 Line 102  C---+----1----+----2----+----3----+----4
102          DO i = 1,NLEN          DO i = 1,NLEN
103            dn_blnk(i:i) = ' '            dn_blnk(i:i) = ' '
104          ENDDO          ENDDO
105          WRITE( diag_mnc_bn, '(A)' ) fnames(listnum)(1:ilen)          WRITE( diag_mnc_bn, '(A)' ) fnames(listId)(1:ilen)
106    
107  C       Update the record dimension by writing the iteration number  C       Update the record dimension by writing the iteration number
108          CALL MNC_CW_SET_UDIM(diag_mnc_bn, -1, myThid)          CALL MNC_CW_SET_UDIM(diag_mnc_bn, -1, myThid)
109          CALL MNC_CW_RL_W_S('D',diag_mnc_bn,0,0,'T',myTime,myThid)          CALL MNC_CW_RL_W_S('D',diag_mnc_bn,0,0,'T',myTime,myThid)
110          CALL MNC_CW_SET_UDIM(diag_mnc_bn, 0, myThid)          CALL MNC_CW_SET_UDIM(diag_mnc_bn, 0, myThid)
111            CALL MNC_CW_I_W_S('I',diag_mnc_bn,1,1,'iter',myIter,myThid)
112    
113    C       NOTE: at some point it would be a good idea to add a time_bounds
114    C       variable that has dimension (2,T) and clearly denotes the
115    C       beginning and ending times for each diagnostics period
116    
117          dn(1)(1:NLEN) = dn_blnk(1:NLEN)          dn(1)(1:NLEN) = dn_blnk(1:NLEN)
118          WRITE(dn(1),'(a,i6.6)') 'Zmd', nlevels(listnum)          WRITE(dn(1),'(a,i6.6)') 'Zmd', nlevels(listId)
119          dim(1) = nlevels(listnum)          dim(1) = nlevels(listId)
120          ib(1)  = 1          ib(1)  = 1
121          ie(1)  = nlevels(listnum)          ie(1)  = nlevels(listId)
122    
123          CALL MNC_CW_ADD_GNAME('diag_levels', 1,          CALL MNC_CW_ADD_GNAME('diag_levels', 1,
124       &       dim, dn, ib, ie, myThid)       &       dim, dn, ib, ie, myThid)
# Line 112  C       Update the record dimension by w Line 129  C       Update the record dimension by w
129       &       myThid)       &       myThid)
130                    
131          CALL MNC_CW_RL_W('D',diag_mnc_bn,0,0,          CALL MNC_CW_RL_W('D',diag_mnc_bn,0,0,
132       &       'diag_levels', levs(1,listnum), myThid)       &       'diag_levels', levs(1,listId), myThid)
133    
134          CALL MNC_CW_DEL_VNAME('diag_levels', myThid)          CALL MNC_CW_DEL_VNAME('diag_levels', myThid)
135          CALL MNC_CW_DEL_GNAME('diag_levels', myThid)          CALL MNC_CW_DEL_GNAME('diag_levels', myThid)
136    
137    #ifdef DIAG_MNC_COORD_NEEDSWORK
138    C       This part has been placed in an #ifdef because, as its currently
139    C       written, it will only work with variables defined on a dynamics
140    C       grid.  As we start using diagnostics for physics grids, ice
141    C       levels, land levels, etc. the different vertical coordinate
142    C       dimensions will have to be taken into account.
143    
144  C       Now define:  Zmdxxxxxx, Zudxxxxxx, Zldxxxxxx  C       Now define:  Zmdxxxxxx, Zudxxxxxx, Zldxxxxxx
145          ctmp(1:5) = 'mul  '          ctmp(1:5) = 'mul  '
146          DO i = 1,3          DO i = 1,3
147            dn(1)(1:NLEN) = dn_blnk(1:NLEN)            dn(1)(1:NLEN) = dn_blnk(1:NLEN)
148            WRITE(dn(1),'(3a,i6.6)') 'Z',ctmp(i:i),'d',nlevels(listnum)            WRITE(dn(1),'(3a,i6.6)') 'Z',ctmp(i:i),'d',nlevels(listId)
149            CALL MNC_CW_ADD_GNAME(dn(1), 1, dim, dn, ib, ie, myThid)            CALL MNC_CW_ADD_GNAME(dn(1), 1, dim, dn, ib, ie, myThid)
150            CALL MNC_CW_ADD_VNAME(dn(1), dn(1), 0,0, myThid)            CALL MNC_CW_ADD_VNAME(dn(1), dn(1), 0,0, myThid)
151    
# Line 134  C                          + rC(INT(CEIL Line 158  C                          + rC(INT(CEIL
158  C                        / ( levs(j,l) - FLOOR(levs(j,l)) )  C                        / ( levs(j,l) - FLOOR(levs(j,l)) )
159  C         for averaged levels.  C         for averaged levels.
160            IF (i .EQ. 1) THEN            IF (i .EQ. 1) THEN
161              DO j = 1,nlevels(listnum)              DO j = 1,nlevels(listId)
162                ztmp(j) = rC(NINT(levs(j,listnum)))                ztmp(j) = rC(NINT(levs(j,listId)))
163              ENDDO              ENDDO
164              CALL MNC_CW_ADD_VATTR_TEXT(dn(1),'description',              CALL MNC_CW_ADD_VATTR_TEXT(dn(1),'description',
165       &           'Dimensional coordinate value at the mid point',       &           'Dimensional coordinate value at the mid point',
166       &           myThid)       &           myThid)
167            ELSEIF (i .EQ. 2) THEN            ELSEIF (i .EQ. 2) THEN
168              DO j = 1,nlevels(listnum)              DO j = 1,nlevels(listId)
169                ztmp(j) = rF(NINT(levs(j,listnum)) + 1)                ztmp(j) = rF(NINT(levs(j,listId)) + 1)
170              ENDDO              ENDDO
171              CALL MNC_CW_ADD_VATTR_TEXT(dn(1),'description',              CALL MNC_CW_ADD_VATTR_TEXT(dn(1),'description',
172       &           'Dimensional coordinate value at the upper point',       &           'Dimensional coordinate value at the upper point',
173       &           myThid)       &           myThid)
174            ELSEIF (i .EQ. 3) THEN            ELSEIF (i .EQ. 3) THEN
175              DO j = 1,nlevels(listnum)              DO j = 1,nlevels(listId)
176                ztmp(j) = rF(NINT(levs(j,listnum)))                ztmp(j) = rF(NINT(levs(j,listId)))
177              ENDDO              ENDDO
178              CALL MNC_CW_ADD_VATTR_TEXT(dn(1),'description',              CALL MNC_CW_ADD_VATTR_TEXT(dn(1),'description',
179       &           'Dimensional coordinate value at the lower point',       &           'Dimensional coordinate value at the lower point',
# Line 159  C         for averaged levels. Line 183  C         for averaged levels.
183            CALL MNC_CW_DEL_VNAME(dn(1), myThid)            CALL MNC_CW_DEL_VNAME(dn(1), myThid)
184            CALL MNC_CW_DEL_GNAME(dn(1), myThid)            CALL MNC_CW_DEL_GNAME(dn(1), myThid)
185          ENDDO          ENDDO
186    #endif /*  DIAG_MNC_COORD_NEEDSWORK  */
187    
188        ENDIF        ENDIF
189  #endif /*  ALLOW_MNC  */  #endif /*  ALLOW_MNC  */
190    
191        DO n = 1,nfields(listnum)        DO md = 1,nfields(listId)
192          m = jdiag(n,listnum)          ndId = jdiag(md,listId)
193          parms1 = gdiag(m)(1:8)          parms1 = gdiag(ndId)(1:8)
194          IF ( idiag(m).NE.0 .AND. parms1(5:5).NE.'D' ) THEN          IF ( idiag(md,listId).NE.0 .AND. parms1(5:5).NE.'D' ) THEN
195  C--     Start processing 1 Fld :  C--     Start processing 1 Fld :
196    
197            IF ( ndiag(m).EQ.0 ) THEN            ip = ABS(idiag(md,listId))
198              im = mdiag(md,listId)
199              IF ( ndiag(ip,1,1).EQ.0 ) THEN
200  C-        Empty diagnostics case :  C-        Empty diagnostics case :
201    
202              _BEGIN_MASTER( myThid )              _BEGIN_MASTER( myThid )
203              WRITE(msgBuf,'(A,I10)')              WRITE(msgBuf,'(A,I10)')
204       &        '- WARNING - from DIAGNOSTICS_OUT at iter=', myIter       &        '- WARNING - from DIAGNOSTICS_OUT at iter=', myIter
205              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
206       &                          SQUEEZE_RIGHT, myThid)       &                          SQUEEZE_RIGHT, myThid)
207              WRITE(msgBuf,'(A,I4,3A,I3,2A)')              WRITE(msgBuf,'(A,I4,3A,I3,2A)')
208       &       '- WARNING -   diag.#',m, ' : ',flds(n,listnum),       &       '- WARNING -   diag.#',ndId, ' : ',flds(md,listId),
209       &       ' (#',n,' ) in outp.Stream: ',fnames(listnum)       &       ' (#',md,' ) in outp.Stream: ',fnames(listId)
210              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
211       &                          SQUEEZE_RIGHT, myThid)       &                          SQUEEZE_RIGHT, myThid)
212              WRITE(msgBuf,'(A,I2,A)')              WRITE(msgBuf,'(A,I2,A)')
213       &       '- WARNING -   has not been filled (ndiag=',ndiag(m),' )'       &       '- WARNING -   has not been filled (ndiag=',
214              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,       &       ndiag(ip,1,1), ' )'
215                CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
216       &                          SQUEEZE_RIGHT, myThid)       &                          SQUEEZE_RIGHT, myThid)
217              WRITE(msgBuf,'(A)')              WRITE(msgBuf,'(A)')
218       &       'WARNING DIAGNOSTICS_OUT  => write ZEROS instead'       &       'WARNING DIAGNOSTICS_OUT  => write ZEROS instead'
219              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
220       &                          SQUEEZE_RIGHT, myThid)       &                          SQUEEZE_RIGHT, myThid)
221              _END_MASTER( myThid )              _END_MASTER( myThid )
222              DO bj = myByLo(myThid), myByHi(myThid)              DO bj = myByLo(myThid), myByHi(myThid)
223                DO bi = myBxLo(myThid), myBxHi(myThid)                DO bi = myBxLo(myThid), myBxHi(myThid)
224                  DO k = 1,nlevels(listnum)                  DO k = 1,nlevels(listId)
225                    DO j = 1-OLy,sNy+OLy                    DO j = 1-OLy,sNy+OLy
226                      DO i = 1-OLx,sNx+OLx                      DO i = 1-OLx,sNx+OLx
227                        qtmp1(i,j,k,bi,bj) = 0. _d 0                        qtmp1(i,j,k,bi,bj) = 0. _d 0
# Line 206  C-        Empty diagnostics case : Line 234  C-        Empty diagnostics case :
234            ELSE            ELSE
235  C-        diagnostics is not empty :  C-        diagnostics is not empty :
236    
237              IF ( myThid.EQ.1 )              IF ( myThid.EQ.1 ) WRITE(ioUnit,'(A,I3,3A,I8,2A)')
238       &             WRITE(ioUnit,2000) m,cdiag(m),ndiag(m),gdiag(m)       &         ' Computing Diagnostic # ', ndId, '  ', cdiag(ndId),
239         &         '     Counter:',ndiag(ip,1,1),'   Parms: ',gdiag(ndId)
240    
241              IF ( parms1(5:5).EQ.'C' ) THEN              IF ( parms1(5:5).EQ.'C' ) THEN
242  C             Check for Mate of a Counter Diagnostic  C             Check for Mate of a Counter Diagnostic
243  C             --------------------------------------  C             --------------------------------------
244                mate_index = parms1(6:8)                mate_index = parms1(6:8)
245                READ (mate_index,'(I3)') mate                READ (mate_index,'(I3)') mate
246                IF ( myThid.EQ.1 )                IF ( myThid.EQ.1 ) WRITE(ioUnit,'(3A,I3,2A)')
247       &                 WRITE(ioUnit,2003) cdiag(m),mate,cdiag(mate)       &         '       use Counter Mate for  ', cdiag(ndId),
248         &         '     Diagnostic # ',mate, '  ', cdiag(mate)
249    
250              ELSE              ELSE
251                mate = 0                mate = 0
252    
# Line 224  C             -------------------------- Line 255  C             --------------------------
255                IF ( parms1(1:1).EQ.'U' .OR. parms1(1:1).EQ.'V' ) THEN                IF ( parms1(1:1).EQ.'U' .OR. parms1(1:1).EQ.'V' ) THEN
256                  mate_index = parms1(6:8)                  mate_index = parms1(6:8)
257                  READ (mate_index,'(I3)') mVec                  READ (mate_index,'(I3)') mVec
258                  IF ( idiag(mVec).NE.0 ) THEN                  IF ( im.GT.0 .AND. ndiag(MAX(1,im),1,1).GT.0 ) THEN
259                    IF ( myThid.EQ.1 )                   IF ( myThid.EQ.1 ) WRITE(ioUnit,'(3A,I3,3A)')
260       &                 WRITE(ioUnit,2001) cdiag(m),mVec,cdiag(mVec)       &             '           Vector  Mate for  ', cdiag(ndId),
261         &             '     Diagnostic # ',mVec, '  ', cdiag(mVec),
262         &             ' exists '
263                  ELSE                  ELSE
264                    IF ( myThid.EQ.1 )                   IF ( myThid.EQ.1 ) WRITE(ioUnit,'(3A,I3,3A)')
265       &                 WRITE(ioUnit,2002) cdiag(m),mVec,cdiag(mVec)       &             '           Vector  Mate for  ', cdiag(ndId),
266         &             '     Diagnostic # ',mVec, '  ', cdiag(mVec),
267         &             ' not enabled'
268                  ENDIF                  ENDIF
269                ENDIF                ENDIF
270              ENDIF              ENDIF
271    
272              DO bj = myByLo(myThid), myByHi(myThid)              DO bj = myByLo(myThid), myByHi(myThid)
273               DO bi = myBxLo(myThid), myBxHi(myThid)               DO bi = myBxLo(myThid), myBxHi(myThid)
274                DO k = 1,nlevels(listnum)                DO k = 1,nlevels(listId)
275                  CALL GETDIAG(                  CALL GETDIAG(
276       I                       levs(k,listnum),undef,       I                       levs(k,listId),undef,
277       O                       qtmp1(1-OLx,1-OLy,k,bi,bj),       O                       qtmp1(1-OLx,1-OLy,k,bi,bj),
278       I                       m,mate,bi,bj,myThid)       I                       ndId,mate,ip,im,bi,bj,myThid)
279                ENDDO                ENDDO
280               ENDDO               ENDDO
281              ENDDO              ENDDO
# Line 248  C             -------------------------- Line 283  C             --------------------------
283  C-        end of empty diag / not empty block  C-        end of empty diag / not empty block
284            ENDIF            ENDIF
285    
286              nlevsout = nlevels(listId)
287    
288    C-----------------------------------------------------------------------
289    C         Check to see if we need to interpolate before output
290    C-----------------------------------------------------------------------
291             IF ( fflags(listId)(2:2).EQ.'P' ) THEN
292    C-        Do vertical interpolation:
293              CALL DIAGNOSTICS_INTERP_VERT(
294         I                     listId, md, ndId, ip, im,
295         U                     nlevsout,
296         U                     qtmp1,
297         I                     undef,
298         I                     myTime, myIter, myThid )
299             ENDIF
300    
301  #ifdef ALLOW_MDSIO  #ifdef ALLOW_MDSIO
302  C         Prepare for mdsio optionality  C         Prepare for mdsio optionality
303            IF (diag_mdsio) THEN            IF (diag_mdsio) THEN
304              IF (fflags(listnum)(1:1) .EQ. ' ') THEN              IF (fflags(listId)(1:1) .EQ. ' ') THEN
305  C             This is the old default behavior  C             This is the old default behavior
306                CALL mdswritefield_new(fn,writeBinaryPrec,glf,'RL',                CALL MDSWRITEFIELD_NEW(fn,writeBinaryPrec,glf,'RL',
307       &             Nr+Nrphys,nlevels(listnum),qtmp1,n,myIter,myThid)       &             Nr+Nrphys,nlevsout,qtmp1,md,myIter,myThid)
308              ELSEIF (fflags(listnum)(1:1) .EQ. 'R') THEN              ELSEIF (fflags(listId)(1:1) .EQ. 'R') THEN
309  C             Force it to be 32-bit precision  C             Force it to be 32-bit precision
310                CALL mdswritefield_new(fn,precFloat32,glf,'RL',                CALL MDSWRITEFIELD_NEW(fn,precFloat32,glf,'RL',
311       &             Nr+Nrphys,nlevels(listnum),qtmp1,n,myIter,myThid)       &             Nr+Nrphys,nlevsout,qtmp1,md,myIter,myThid)
312              ELSEIF (fflags(listnum)(1:1) .EQ. 'D') THEN              ELSEIF (fflags(listId)(1:1) .EQ. 'D') THEN
313  C             Force it to be 64-bit precision  C             Force it to be 64-bit precision
314                CALL mdswritefield_new(fn,precFloat64,glf,'RL',                CALL MDSWRITEFIELD_NEW(fn,precFloat64,glf,'RL',
315       &             Nr+Nrphys,nlevels(listnum),qtmp1,n,myIter,myThid)       &             Nr+Nrphys,nlevsout,qtmp1,md,myIter,myThid)
316              ENDIF              ENDIF
317            ENDIF            ENDIF
318  #endif /*  ALLOW_MDSIO  */  #endif /*  ALLOW_MDSIO  */
# Line 282  C           subtlety within MNC.  Basica Line 332  C           subtlety within MNC.  Basica
332  C           caching its own concept of what each "grid name" (that is, a  C           caching its own concept of what each "grid name" (that is, a
333  C           dimension group name) means.  So one cannot re-use the same  C           dimension group name) means.  So one cannot re-use the same
334  C           "grid" name for different collections of dimensions within a  C           "grid" name for different collections of dimensions within a
335  C           given file.  By appending the "m" values to each name, we  C           given file.  By appending the "ndId" values to each name, we
336  C           guarantee uniqueness within each MNC-produced file.  C           guarantee uniqueness within each MNC-produced file.
337              WRITE(d_cw_name,'(a,i6.6)') 'd_cw_',m              WRITE(d_cw_name,'(a,i6.6)') 'd_cw_',ndId
338    
339  C           XY dimensions  C           XY dimensions
340              dim(1)       = sNx + 2*OLx              dim(1)       = sNx + 2*OLx
341              dim(2)       = sNy + 2*OLy              dim(2)       = sNy + 2*OLy
342              ib(1)        = OLx + 1              ib(1)        = OLx + 1
343              ib(2)        = OLy + 1              ib(2)        = OLy + 1
344              IF (gdiag(m)(2:2) .EQ. 'M') THEN              IF (gdiag(ndId)(2:2) .EQ. 'M') THEN
345                dn(1)(1:2) = 'X'                dn(1)(1:2) = 'X'
346                ie(1)      = OLx + sNx                ie(1)      = OLx + sNx
347                dn(2)(1:2) = 'Y'                dn(2)(1:2) = 'Y'
348                ie(2)      = OLy + sNy                ie(2)      = OLy + sNy
349              ELSEIF (gdiag(m)(2:2) .EQ. 'U') THEN              ELSEIF (gdiag(ndId)(2:2) .EQ. 'U') THEN
350                dn(1)(1:3) = 'Xp1'                dn(1)(1:3) = 'Xp1'
351                ie(1)      = OLx + sNx + 1                ie(1)      = OLx + sNx + 1
352                dn(2)(1:2) = 'Y'                dn(2)(1:2) = 'Y'
353                ie(2)      = OLy + sNy                ie(2)      = OLy + sNy
354              ELSEIF (gdiag(m)(2:2) .EQ. 'V') THEN              ELSEIF (gdiag(ndId)(2:2) .EQ. 'V') THEN
355                dn(1)(1:2) = 'X'                dn(1)(1:2) = 'X'
356                ie(1)      = OLx + sNx                ie(1)      = OLx + sNx
357                dn(2)(1:3) = 'Yp1'                dn(2)(1:3) = 'Yp1'
358                ie(2)      = OLy + sNy + 1                ie(2)      = OLy + sNy + 1
359              ELSEIF (gdiag(m)(2:2) .EQ. 'Z') THEN              ELSEIF (gdiag(ndId)(2:2) .EQ. 'Z') THEN
360                dn(1)(1:3) = 'Xp1'                dn(1)(1:3) = 'Xp1'
361                ie(1)      = OLx + sNx + 1                ie(1)      = OLx + sNx + 1
362                dn(2)(1:3) = 'Yp1'                dn(2)(1:3) = 'Yp1'
# Line 314  C           XY dimensions Line 364  C           XY dimensions
364              ENDIF              ENDIF
365                            
366  C           Z is special since it varies  C           Z is special since it varies
367              WRITE(dn(3),'(a,i6.6)') 'Zd', nlevels(listnum)              WRITE(dn(3),'(a,i6.6)') 'Zd', nlevels(listId)
368              IF ( (gdiag(m)(10:10) .EQ. 'R')              IF ( (gdiag(ndId)(10:10) .EQ. 'R')
369       &           .AND. (gdiag(m)(9:9) .EQ. 'M') ) THEN       &           .AND. (gdiag(ndId)(9:9) .EQ. 'M') ) THEN
370                WRITE(dn(3),'(a,i6.6)') 'Zmd', nlevels(listnum)                WRITE(dn(3),'(a,i6.6)') 'Zmd', nlevels(listId)
371              ENDIF              ENDIF
372              IF ( (gdiag(m)(10:10) .EQ. 'R')              IF ( (gdiag(ndId)(10:10) .EQ. 'R')
373       &           .AND. (gdiag(m)(9:9) .EQ. 'L') ) THEN       &           .AND. (gdiag(ndId)(9:9) .EQ. 'L') ) THEN
374                WRITE(dn(3),'(a,i6.6)') 'Zld', nlevels(listnum)                WRITE(dn(3),'(a,i6.6)') 'Zld', nlevels(listId)
375              ENDIF              ENDIF
376              IF ( (gdiag(m)(10:10) .EQ. 'R')              IF ( (gdiag(ndId)(10:10) .EQ. 'R')
377       &           .AND. (gdiag(m)(9:9) .EQ. 'U') ) THEN       &           .AND. (gdiag(ndId)(9:9) .EQ. 'U') ) THEN
378                WRITE(dn(3),'(a,i6.6)') 'Zud', nlevels(listnum)                WRITE(dn(3),'(a,i6.6)') 'Zud', nlevels(listId)
379              ENDIF              ENDIF
380              dim(3) = Nr+Nrphys              dim(3) = Nr+Nrphys
381              ib(3)  = 1              ib(3)  = 1
382              ie(3)  = nlevels(listnum)              ie(3)  = nlevels(listId)
383    
384  C           Time dimension  C           Time dimension
385              dn(4)(1:1) = 'T'              dn(4)(1:1) = 'T'
# Line 339  C           Time dimension Line 389  C           Time dimension
389    
390              CALL MNC_CW_ADD_GNAME(d_cw_name, 4,              CALL MNC_CW_ADD_GNAME(d_cw_name, 4,
391       &             dim, dn, ib, ie, myThid)       &             dim, dn, ib, ie, myThid)
392              CALL MNC_CW_ADD_VNAME(cdiag(m), d_cw_name,              CALL MNC_CW_ADD_VNAME(cdiag(ndId), d_cw_name,
393       &             4,5, myThid)       &             4,5, myThid)
394              CALL MNC_CW_ADD_VATTR_TEXT(cdiag(m),'description',              CALL MNC_CW_ADD_VATTR_TEXT(cdiag(ndId),'description',
395       &             tdiag(m),myThid)       &             tdiag(ndId),myThid)
396              CALL MNC_CW_ADD_VATTR_TEXT(cdiag(m),'units',              CALL MNC_CW_ADD_VATTR_TEXT(cdiag(ndId),'units',
397       &             udiag(m),myThid)       &             udiag(ndId),myThid)
398    
399              IF ((fflags(listnum)(1:1) .EQ. ' ')              IF ((fflags(listId)(1:1) .EQ. ' ')
400       &           .OR. (fflags(listnum)(1:1) .EQ. 'R')) THEN       &           .OR. (fflags(listId)(1:1) .EQ. 'R')) THEN
401                CALL MNC_CW_RL_W('R',diag_mnc_bn,0,0,                CALL MNC_CW_RL_W('R',diag_mnc_bn,0,0,
402       &             cdiag(m), qtmp1, myThid)       &             cdiag(ndId), qtmp1, myThid)
403              ELSEIF (fflags(listnum)(1:1) .EQ. 'D') THEN              ELSEIF (fflags(listId)(1:1) .EQ. 'D') THEN
404                CALL MNC_CW_RL_W('D',diag_mnc_bn,0,0,                CALL MNC_CW_RL_W('D',diag_mnc_bn,0,0,
405       &             cdiag(m), qtmp1, myThid)       &             cdiag(ndId), qtmp1, myThid)
406              ENDIF              ENDIF
407                            
408              CALL MNC_CW_DEL_VNAME(cdiag(m), myThid)              CALL MNC_CW_DEL_VNAME(cdiag(ndId), myThid)
409              CALL MNC_CW_DEL_GNAME(d_cw_name, myThid)              CALL MNC_CW_DEL_GNAME(d_cw_name, myThid)
410    
411              _END_MASTER( myThid )              _END_MASTER( myThid )
# Line 363  C           Time dimension Line 413  C           Time dimension
413            ENDIF            ENDIF
414  #endif /*  ALLOW_MNC  */  #endif /*  ALLOW_MNC  */
415    
416  C--     end of Processing Fld # n  C--     end of Processing Fld # md
417          ENDIF          ENDIF
418        ENDDO        ENDDO
419    
420   2000 format(1x,'Computing Diagnostic # ',i3,2x,a8,5x,        RETURN
      &     'Counter:',i8,3x,'Parms: ',a16)  
  2001 format(1x,'          Vector  Mate for  ',a8,5x,  
      &     'Diagnostic # ',i3,2x,a8,' exists ')  
  2002 format(1x,'          Vector  Mate for  ',a8,5x,  
      &     'Diagnostic # ',i3,2x,a8,' not enabled')  
  2003 format(1x,'      use Counter Mate for  ',a8,5x,  
      &     'Diagnostic # ',i3,2x,a8)  
         
       RETURN  
421        END        END
422                                                                        
423  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
Legend:
Removed from v.1.14  
changed lines
  Added in v.1.21
  ViewVC Help
Powered by ViewVC 1.1.22