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

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

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


Revision 1.12 - (hide annotations) (download)
Mon Apr 4 22:05:14 2005 UTC (19 years, 1 month ago) by jmc
Branch: MAIN
CVS Tags: checkpoint57g_post, checkpoint57g_pre, checkpoint57f_pre, checkpoint57f_post
Changes since 1.11: +4 -4 lines
write "counter" to standard-output with I8 format (I4 was too short)

1 jmc 1.12 C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diagnostics_out.F,v 1.11 2005/03/17 01:22:43 jmc Exp $
2 jmc 1.1 C $Name: $
3    
4     #include "DIAG_OPTIONS.h"
5    
6     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7     CBOP 0
8     C !ROUTINE: DIAGNOSTICS_OUT
9    
10     C !INTERFACE:
11     SUBROUTINE DIAGNOSTICS_OUT(
12     I listnum,
13     I myIter,
14     I myThid )
15    
16     C !DESCRIPTION:
17     C Write output for diagnostics fields.
18    
19     C !USES:
20 jmc 1.3 IMPLICIT NONE
21 jmc 1.1 #include "SIZE.h"
22     #include "EEPARAMS.h"
23     #include "PARAMS.h"
24 edhill 1.7 #include "GRID.h"
25 jmc 1.3 #include "DIAGNOSTICS_SIZE.h"
26     #include "DIAGNOSTICS.h"
27 jmc 1.1
28     #ifdef ALLOW_FIZHI
29     #include "fizhi_SIZE.h"
30     #else
31 jmc 1.3 INTEGER Nrphys
32     PARAMETER (Nrphys=0)
33 jmc 1.1 #endif
34    
35    
36     C !INPUT PARAMETERS:
37 jmc 1.3 C listnum :: Diagnostics list number being written
38     C myIter :: current iteration number
39     C myThid :: my Thread Id number
40     INTEGER listnum, myIter, myThid
41 jmc 1.1 CEOP
42    
43 jmc 1.3 C !LOCAL VARIABLES:
44     INTEGER i, j, k, m, n, bi, bj
45     CHARACTER*8 parms1
46     CHARACTER*3 mate_index
47 jmc 1.6 INTEGER mate, mVec
48 jmc 1.1 _RL qtmp1(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr+Nrphys,nSx,nSy)
49     _RL undef, getcon
50 jmc 1.3 EXTERNAL getcon
51     INTEGER ILNBLNK
52     EXTERNAL ILNBLNK
53     INTEGER ilen
54 jmc 1.1
55 jmc 1.6 INTEGER ioUnit
56 jmc 1.11 CHARACTER*(MAX_LEN_FNAM) fn
57 jmc 1.1 CHARACTER*(MAX_LEN_MBUF) suff
58 jmc 1.3 CHARACTER*(MAX_LEN_MBUF) msgBuf
59     LOGICAL glf
60 jmc 1.1 #ifdef ALLOW_MNC
61 jmc 1.3 INTEGER ii
62 jmc 1.1 CHARACTER*(MAX_LEN_FNAM) diag_mnc_bn
63 edhill 1.7 CHARACTER*(5) ctmp
64 jmc 1.3 INTEGER CW_DIMS, NLEN
65     PARAMETER ( CW_DIMS = 10 )
66     PARAMETER ( NLEN = 80 )
67     INTEGER dim(CW_DIMS), ib(CW_DIMS), ie(CW_DIMS)
68     CHARACTER*(NLEN) dn(CW_DIMS)
69 edhill 1.7 CHARACTER*(NLEN) d_cw_name
70 jmc 1.3 CHARACTER*(NLEN) dn_blnk
71 edhill 1.7 _RS ztmp(Nr+Nrphys)
72 jmc 1.1 #endif /* ALLOW_MNC */
73    
74 jmc 1.3 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
75    
76 jmc 1.6 ioUnit= standardMessageUnit
77 jmc 1.1 undef = getcon('UNDEF')
78     glf = globalFiles
79     WRITE(suff,'(I10.10)') myIter
80 jmc 1.11 ilen = ILNBLNK(fnames(listnum))
81     WRITE( fn, '(A,A,A)' ) fnames(listnum)(1:ilen),'.',suff(1:10)
82 jmc 1.1
83     #ifdef ALLOW_MNC
84     IF (useMNC .AND. diag_mnc) THEN
85     DO i = 1,MAX_LEN_FNAM
86     diag_mnc_bn(i:i) = ' '
87     ENDDO
88     DO i = 1,NLEN
89     dn_blnk(i:i) = ' '
90     ENDDO
91 jmc 1.11 WRITE( diag_mnc_bn, '(A)' ) fnames(listnum)(1:ilen)
92 jmc 1.1
93     C Update the record dimension by writing the iteration number
94     CALL MNC_CW_SET_UDIM(diag_mnc_bn, -1, myThid)
95 edhill 1.4 CALL MNC_CW_I_W_S('I',diag_mnc_bn,0,0,'T',myIter,myThid)
96 jmc 1.1 CALL MNC_CW_SET_UDIM(diag_mnc_bn, 0, myThid)
97    
98     dn(1)(1:NLEN) = dn_blnk(1:NLEN)
99 edhill 1.7 WRITE(dn(1),'(a,i6.6)') 'Zmd', nlevels(listnum)
100 jmc 1.1 dim(1) = nlevels(listnum)
101     ib(1) = 1
102     ie(1) = nlevels(listnum)
103    
104     CALL MNC_CW_ADD_GNAME('diag_levels', 1,
105     & dim, dn, ib, ie, myThid)
106 edhill 1.7 CALL MNC_CW_ADD_VNAME('diag_levels', 'diag_levels',
107 jmc 1.1 & 0,0, myThid)
108 edhill 1.7 CALL MNC_CW_ADD_VATTR_TEXT('diag_levels','description',
109     & 'Idicies of vertical levels within the source arrays',
110 jmc 1.1 & myThid)
111    
112 edhill 1.9 CALL MNC_CW_RL_W('D',diag_mnc_bn,0,0,
113 edhill 1.7 & 'diag_levels', levs(1,listnum), myThid)
114 jmc 1.1
115 edhill 1.7 CALL MNC_CW_DEL_VNAME('diag_levels', myThid)
116 jmc 1.1 CALL MNC_CW_DEL_GNAME('diag_levels', myThid)
117 edhill 1.7
118     C Now define: Zmdxxxxxx, Zudxxxxxx, Zldxxxxxx
119     ctmp(1:5) = 'mul '
120     DO i = 1,3
121     dn(1)(1:NLEN) = dn_blnk(1:NLEN)
122     WRITE(dn(1),'(3a,i6.6)') 'Z',ctmp(i:i),'d',nlevels(listnum)
123     CALL MNC_CW_ADD_GNAME(dn(1), 1, dim, dn, ib, ie, myThid)
124     CALL MNC_CW_ADD_VNAME(dn(1), dn(1), 0,0, myThid)
125 edhill 1.10
126     C The following three ztmp() loops should eventually be modified
127     C to reflect the fractional nature of levs(j,l) -- they should
128     C do something like:
129     C ztmp(j) = rC(INT(FLOOR(levs(j,l))))
130     C + ( rC(INT(FLOOR(levs(j,l))))
131     C + rC(INT(CEIL(levs(j,l)))) )
132     C / ( levs(j,l) - FLOOR(levs(j,l)) )
133     C for averaged levels.
134     IF (i .EQ. 1) THEN
135     DO j = 1,nlevels(listnum)
136     ztmp(j) = rC(NINT(levs(j,listnum)))
137     ENDDO
138     CALL MNC_CW_ADD_VATTR_TEXT(dn(1),'description',
139     & 'Dimensional coordinate value at the mid point',
140     & myThid)
141     ELSEIF (i .EQ. 2) THEN
142     DO j = 1,nlevels(listnum)
143     ztmp(j) = rF(NINT(levs(j,listnum)) + 1)
144     ENDDO
145     CALL MNC_CW_ADD_VATTR_TEXT(dn(1),'description',
146     & 'Dimensional coordinate value at the upper point',
147     & myThid)
148     ELSEIF (i .EQ. 3) THEN
149     DO j = 1,nlevels(listnum)
150     ztmp(j) = rF(NINT(levs(j,listnum)))
151     ENDDO
152     CALL MNC_CW_ADD_VATTR_TEXT(dn(1),'description',
153     & 'Dimensional coordinate value at the lower point',
154     & myThid)
155     ENDIF
156 edhill 1.7 CALL MNC_CW_RS_W('D',diag_mnc_bn,0,0, dn(1), ztmp, myThid)
157     CALL MNC_CW_DEL_VNAME(dn(1), myThid)
158     CALL MNC_CW_DEL_GNAME(dn(1), myThid)
159     ENDDO
160    
161 jmc 1.1 ENDIF
162     #endif /* ALLOW_MNC */
163    
164 jmc 1.3 DO n = 1,nfields(listnum)
165     m = jdiag(n,listnum)
166     parms1 = gdiag(m)(1:8)
167     IF ( idiag(m).NE.0 .AND. parms1(5:5).NE.'D' ) THEN
168     C-- Start processing 1 Fld :
169    
170     IF ( ndiag(m).EQ.0 ) THEN
171     C- Empty diagnostics case :
172    
173     _BEGIN_MASTER( myThid )
174     WRITE(msgBuf,'(A,I10)')
175     & '- WARNING - from DIAGNOSTICS_OUT at iter=', myIter
176     CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
177     & SQUEEZE_RIGHT, myThid)
178     WRITE(msgBuf,'(A,I4,3A,I3,2A)')
179     & '- WARNING - diag.#',m, ' : ',flds(n,listnum),
180     & ' (#',n,' ) in outp.Stream: ',fnames(listnum)
181     CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
182     & SQUEEZE_RIGHT, myThid)
183     WRITE(msgBuf,'(A,I2,A)')
184     & '- WARNING - has not been filled (ndiag=',ndiag(m),' )'
185     CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
186     & SQUEEZE_RIGHT, myThid)
187     WRITE(msgBuf,'(A)')
188     & 'WARNING DIAGNOSTICS_OUT => write ZEROS instead'
189     CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
190     & SQUEEZE_RIGHT, myThid)
191     _END_MASTER( myThid )
192     DO bj = myByLo(myThid), myByHi(myThid)
193     DO bi = myBxLo(myThid), myBxHi(myThid)
194     DO k = 1,nlevels(listnum)
195     DO j = 1-OLy,sNy+OLy
196     DO i = 1-OLx,sNx+OLx
197     qtmp1(i,j,k,bi,bj) = 0. _d 0
198     ENDDO
199     ENDDO
200     ENDDO
201     ENDDO
202     ENDDO
203    
204     ELSE
205     C- diagnostics is not empty :
206    
207     IF ( myThid.EQ.1 )
208 jmc 1.6 & WRITE(ioUnit,2000) m,cdiag(m),ndiag(m),gdiag(m)
209 jmc 1.3
210 jmc 1.6 IF ( parms1(5:5).EQ.'C' ) THEN
211     C Check for Mate of a Counter Diagnostic
212     C --------------------------------------
213     mate_index = parms1(6:8)
214     READ (mate_index,'(I3)') mate
215     IF ( myThid.EQ.1 )
216     & WRITE(ioUnit,2003) cdiag(m),mate,cdiag(mate)
217     ELSE
218     mate = 0
219 jmc 1.3
220     C Check for Mate of a Vector Diagnostic
221     C -------------------------------------
222     IF ( parms1(1:1).EQ.'U' .OR. parms1(1:1).EQ.'V' ) THEN
223     mate_index = parms1(6:8)
224 jmc 1.6 READ (mate_index,'(I3)') mVec
225     IF ( idiag(mVec).NE.0 ) THEN
226 jmc 1.3 IF ( myThid.EQ.1 )
227 jmc 1.6 & WRITE(ioUnit,2001) cdiag(m),mVec,cdiag(mVec)
228 jmc 1.3 ELSE
229     IF ( myThid.EQ.1 )
230 jmc 1.6 & WRITE(ioUnit,2002) cdiag(m),mVec,cdiag(mVec)
231 jmc 1.3 ENDIF
232     ENDIF
233 jmc 1.6 ENDIF
234 jmc 1.3
235 jmc 1.6 DO bj = myByLo(myThid), myByHi(myThid)
236     DO bi = myBxLo(myThid), myBxHi(myThid)
237 jmc 1.3 DO k = 1,nlevels(listnum)
238 jmc 1.6 CALL GETDIAG(
239     I levs(k,listnum),undef,
240     O qtmp1(1-OLx,1-OLy,k,bi,bj),
241     I m,mate,bi,bj,myThid)
242 jmc 1.3 ENDDO
243 jmc 1.6 ENDDO
244     ENDDO
245 jmc 1.1
246 jmc 1.3 C- end of empty diag / not empty block
247     ENDIF
248 jmc 1.1
249     #ifdef ALLOW_MDSIO
250 jmc 1.3 C Prepare for mdsio optionality
251     IF (diag_mdsio) THEN
252     CALL mdswritefield_new(fn,writeBinaryPrec,glf,'RL',
253     & Nr+Nrphys,nlevels(listnum),qtmp1,n,myIter,myThid)
254     ENDIF
255 jmc 1.1 #endif /* ALLOW_MDSIO */
256    
257     #ifdef ALLOW_MNC
258 jmc 1.3 IF (useMNC .AND. diag_mnc) THEN
259 jmc 1.1
260 jmc 1.3 _BEGIN_MASTER( myThid )
261 jmc 1.1
262 jmc 1.3 DO ii = 1,CW_DIMS
263 edhill 1.7 d_cw_name(1:NLEN) = dn_blnk(1:NLEN)
264 jmc 1.3 dn(ii)(1:NLEN) = dn_blnk(1:NLEN)
265     ENDDO
266    
267 edhill 1.7 C Note that the "d_cw_name" variable is a hack that hides a
268     C subtlety within MNC. Basically, each MNC-wrapped file is
269     C caching its own concept of what each "grid name" (that is, a
270     C dimension group name) means. So one cannot re-use the same
271     C "grid" name for different collections of dimensions within a
272     C given file. By appending the "m" values to each name, we
273     C guarantee uniqueness within each MNC-produced file.
274     WRITE(d_cw_name,'(a,i6.6)') 'd_cw_',m
275    
276 edhill 1.5 C XY dimensions
277     dim(1) = sNx + 2*OLx
278     dim(2) = sNy + 2*OLy
279     ib(1) = OLx + 1
280     ib(2) = OLy + 1
281 edhill 1.7 IF (gdiag(m)(2:2) .EQ. 'M') THEN
282 edhill 1.5 dn(1)(1:2) = 'X'
283     ie(1) = OLx + sNx
284     dn(2)(1:2) = 'Y'
285     ie(2) = OLy + sNy
286 edhill 1.7 ELSEIF (gdiag(m)(2:2) .EQ. 'U') THEN
287 edhill 1.5 dn(1)(1:3) = 'Xp1'
288     ie(1) = OLx + sNx + 1
289     dn(2)(1:2) = 'Y'
290     ie(2) = OLy + sNy
291 edhill 1.7 ELSEIF (gdiag(m)(2:2) .EQ. 'V') THEN
292 edhill 1.5 dn(1)(1:2) = 'X'
293     ie(1) = OLx + sNx
294     dn(2)(1:3) = 'Yp1'
295     ie(2) = OLy + sNy + 1
296 edhill 1.7 ELSEIF (gdiag(m)(2:2) .EQ. 'Z') THEN
297 edhill 1.5 dn(1)(1:3) = 'Xp1'
298     ie(1) = OLx + sNx + 1
299     dn(2)(1:3) = 'Yp1'
300     ie(2) = OLy + sNy + 1
301     ENDIF
302    
303 jmc 1.3 C Z is special since it varies
304     WRITE(dn(3),'(a,i6.6)') 'Zd', nlevels(listnum)
305 edhill 1.7 IF ( (gdiag(m)(10:10) .EQ. 'R')
306     & .AND. (gdiag(m)(9:9) .EQ. 'M') ) THEN
307     WRITE(dn(3),'(a,i6.6)') 'Zmd', nlevels(listnum)
308     ENDIF
309     IF ( (gdiag(m)(10:10) .EQ. 'R')
310     & .AND. (gdiag(m)(9:9) .EQ. 'L') ) THEN
311     WRITE(dn(3),'(a,i6.6)') 'Zld', nlevels(listnum)
312     ENDIF
313     IF ( (gdiag(m)(10:10) .EQ. 'R')
314     & .AND. (gdiag(m)(9:9) .EQ. 'U') ) THEN
315     WRITE(dn(3),'(a,i6.6)') 'Zud', nlevels(listnum)
316     ENDIF
317 jmc 1.3 dim(3) = Nr+Nrphys
318     ib(3) = 1
319     ie(3) = nlevels(listnum)
320 jmc 1.1
321 edhill 1.5 C Time dimension
322     dn(4)(1:1) = 'T'
323     dim(4) = -1
324     ib(4) = 1
325     ie(4) = 1
326    
327 edhill 1.7 CALL MNC_CW_ADD_GNAME(d_cw_name, 4,
328 jmc 1.1 & dim, dn, ib, ie, myThid)
329 edhill 1.7 CALL MNC_CW_ADD_VNAME(cdiag(m), d_cw_name,
330 jmc 1.1 & 4,5, myThid)
331 jmc 1.3 CALL MNC_CW_ADD_VATTR_TEXT(cdiag(m),'description',
332 jmc 1.1 & tdiag(m),myThid)
333 jmc 1.3 CALL MNC_CW_ADD_VATTR_TEXT(cdiag(m),'units',
334 jmc 1.1 & udiag(m),myThid)
335    
336 jmc 1.3 CALL MNC_CW_RL_W('D',diag_mnc_bn,0,0,
337 jmc 1.1 & cdiag(m), qtmp1, myThid)
338    
339 jmc 1.3 CALL MNC_CW_DEL_VNAME(cdiag(m), myThid)
340 edhill 1.7 CALL MNC_CW_DEL_GNAME(d_cw_name, myThid)
341 jmc 1.1
342 jmc 1.3 _END_MASTER( myThid )
343 jmc 1.1
344 jmc 1.3 ENDIF
345 jmc 1.1 #endif /* ALLOW_MNC */
346    
347 jmc 1.3 C-- end of Processing Fld # n
348     ENDIF
349     ENDDO
350 jmc 1.1
351 jmc 1.12 2000 format(1x,'Computing Diagnostic # ',i3,2x,a8,5x,
352     & 'Counter:',i8,3x,'Parms: ',a16)
353 jmc 1.1 2001 format(1x,' Vector Mate for ',a8,5x,
354     & 'Diagnostic # ',i3,2x,a8,' exists ')
355 jmc 1.12 2002 format(1x,' Vector Mate for ',a8,5x,
356 jmc 1.1 & 'Diagnostic # ',i3,2x,a8,' not enabled')
357     2003 format(1x,' use Counter Mate for ',a8,5x,
358     & 'Diagnostic # ',i3,2x,a8)
359    
360 jmc 1.3 RETURN
361     END
362 jmc 1.1
363     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

  ViewVC Help
Powered by ViewVC 1.1.22