/[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.9 by edhill, Mon Feb 28 19:38:30 2005 UTC revision 1.26 by edhill, Thu Jan 26 04:15:05 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            DO j = 1,nlevels(listnum)  
158              IF (i .EQ. 1) THEN  C         The following three ztmp() loops should eventually be modified
159                ztmp(j) = rC(levs(j,listnum))  C         to reflect the fractional nature of levs(j,l) -- they should
160                CALL MNC_CW_ADD_VATTR_TEXT(dn(1),'description',  C         do something like:
161       &             'Dimensional coordinate value at the mid point',  C            ztmp(j) = rC(INT(FLOOR(levs(j,l))))
162       &             myThid)  C                      + ( rC(INT(FLOOR(levs(j,l))))
163              ELSEIF (i .EQ. 2) THEN  C                          + rC(INT(CEIL(levs(j,l)))) )
164                ztmp(j) = rF(levs(j,listnum) + 1)  C                        / ( levs(j,l) - FLOOR(levs(j,l)) )
165                CALL MNC_CW_ADD_VATTR_TEXT(dn(1),'description',  C         for averaged levels.
166       &             'Dimensional coordinate value at the upper point',            IF (i .EQ. 1) THEN
167       &             myThid)              DO j = 1,nlevels(listId)
168              ELSEIF (i .EQ. 3) THEN                ztmp(j) = rC(NINT(levs(j,listId)))
169                ztmp(j) = rF(levs(j,listnum))              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 lower point',       &           'Dimensional coordinate value at the mid point',
172       &             myThid)       &           myThid)
173              ENDIF            ELSEIF (i .EQ. 2) THEN
174            ENDDO              DO j = 1,nlevels(listId)
175                  ztmp(j) = rF(NINT(levs(j,listId)) + 1)
176                ENDDO
177                CALL MNC_CW_ADD_VATTR_TEXT(dn(1),'description',
178         &           'Dimensional coordinate value at the upper point',
179         &           myThid)
180              ELSEIF (i .EQ. 3) THEN
181                DO j = 1,nlevels(listId)
182                  ztmp(j) = rF(NINT(levs(j,listId)))
183                ENDDO
184                CALL MNC_CW_ADD_VATTR_TEXT(dn(1),'description',
185         &           'Dimensional coordinate value at the lower point',
186         &           myThid)
187              ENDIF
188            CALL MNC_CW_RS_W('D',diag_mnc_bn,0,0, dn(1), ztmp, myThid)            CALL MNC_CW_RS_W('D',diag_mnc_bn,0,0, dn(1), ztmp, myThid)
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 194  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 212  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 236  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 259  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 291  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 316  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    
405              CALL MNC_CW_RL_W('D',diag_mnc_bn,0,0,              IF ( ( (writeBinaryPrec .EQ. precFloat32)
406       &             cdiag(m), qtmp1, myThid)       &           .AND. (fflags(listId)(1:1) .NE. 'D')
407         &           .AND. (fflags(listId)(1:1) .NE. 'R') )
408              CALL MNC_CW_DEL_VNAME(cdiag(m), myThid)       &           .OR. (fflags(listId)(1:1) .EQ. 'R')) THEN
409                  CALL MNC_CW_RL_W('R',diag_mnc_bn,0,0,
410         &             cdiag(ndId), qtmp1, myThid)
411                ELSEIF ( (writeBinaryPrec .EQ. precFloat64)
412         &             .OR. (fflags(listId)(1:1) .EQ. 'D') ) THEN
413                  CALL MNC_CW_RL_W('D',diag_mnc_bn,0,0,
414         &             cdiag(ndId), qtmp1, myThid)
415                ENDIF
416                
417                CALL MNC_CW_DEL_VNAME(cdiag(ndId), myThid)
418              CALL MNC_CW_DEL_GNAME(d_cw_name, myThid)              CALL MNC_CW_DEL_GNAME(d_cw_name, myThid)
419    
420              _END_MASTER( myThid )              _END_MASTER( myThid )
# Line 334  C           Time dimension Line 422  C           Time dimension
422            ENDIF            ENDIF
423  #endif /*  ALLOW_MNC  */  #endif /*  ALLOW_MNC  */
424    
425  C--     end of Processing Fld # n  C--     end of Processing Fld # md
426          ENDIF          ENDIF
427        ENDDO        ENDDO
428    
429   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  
430        END        END
431                                                                        
432  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
Legend:
Removed from v.1.9  
changed lines
  Added in v.1.26
  ViewVC Help
Powered by ViewVC 1.1.22