/[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.10 by edhill, Tue Mar 1 15:48:03 2005 UTC revision 1.27 by edhill, Mon Feb 6 21:20:23 2006 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,
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 34  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        INTEGER listnum, myIter, myThid        _RL     myTime
43          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) pref        CHARACTER*(MAX_LEN_FNAM) fn
69        CHARACTER*(MAX_LEN_MBUF) suff        CHARACTER*(MAX_LEN_MBUF) suff
70        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
       CHARACTER*(80) fn  
71        LOGICAL glf        LOGICAL glf
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 69  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 78  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        pref = fnames(listnum)        ilen = ILNBLNK(fnames(listId))
95        ilen=ILNBLNK( pref )        WRITE( fn, '(A,A,A)' ) fnames(listId)(1:ilen),'.',suff(1:10)
       WRITE( fn, '(A,A,A)' ) pref(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  c       WRITE( diag_mnc_bn, '(A,A)' ) 'diag.', pref(1:ilen)          WRITE( diag_mnc_bn, '(A)' ) fnames(listId)(1:ilen)
         WRITE( diag_mnc_bn, '(A)' ) pref(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_I_W_S('I',diag_mnc_bn,0,0,'T',myIter,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,0,0,'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 113  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       20051021 JMC & EH3 : We need to extend this so that a few
145    C       variables each defined on different grids do not have the same
146    C       vertical dimension names so we should be using a pattern such
147    C       as: Z[uml]td000000 where the 't' is the type as specified by
148    C       gdiag(10)
149    
150  C       Now define:  Zmdxxxxxx, Zudxxxxxx, Zldxxxxxx  C       Now define:  Zmdxxxxxx, Zudxxxxxx, Zldxxxxxx
151          ctmp(1:5) = 'mul  '          ctmp(1:5) = 'mul  '
152          DO i = 1,3          DO i = 1,3
153            dn(1)(1:NLEN) = dn_blnk(1:NLEN)            dn(1)(1:NLEN) = dn_blnk(1:NLEN)
154            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)
155            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)
156            CALL MNC_CW_ADD_VNAME(dn(1), dn(1), 0,0, myThid)            CALL MNC_CW_ADD_VNAME(dn(1), dn(1), 0,0, myThid)
157    
# Line 135  C                          + rC(INT(CEIL Line 164  C                          + rC(INT(CEIL
164  C                        / ( levs(j,l) - FLOOR(levs(j,l)) )  C                        / ( levs(j,l) - FLOOR(levs(j,l)) )
165  C         for averaged levels.  C         for averaged levels.
166            IF (i .EQ. 1) THEN            IF (i .EQ. 1) THEN
167              DO j = 1,nlevels(listnum)              DO j = 1,nlevels(listId)
168                ztmp(j) = rC(NINT(levs(j,listnum)))                ztmp(j) = rC(NINT(levs(j,listId)))
169              ENDDO              ENDDO
170              CALL MNC_CW_ADD_VATTR_TEXT(dn(1),'description',              CALL MNC_CW_ADD_VATTR_TEXT(dn(1),'description',
171       &           'Dimensional coordinate value at the mid point',       &           'Dimensional coordinate value at the mid point',
172       &           myThid)       &           myThid)
173            ELSEIF (i .EQ. 2) THEN            ELSEIF (i .EQ. 2) THEN
174              DO j = 1,nlevels(listnum)              DO j = 1,nlevels(listId)
175                ztmp(j) = rF(NINT(levs(j,listnum)) + 1)                ztmp(j) = rF(NINT(levs(j,listId)) + 1)
176              ENDDO              ENDDO
177              CALL MNC_CW_ADD_VATTR_TEXT(dn(1),'description',              CALL MNC_CW_ADD_VATTR_TEXT(dn(1),'description',
178       &           'Dimensional coordinate value at the upper point',       &           'Dimensional coordinate value at the upper point',
179       &           myThid)       &           myThid)
180            ELSEIF (i .EQ. 3) THEN            ELSEIF (i .EQ. 3) THEN
181              DO j = 1,nlevels(listnum)              DO j = 1,nlevels(listId)
182                ztmp(j) = rF(NINT(levs(j,listnum)))                ztmp(j) = rF(NINT(levs(j,listId)))
183              ENDDO              ENDDO
184              CALL MNC_CW_ADD_VATTR_TEXT(dn(1),'description',              CALL MNC_CW_ADD_VATTR_TEXT(dn(1),'description',
185       &           'Dimensional coordinate value at the lower point',       &           'Dimensional coordinate value at the lower point',
# Line 160  C         for averaged levels. Line 189  C         for averaged levels.
189            CALL MNC_CW_DEL_VNAME(dn(1), myThid)            CALL MNC_CW_DEL_VNAME(dn(1), myThid)
190            CALL MNC_CW_DEL_GNAME(dn(1), myThid)            CALL MNC_CW_DEL_GNAME(dn(1), myThid)
191          ENDDO          ENDDO
192    #endif /*  DIAG_MNC_COORD_NEEDSWORK  */
193    
194        ENDIF        ENDIF
195  #endif /*  ALLOW_MNC  */  #endif /*  ALLOW_MNC  */
196    
197        DO n = 1,nfields(listnum)        DO md = 1,nfields(listId)
198          m = jdiag(n,listnum)          ndId = jdiag(md,listId)
199          parms1 = gdiag(m)(1:8)          parms1 = gdiag(ndId)(1:8)
200          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
201  C--     Start processing 1 Fld :  C--     Start processing 1 Fld :
202    
203            IF ( ndiag(m).EQ.0 ) THEN            ip = ABS(idiag(md,listId))
204              im = mdiag(md,listId)
205              IF ( ndiag(ip,1,1).EQ.0 ) THEN
206  C-        Empty diagnostics case :  C-        Empty diagnostics case :
207    
208              _BEGIN_MASTER( myThid )              _BEGIN_MASTER( myThid )
209              WRITE(msgBuf,'(A,I10)')              WRITE(msgBuf,'(A,I10)')
210       &        '- WARNING - from DIAGNOSTICS_OUT at iter=', myIter       &        '- WARNING - from DIAGNOSTICS_OUT at iter=', myIter
211              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
212       &                          SQUEEZE_RIGHT, myThid)       &                          SQUEEZE_RIGHT, myThid)
213              WRITE(msgBuf,'(A,I4,3A,I3,2A)')              WRITE(msgBuf,'(A,I4,3A,I3,2A)')
214       &       '- WARNING -   diag.#',m, ' : ',flds(n,listnum),       &       '- WARNING -   diag.#',ndId, ' : ',flds(md,listId),
215       &       ' (#',n,' ) in outp.Stream: ',fnames(listnum)       &       ' (#',md,' ) in outp.Stream: ',fnames(listId)
216              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
217       &                          SQUEEZE_RIGHT, myThid)       &                          SQUEEZE_RIGHT, myThid)
218              WRITE(msgBuf,'(A,I2,A)')              WRITE(msgBuf,'(A,I2,A)')
219       &       '- WARNING -   has not been filled (ndiag=',ndiag(m),' )'       &       '- WARNING -   has not been filled (ndiag=',
220              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,       &       ndiag(ip,1,1), ' )'
221                CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
222       &                          SQUEEZE_RIGHT, myThid)       &                          SQUEEZE_RIGHT, myThid)
223              WRITE(msgBuf,'(A)')              WRITE(msgBuf,'(A)')
224       &       'WARNING DIAGNOSTICS_OUT  => write ZEROS instead'       &       'WARNING DIAGNOSTICS_OUT  => write ZEROS instead'
225              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
226       &                          SQUEEZE_RIGHT, myThid)       &                          SQUEEZE_RIGHT, myThid)
227              _END_MASTER( myThid )              _END_MASTER( myThid )
228              DO bj = myByLo(myThid), myByHi(myThid)              DO bj = myByLo(myThid), myByHi(myThid)
229                DO bi = myBxLo(myThid), myBxHi(myThid)                DO bi = myBxLo(myThid), myBxHi(myThid)
230                  DO k = 1,nlevels(listnum)                  DO k = 1,nlevels(listId)
231                    DO j = 1-OLy,sNy+OLy                    DO j = 1-OLy,sNy+OLy
232                      DO i = 1-OLx,sNx+OLx                      DO i = 1-OLx,sNx+OLx
233                        qtmp1(i,j,k,bi,bj) = 0. _d 0                        qtmp1(i,j,k,bi,bj) = 0. _d 0
# Line 207  C-        Empty diagnostics case : Line 240  C-        Empty diagnostics case :
240            ELSE            ELSE
241  C-        diagnostics is not empty :  C-        diagnostics is not empty :
242    
243              IF ( myThid.EQ.1 )              IF ( myThid.EQ.1 ) WRITE(ioUnit,'(A,I3,3A,I8,2A)')
244       &             WRITE(ioUnit,2000) m,cdiag(m),ndiag(m),gdiag(m)       &         ' Computing Diagnostic # ', ndId, '  ', cdiag(ndId),
245         &         '     Counter:',ndiag(ip,1,1),'   Parms: ',gdiag(ndId)
246    
247              IF ( parms1(5:5).EQ.'C' ) THEN              IF ( parms1(5:5).EQ.'C' ) THEN
248  C             Check for Mate of a Counter Diagnostic  C             Check for Mate of a Counter Diagnostic
249  C             --------------------------------------  C             --------------------------------------
250                mate_index = parms1(6:8)                mate_index = parms1(6:8)
251                READ (mate_index,'(I3)') mate                READ (mate_index,'(I3)') mate
252                IF ( myThid.EQ.1 )                IF ( myThid.EQ.1 ) WRITE(ioUnit,'(3A,I3,2A)')
253       &                 WRITE(ioUnit,2003) cdiag(m),mate,cdiag(mate)       &         '       use Counter Mate for  ', cdiag(ndId),
254         &         '     Diagnostic # ',mate, '  ', cdiag(mate)
255    
256              ELSE              ELSE
257                mate = 0                mate = 0
258    
# Line 225  C             -------------------------- Line 261  C             --------------------------
261                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
262                  mate_index = parms1(6:8)                  mate_index = parms1(6:8)
263                  READ (mate_index,'(I3)') mVec                  READ (mate_index,'(I3)') mVec
264                  IF ( idiag(mVec).NE.0 ) THEN                  IF ( im.GT.0 .AND. ndiag(MAX(1,im),1,1).GT.0 ) THEN
265                    IF ( myThid.EQ.1 )                   IF ( myThid.EQ.1 ) WRITE(ioUnit,'(3A,I3,3A)')
266       &                 WRITE(ioUnit,2001) cdiag(m),mVec,cdiag(mVec)       &             '           Vector  Mate for  ', cdiag(ndId),
267         &             '     Diagnostic # ',mVec, '  ', cdiag(mVec),
268         &             ' exists '
269                  ELSE                  ELSE
270                    IF ( myThid.EQ.1 )                   IF ( myThid.EQ.1 ) WRITE(ioUnit,'(3A,I3,3A)')
271       &                 WRITE(ioUnit,2002) cdiag(m),mVec,cdiag(mVec)       &             '           Vector  Mate for  ', cdiag(ndId),
272         &             '     Diagnostic # ',mVec, '  ', cdiag(mVec),
273         &             ' not enabled'
274                  ENDIF                  ENDIF
275                ENDIF                ENDIF
276              ENDIF              ENDIF
277    
278              DO bj = myByLo(myThid), myByHi(myThid)              DO bj = myByLo(myThid), myByHi(myThid)
279               DO bi = myBxLo(myThid), myBxHi(myThid)               DO bi = myBxLo(myThid), myBxHi(myThid)
280                DO k = 1,nlevels(listnum)                DO k = 1,nlevels(listId)
281                  CALL GETDIAG(                  CALL GETDIAG(
282       I                       levs(k,listnum),undef,       I                       levs(k,listId),undef,
283       O                       qtmp1(1-OLx,1-OLy,k,bi,bj),       O                       qtmp1(1-OLx,1-OLy,k,bi,bj),
284       I                       m,mate,bi,bj,myThid)       I                       ndId,mate,ip,im,bi,bj,myThid)
285                ENDDO                ENDDO
286               ENDDO               ENDDO
287              ENDDO              ENDDO
# Line 249  C             -------------------------- Line 289  C             --------------------------
289  C-        end of empty diag / not empty block  C-        end of empty diag / not empty block
290            ENDIF            ENDIF
291    
292              nlevsout = nlevels(listId)
293    
294    C-----------------------------------------------------------------------
295    C         Check to see if we need to interpolate before output
296    C-----------------------------------------------------------------------
297             IF ( fflags(listId)(2:2).EQ.'P' ) THEN
298    C-        Do vertical interpolation:
299              CALL DIAGNOSTICS_INTERP_VERT(
300         I                     listId, md, ndId, ip, im,
301         U                     nlevsout,
302         U                     qtmp1,
303         I                     undef,
304         I                     myTime, myIter, myThid )
305             ENDIF
306    
307  #ifdef ALLOW_MDSIO  #ifdef ALLOW_MDSIO
308  C         Prepare for mdsio optionality  C         Prepare for mdsio optionality
309            IF (diag_mdsio) THEN            IF (diag_mdsio) THEN
310              CALL mdswritefield_new(fn,writeBinaryPrec,glf,'RL',              IF (fflags(listId)(1:1) .EQ. 'R') THEN
311       &           Nr+Nrphys,nlevels(listnum),qtmp1,n,myIter,myThid)  C             Force it to be 32-bit precision
312                  CALL MDSWRITEFIELD_NEW(fn,precFloat32,glf,.FALSE.,
313         &             'RL',Nr+Nrphys,nlevsout,qtmp1,md,myIter,myThid)
314                ELSEIF (fflags(listId)(1:1) .EQ. 'D') THEN
315    C             Force it to be 64-bit precision
316                  CALL MDSWRITEFIELD_NEW(fn,precFloat64,glf,.FALSE.,
317         &             'RL',Nr+Nrphys,nlevsout,qtmp1,md,myIter,myThid)
318                ELSE
319    C             This is the old default behavior
320                  CALL MDSWRITEFIELD_NEW(fn,writeBinaryPrec,glf,.FALSE.,
321         &             'RL',Nr+Nrphys,nlevsout,qtmp1,md,myIter,myThid)
322                ENDIF
323            ENDIF            ENDIF
324  #endif /*  ALLOW_MDSIO  */  #endif /*  ALLOW_MDSIO  */
325    
# Line 272  C           subtlety within MNC.  Basica Line 338  C           subtlety within MNC.  Basica
338  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
339  C           dimension group name) means.  So one cannot re-use the same  C           dimension group name) means.  So one cannot re-use the same
340  C           "grid" name for different collections of dimensions within a  C           "grid" name for different collections of dimensions within a
341  C           given file.  By appending the "m" values to each name, we  C           given file.  By appending the "ndId" values to each name, we
342  C           guarantee uniqueness within each MNC-produced file.  C           guarantee uniqueness within each MNC-produced file.
343              WRITE(d_cw_name,'(a,i6.6)') 'd_cw_',m              WRITE(d_cw_name,'(a,i6.6)') 'd_cw_',ndId
344    
345  C           XY dimensions  C           XY dimensions
346              dim(1)       = sNx + 2*OLx              dim(1)       = sNx + 2*OLx
347              dim(2)       = sNy + 2*OLy              dim(2)       = sNy + 2*OLy
348              ib(1)        = OLx + 1              ib(1)        = OLx + 1
349              ib(2)        = OLy + 1              ib(2)        = OLy + 1
350              IF (gdiag(m)(2:2) .EQ. 'M') THEN              IF (gdiag(ndId)(2:2) .EQ. 'M') THEN
351                dn(1)(1:2) = 'X'                dn(1)(1:2) = 'X'
352                ie(1)      = OLx + sNx                ie(1)      = OLx + sNx
353                dn(2)(1:2) = 'Y'                dn(2)(1:2) = 'Y'
354                ie(2)      = OLy + sNy                ie(2)      = OLy + sNy
355              ELSEIF (gdiag(m)(2:2) .EQ. 'U') THEN              ELSEIF (gdiag(ndId)(2:2) .EQ. 'U') THEN
356                dn(1)(1:3) = 'Xp1'                dn(1)(1:3) = 'Xp1'
357                ie(1)      = OLx + sNx + 1                ie(1)      = OLx + sNx + 1
358                dn(2)(1:2) = 'Y'                dn(2)(1:2) = 'Y'
359                ie(2)      = OLy + sNy                ie(2)      = OLy + sNy
360              ELSEIF (gdiag(m)(2:2) .EQ. 'V') THEN              ELSEIF (gdiag(ndId)(2:2) .EQ. 'V') THEN
361                dn(1)(1:2) = 'X'                dn(1)(1:2) = 'X'
362                ie(1)      = OLx + sNx                ie(1)      = OLx + sNx
363                dn(2)(1:3) = 'Yp1'                dn(2)(1:3) = 'Yp1'
364                ie(2)      = OLy + sNy + 1                ie(2)      = OLy + sNy + 1
365              ELSEIF (gdiag(m)(2:2) .EQ. 'Z') THEN              ELSEIF (gdiag(ndId)(2:2) .EQ. 'Z') THEN
366                dn(1)(1:3) = 'Xp1'                dn(1)(1:3) = 'Xp1'
367                ie(1)      = OLx + sNx + 1                ie(1)      = OLx + sNx + 1
368                dn(2)(1:3) = 'Yp1'                dn(2)(1:3) = 'Yp1'
# Line 304  C           XY dimensions Line 370  C           XY dimensions
370              ENDIF              ENDIF
371                            
372  C           Z is special since it varies  C           Z is special since it varies
373              WRITE(dn(3),'(a,i6.6)') 'Zd', nlevels(listnum)              WRITE(dn(3),'(a,i6.6)') 'Zd', nlevsout
374              IF ( (gdiag(m)(10:10) .EQ. 'R')              IF ( (gdiag(ndId)(10:10) .EQ. 'R')
375       &           .AND. (gdiag(m)(9:9) .EQ. 'M') ) THEN       &           .AND. (gdiag(ndId)(9:9) .EQ. 'M') ) THEN
376                WRITE(dn(3),'(a,i6.6)') 'Zmd', nlevels(listnum)                WRITE(dn(3),'(a,i6.6)') 'Zmd', nlevsout
377              ENDIF              ENDIF
378              IF ( (gdiag(m)(10:10) .EQ. 'R')              IF ( (gdiag(ndId)(10:10) .EQ. 'R')
379       &           .AND. (gdiag(m)(9:9) .EQ. 'L') ) THEN       &           .AND. (gdiag(ndId)(9:9) .EQ. 'L') ) THEN
380                WRITE(dn(3),'(a,i6.6)') 'Zld', nlevels(listnum)                WRITE(dn(3),'(a,i6.6)') 'Zld', nlevsout
381              ENDIF              ENDIF
382              IF ( (gdiag(m)(10:10) .EQ. 'R')              IF ( (gdiag(ndId)(10:10) .EQ. 'R')
383       &           .AND. (gdiag(m)(9:9) .EQ. 'U') ) THEN       &           .AND. (gdiag(ndId)(9:9) .EQ. 'U') ) THEN
384                WRITE(dn(3),'(a,i6.6)') 'Zud', nlevels(listnum)                WRITE(dn(3),'(a,i6.6)') 'Zud', nlevsout
385              ENDIF              ENDIF
386              dim(3) = Nr+Nrphys              dim(3) = Nr+Nrphys
387              ib(3)  = 1              ib(3)  = 1
388              ie(3)  = nlevels(listnum)              ie(3)  = nlevsout
389    
390  C           Time dimension  C           Time dimension
391              dn(4)(1:1) = 'T'              dn(4)(1:1) = 'T'
# Line 329  C           Time dimension Line 395  C           Time dimension
395    
396              CALL MNC_CW_ADD_GNAME(d_cw_name, 4,              CALL MNC_CW_ADD_GNAME(d_cw_name, 4,
397       &             dim, dn, ib, ie, myThid)       &             dim, dn, ib, ie, myThid)
398              CALL MNC_CW_ADD_VNAME(cdiag(m), d_cw_name,              CALL MNC_CW_ADD_VNAME(cdiag(ndId), d_cw_name,
399       &             4,5, myThid)       &             4,5, myThid)
400              CALL MNC_CW_ADD_VATTR_TEXT(cdiag(m),'description',              CALL MNC_CW_ADD_VATTR_TEXT(cdiag(ndId),'description',
401       &             tdiag(m),myThid)       &             tdiag(ndId),myThid)
402              CALL MNC_CW_ADD_VATTR_TEXT(cdiag(m),'units',              CALL MNC_CW_ADD_VATTR_TEXT(cdiag(ndId),'units',
403       &             udiag(m),myThid)       &             udiag(ndId),myThid)
404                CALL MNC_CW_ADD_VATTR_DBL(cdiag(ndId),'missing_value',
405              CALL MNC_CW_RL_W('D',diag_mnc_bn,0,0,       &             0.0 _d 0,myThid)
406       &             cdiag(m), qtmp1, myThid)  
407                IF ( ( (writeBinaryPrec .EQ. precFloat32)
408              CALL MNC_CW_DEL_VNAME(cdiag(m), myThid)       &           .AND. (fflags(listId)(1:1) .NE. 'D')
409         &           .AND. (fflags(listId)(1:1) .NE. 'R') )
410         &           .OR. (fflags(listId)(1:1) .EQ. 'R')) THEN
411                  CALL MNC_CW_RL_W('R',diag_mnc_bn,0,0,
412         &             cdiag(ndId), qtmp1, myThid)
413                ELSEIF ( (writeBinaryPrec .EQ. precFloat64)
414         &             .OR. (fflags(listId)(1:1) .EQ. 'D') ) THEN
415                  CALL MNC_CW_RL_W('D',diag_mnc_bn,0,0,
416         &             cdiag(ndId), qtmp1, myThid)
417                ENDIF
418                
419                CALL MNC_CW_DEL_VNAME(cdiag(ndId), myThid)
420              CALL MNC_CW_DEL_GNAME(d_cw_name, myThid)              CALL MNC_CW_DEL_GNAME(d_cw_name, myThid)
421    
422              _END_MASTER( myThid )              _END_MASTER( myThid )
# Line 347  C           Time dimension Line 424  C           Time dimension
424            ENDIF            ENDIF
425  #endif /*  ALLOW_MNC  */  #endif /*  ALLOW_MNC  */
426    
427  C--     end of Processing Fld # n  C--     end of Processing Fld # md
428          ENDIF          ENDIF
429        ENDDO        ENDDO
430    
431   2000 format(1x,'Computing Diagnostic # ',i3,2x,a8,5x,'Counter: ',        RETURN
      &     i4,6x,'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  
432        END        END
433                                                                        
434  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
Legend:
Removed from v.1.10  
changed lines
  Added in v.1.27
  ViewVC Help
Powered by ViewVC 1.1.22