/[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.10 - (hide annotations) (download)
Tue Mar 1 15:48:03 2005 UTC (19 years, 2 months ago) by edhill
Branch: MAIN
Changes since 1.9: +32 -19 lines
 o improve mnc handling of the Z diag coordinate locations

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

  ViewVC Help
Powered by ViewVC 1.1.22