/[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.35 - (hide annotations) (download)
Tue Feb 5 15:13:01 2008 UTC (16 years, 3 months ago) by jmc
Branch: MAIN
Changes since 1.34: +15 -15 lines 
In order to deal with large number of diagnostics (happens with large number
of tracers), store diagnostic mate number in dedicate array "hdiag":
- new version of S/R DIAGNOSTICS_ADD2LIST : DIAGNOSTICS_ADDTOLIST
  with 1 more argument (mate number).
- change old version of DIAGNOSTICS_ADD2LIST to extract mate number
  from parsing code and then call DIAGNOSTICS_ADDTOLIST
- modify setting, filling & output to use "hdiag" instead of reading
  mate number from gdiag.
1 jmc 1.35 C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diagnostics_out.F,v 1.34 2007/11/13 19:43:44 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 jmc 1.15 I listId,
13 jmc 1.1 I myIter,
14 edhill 1.14 I myTime,
15 jmc 1.1 I myThid )
16    
17     C !DESCRIPTION:
18     C Write output for diagnostics fields.
19 jmc 1.15
20 jmc 1.1 C !USES:
21 jmc 1.3 IMPLICIT NONE
22 jmc 1.1 #include "SIZE.h"
23     #include "EEPARAMS.h"
24     #include "PARAMS.h"
25 edhill 1.7 #include "GRID.h"
26 jmc 1.3 #include "DIAGNOSTICS_SIZE.h"
27     #include "DIAGNOSTICS.h"
28 jmc 1.1
29 jmc 1.30 INTEGER NrMax
30 jmc 1.33 PARAMETER( NrMax = numLevels )
31 jmc 1.1
32     C !INPUT PARAMETERS:
33 jmc 1.15 C listId :: Diagnostics list number being written
34 jmc 1.3 C myIter :: current iteration number
35 jmc 1.15 C myTime :: current time of simulation (s)
36 jmc 1.3 C myThid :: my Thread Id number
37 edhill 1.14 _RL myTime
38 jmc 1.15 INTEGER listId, myIter, myThid
39 jmc 1.1 CEOP
40    
41 jmc 1.3 C !LOCAL VARIABLES:
42 jmc 1.15 C i,j,k :: loop indices
43 jmc 1.29 C lm :: loop index (averageCycle)
44 jmc 1.15 C md :: field number in the list "listId".
45     C ndId :: diagnostics Id number (in available diagnostics list)
46     C mate :: counter mate Id number (in available diagnostics list)
47     C ip :: diagnostics pointer to storage array
48     C im :: counter-mate pointer to storage array
49 jmc 1.32 C
50     C-- COMMON /LOCAL_DIAGNOSTICS_OUT/ local common block (for multi-threaded)
51     C qtmp1 :: thread-shared temporary array (needs to be in common block):
52     C to write a diagnostic field to file, copy it first from (big)
53     C diagnostic storage qdiag into it.
54     COMMON /LOCAL_DIAGNOSTICS_OUT/ qtmp1
55     _RL qtmp1(1-OLx:sNx+OLx,1-OLy:sNy+OLy,NrMax,nSx,nSy)
56    
57 jmc 1.29 INTEGER i, j, k, lm
58 jmc 1.15 INTEGER bi, bj
59     INTEGER md, ndId, ip, im
60     INTEGER mate, mVec
61 jmc 1.35 CHARACTER*10 gcode
62 jmc 1.1 _RL undef, getcon
63 jmc 1.30 _RL tmpLev
64 jmc 1.3 EXTERNAL getcon
65     INTEGER ILNBLNK
66     EXTERNAL ILNBLNK
67     INTEGER ilen
68 jmc 1.1
69 jmc 1.6 INTEGER ioUnit
70 jmc 1.11 CHARACTER*(MAX_LEN_FNAM) fn
71 jmc 1.1 CHARACTER*(MAX_LEN_MBUF) suff
72 jmc 1.3 CHARACTER*(MAX_LEN_MBUF) msgBuf
73 jmc 1.34 INTEGER prec, nRec
74 jmc 1.29 #ifdef ALLOW_MDSIO
75 jmc 1.3 LOGICAL glf
76 jmc 1.29 #endif
77 jmc 1.1 #ifdef ALLOW_MNC
78 jmc 1.3 INTEGER ii
79 jmc 1.1 CHARACTER*(MAX_LEN_FNAM) diag_mnc_bn
80 jmc 1.3 INTEGER CW_DIMS, NLEN
81     PARAMETER ( CW_DIMS = 10 )
82     PARAMETER ( NLEN = 80 )
83     INTEGER dim(CW_DIMS), ib(CW_DIMS), ie(CW_DIMS)
84     CHARACTER*(NLEN) dn(CW_DIMS)
85 edhill 1.7 CHARACTER*(NLEN) d_cw_name
86 jmc 1.3 CHARACTER*(NLEN) dn_blnk
87 jmc 1.20 #ifdef DIAG_MNC_COORD_NEEDSWORK
88     CHARACTER*(5) ctmp
89 jmc 1.30 _RS ztmp(NrMax)
90 jmc 1.20 #endif
91 jmc 1.1 #endif /* ALLOW_MNC */
92    
93 jmc 1.3 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
94    
95 jmc 1.6 ioUnit= standardMessageUnit
96 jmc 1.1 undef = getcon('UNDEF')
97     WRITE(suff,'(I10.10)') myIter
98 jmc 1.15 ilen = ILNBLNK(fnames(listId))
99     WRITE( fn, '(A,A,A)' ) fnames(listId)(1:ilen),'.',suff(1:10)
100 jmc 1.1
101     #ifdef ALLOW_MNC
102     IF (useMNC .AND. diag_mnc) THEN
103     DO i = 1,MAX_LEN_FNAM
104     diag_mnc_bn(i:i) = ' '
105     ENDDO
106     DO i = 1,NLEN
107     dn_blnk(i:i) = ' '
108     ENDDO
109 jmc 1.15 WRITE( diag_mnc_bn, '(A)' ) fnames(listId)(1:ilen)
110 jmc 1.1
111     C Update the record dimension by writing the iteration number
112     CALL MNC_CW_SET_UDIM(diag_mnc_bn, -1, myThid)
113 edhill 1.14 CALL MNC_CW_RL_W_S('D',diag_mnc_bn,0,0,'T',myTime,myThid)
114 jmc 1.1 CALL MNC_CW_SET_UDIM(diag_mnc_bn, 0, myThid)
115 edhill 1.26 CALL MNC_CW_I_W_S('I',diag_mnc_bn,0,0,'iter',myIter,myThid)
116 edhill 1.21
117     C NOTE: at some point it would be a good idea to add a time_bounds
118     C variable that has dimension (2,T) and clearly denotes the
119     C beginning and ending times for each diagnostics period
120 jmc 1.1
121     dn(1)(1:NLEN) = dn_blnk(1:NLEN)
122 jmc 1.15 WRITE(dn(1),'(a,i6.6)') 'Zmd', nlevels(listId)
123     dim(1) = nlevels(listId)
124 jmc 1.1 ib(1) = 1
125 jmc 1.15 ie(1) = nlevels(listId)
126 jmc 1.1
127 jmc 1.29 CALL MNC_CW_ADD_GNAME('diag_levels', 1,
128 jmc 1.1 & dim, dn, ib, ie, myThid)
129 jmc 1.29 CALL MNC_CW_ADD_VNAME('diag_levels', 'diag_levels',
130 jmc 1.1 & 0,0, myThid)
131 edhill 1.7 CALL MNC_CW_ADD_VATTR_TEXT('diag_levels','description',
132     & 'Idicies of vertical levels within the source arrays',
133 jmc 1.1 & myThid)
134 jmc 1.29
135 edhill 1.9 CALL MNC_CW_RL_W('D',diag_mnc_bn,0,0,
136 jmc 1.15 & 'diag_levels', levs(1,listId), myThid)
137 jmc 1.1
138 edhill 1.7 CALL MNC_CW_DEL_VNAME('diag_levels', myThid)
139 jmc 1.1 CALL MNC_CW_DEL_GNAME('diag_levels', myThid)
140 edhill 1.7
141 edhill 1.16 #ifdef DIAG_MNC_COORD_NEEDSWORK
142     C This part has been placed in an #ifdef because, as its currently
143     C written, it will only work with variables defined on a dynamics
144     C grid. As we start using diagnostics for physics grids, ice
145     C levels, land levels, etc. the different vertical coordinate
146     C dimensions will have to be taken into account.
147    
148 edhill 1.25 C 20051021 JMC & EH3 : We need to extend this so that a few
149     C variables each defined on different grids do not have the same
150     C vertical dimension names so we should be using a pattern such
151     C as: Z[uml]td000000 where the 't' is the type as specified by
152     C gdiag(10)
153    
154 edhill 1.7 C Now define: Zmdxxxxxx, Zudxxxxxx, Zldxxxxxx
155     ctmp(1:5) = 'mul '
156     DO i = 1,3
157     dn(1)(1:NLEN) = dn_blnk(1:NLEN)
158 jmc 1.15 WRITE(dn(1),'(3a,i6.6)') 'Z',ctmp(i:i),'d',nlevels(listId)
159 edhill 1.7 CALL MNC_CW_ADD_GNAME(dn(1), 1, dim, dn, ib, ie, myThid)
160     CALL MNC_CW_ADD_VNAME(dn(1), dn(1), 0,0, myThid)
161 edhill 1.10
162     C The following three ztmp() loops should eventually be modified
163     C to reflect the fractional nature of levs(j,l) -- they should
164     C do something like:
165 jmc 1.29 C ztmp(j) = rC(INT(FLOOR(levs(j,l))))
166     C + ( rC(INT(FLOOR(levs(j,l))))
167 edhill 1.10 C + rC(INT(CEIL(levs(j,l)))) )
168     C / ( levs(j,l) - FLOOR(levs(j,l)) )
169     C for averaged levels.
170     IF (i .EQ. 1) THEN
171 jmc 1.15 DO j = 1,nlevels(listId)
172     ztmp(j) = rC(NINT(levs(j,listId)))
173 edhill 1.10 ENDDO
174     CALL MNC_CW_ADD_VATTR_TEXT(dn(1),'description',
175     & 'Dimensional coordinate value at the mid point',
176     & myThid)
177     ELSEIF (i .EQ. 2) THEN
178 jmc 1.15 DO j = 1,nlevels(listId)
179     ztmp(j) = rF(NINT(levs(j,listId)) + 1)
180 edhill 1.10 ENDDO
181     CALL MNC_CW_ADD_VATTR_TEXT(dn(1),'description',
182     & 'Dimensional coordinate value at the upper point',
183     & myThid)
184     ELSEIF (i .EQ. 3) THEN
185 jmc 1.15 DO j = 1,nlevels(listId)
186     ztmp(j) = rF(NINT(levs(j,listId)))
187 edhill 1.10 ENDDO
188     CALL MNC_CW_ADD_VATTR_TEXT(dn(1),'description',
189     & 'Dimensional coordinate value at the lower point',
190     & myThid)
191     ENDIF
192 edhill 1.7 CALL MNC_CW_RS_W('D',diag_mnc_bn,0,0, dn(1), ztmp, myThid)
193     CALL MNC_CW_DEL_VNAME(dn(1), myThid)
194     CALL MNC_CW_DEL_GNAME(dn(1), myThid)
195     ENDDO
196 edhill 1.16 #endif /* DIAG_MNC_COORD_NEEDSWORK */
197 edhill 1.7
198 jmc 1.1 ENDIF
199     #endif /* ALLOW_MNC */
200    
201 jmc 1.29 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
202    
203 jmc 1.15 DO md = 1,nfields(listId)
204     ndId = jdiag(md,listId)
205 jmc 1.35 gcode = gdiag(ndId)(1:10)
206 jmc 1.29 mate = 0
207     mVec = 0
208 jmc 1.35 IF ( gcode(5:5).EQ.'C' ) THEN
209 jmc 1.29 C- Check for Mate of a Counter Diagnostic
210 jmc 1.35 mate = hdiag(ndId)
211     ELSEIF ( gcode(1:1).EQ.'U' .OR. gcode(1:1).EQ.'V' ) THEN
212 jmc 1.29 C- Check for Mate of a Vector Diagnostic
213 jmc 1.35 mate = hdiag(ndId)
214 jmc 1.29 ENDIF
215 jmc 1.35 IF ( idiag(md,listId).NE.0 .AND. gcode(5:5).NE.'D' ) THEN
216 jmc 1.3 C-- Start processing 1 Fld :
217 jmc 1.29 DO lm=1,averageCycle(listId)
218 jmc 1.3
219 jmc 1.29 ip = ABS(idiag(md,listId)) + kdiag(ndId)*(lm-1)
220 jmc 1.15 im = mdiag(md,listId)
221 jmc 1.29 IF (mate.GT.0) im = im + kdiag(mate)*(lm-1)
222     IF (mVec.GT.0) im = im + kdiag(mVec)*(lm-1)
223    
224 jmc 1.15 IF ( ndiag(ip,1,1).EQ.0 ) THEN
225 jmc 1.3 C- Empty diagnostics case :
226    
227     _BEGIN_MASTER( myThid )
228     WRITE(msgBuf,'(A,I10)')
229     & '- WARNING - from DIAGNOSTICS_OUT at iter=', myIter
230 jmc 1.15 CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
231 jmc 1.3 & SQUEEZE_RIGHT, myThid)
232 jmc 1.35 WRITE(msgBuf,'(A,I6,3A,I4,2A)')
233 jmc 1.15 & '- WARNING - diag.#',ndId, ' : ',flds(md,listId),
234     & ' (#',md,' ) in outp.Stream: ',fnames(listId)
235     CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
236 jmc 1.3 & SQUEEZE_RIGHT, myThid)
237 jmc 1.29 IF ( averageCycle(listId).GT.1 ) THEN
238 jmc 1.35 WRITE(msgBuf,'(A,2(I3,A))')
239 jmc 1.29 & '- WARNING - has not been filled (ndiag(lm=',lm,')=',
240     & ndiag(ip,1,1), ' )'
241     ELSE
242 jmc 1.35 WRITE(msgBuf,'(A,2(I3,A))')
243 jmc 1.29 & '- WARNING - has not been filled (ndiag=',
244     & ndiag(ip,1,1), ' )'
245     ENDIF
246 jmc 1.15 CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
247 jmc 1.3 & SQUEEZE_RIGHT, myThid)
248     WRITE(msgBuf,'(A)')
249     & 'WARNING DIAGNOSTICS_OUT => write ZEROS instead'
250 jmc 1.15 CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
251 jmc 1.3 & SQUEEZE_RIGHT, myThid)
252     _END_MASTER( myThid )
253     DO bj = myByLo(myThid), myByHi(myThid)
254     DO bi = myBxLo(myThid), myBxHi(myThid)
255 jmc 1.15 DO k = 1,nlevels(listId)
256 jmc 1.3 DO j = 1-OLy,sNy+OLy
257     DO i = 1-OLx,sNx+OLx
258     qtmp1(i,j,k,bi,bj) = 0. _d 0
259     ENDDO
260     ENDDO
261     ENDDO
262     ENDDO
263     ENDDO
264    
265     ELSE
266     C- diagnostics is not empty :
267    
268 jmc 1.29 IF ( debugLevel.GE.debLevA .AND. myThid.EQ.1 ) THEN
269 jmc 1.35 WRITE(ioUnit,'(A,I6,3A,I8,2A)')
270 jmc 1.15 & ' Computing Diagnostic # ', ndId, ' ', cdiag(ndId),
271     & ' Counter:',ndiag(ip,1,1),' Parms: ',gdiag(ndId)
272 jmc 1.29 IF ( mate.GT.0 ) THEN
273 jmc 1.35 WRITE(ioUnit,'(3A,I6,2A)')
274 jmc 1.15 & ' use Counter Mate for ', cdiag(ndId),
275     & ' Diagnostic # ',mate, ' ', cdiag(mate)
276 jmc 1.29 ELSEIF ( mVec.GT.0 ) THEN
277 jmc 1.15 IF ( im.GT.0 .AND. ndiag(MAX(1,im),1,1).GT.0 ) THEN
278 jmc 1.35 WRITE(ioUnit,'(3A,I6,3A)')
279 jmc 1.15 & ' Vector Mate for ', cdiag(ndId),
280     & ' Diagnostic # ',mVec, ' ', cdiag(mVec),
281     & ' exists '
282 jmc 1.3 ELSE
283 jmc 1.35 WRITE(ioUnit,'(3A,I6,3A)')
284 jmc 1.15 & ' Vector Mate for ', cdiag(ndId),
285     & ' Diagnostic # ',mVec, ' ', cdiag(mVec),
286     & ' not enabled'
287 jmc 1.3 ENDIF
288     ENDIF
289 jmc 1.6 ENDIF
290 jmc 1.3
291 jmc 1.30 IF ( fflags(listId)(2:2).EQ.'P' ) THEN
292     C- get all the levels (for vertical interpolation)
293     DO bj = myByLo(myThid), myByHi(myThid)
294     DO bi = myBxLo(myThid), myBxHi(myThid)
295     DO k = 1,kdiag(ndId)
296     tmpLev = k
297     CALL GETDIAG(
298     I tmpLev,undef,
299     O qtmp1(1-OLx,1-OLy,k,bi,bj),
300     I ndId,mate,ip,im,bi,bj,myThid)
301     ENDDO
302     ENDDO
303     ENDDO
304     ELSE
305     C- get only selected levels:
306     DO bj = myByLo(myThid), myByHi(myThid)
307     DO bi = myBxLo(myThid), myBxHi(myThid)
308     DO k = 1,nlevels(listId)
309     CALL GETDIAG(
310     I levs(k,listId),undef,
311     O qtmp1(1-OLx,1-OLy,k,bi,bj),
312     I ndId,mate,ip,im,bi,bj,myThid)
313     ENDDO
314     ENDDO
315 jmc 1.3 ENDDO
316 jmc 1.30 ENDIF
317 jmc 1.1
318 jmc 1.3 C- end of empty diag / not empty block
319     ENDIF
320 jmc 1.1
321 molod 1.17 C-----------------------------------------------------------------------
322 jmc 1.20 C Check to see if we need to interpolate before output
323 molod 1.17 C-----------------------------------------------------------------------
324 jmc 1.29 IF ( fflags(listId)(2:2).EQ.'P' ) THEN
325 jmc 1.20 C- Do vertical interpolation:
326 jmc 1.30 IF ( fluidIsAir ) THEN
327 jmc 1.29 C jmc: for now, this can only work in an atmospheric set-up (fluidIsAir);
328     CALL DIAGNOSTICS_INTERP_VERT(
329 jmc 1.30 I listId, md, ndId, ip, im, lm,
330 jmc 1.20 U qtmp1,
331 jmc 1.30 I undef, myTime, myIter, myThid )
332 jmc 1.29 ELSE
333     WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_OUT: ',
334 jmc 1.30 & 'INTERP_VERT not allowed in this config'
335 jmc 1.29 CALL PRINT_ERROR( msgBuf , myThid )
336     STOP 'ABNORMAL END: S/R DIAGNOSTICS_OUT'
337     ENDIF
338     ENDIF
339 molod 1.17
340 jmc 1.31 C-- Ready to write field "md", element "lm" in averageCycle(listId)
341    
342     C- write to binary file, using MDSIO pkg:
343 jmc 1.34 IF ( diag_mdsio ) THEN
344 jmc 1.29 nRec = lm + (md-1)*averageCycle(listId)
345 jmc 1.30 C default precision for output files
346     prec = writeBinaryPrec
347     C fFlag(1)=R(or D): force it to be 32-bit(or 64) precision
348     IF ( fflags(listId)(1:1).EQ.'R' ) prec = precFloat32
349     IF ( fflags(listId)(1:1).EQ.'D' ) prec = precFloat64
350 jmc 1.34 C a hack not to write meta files now: pass -nRec < 0 to MDS_WRITE S/R
351     CALL WRITE_REC_LEV_RL(
352     I fn, prec,
353     I NrMax, 1, nlevels(listId),
354     I qtmp1, -nRec, myIter, myThid )
355 jmc 1.3 ENDIF
356 jmc 1.1
357     #ifdef ALLOW_MNC
358 jmc 1.3 IF (useMNC .AND. diag_mnc) THEN
359 jmc 1.1
360 jmc 1.3 _BEGIN_MASTER( myThid )
361 jmc 1.1
362 jmc 1.3 DO ii = 1,CW_DIMS
363 edhill 1.7 d_cw_name(1:NLEN) = dn_blnk(1:NLEN)
364 jmc 1.3 dn(ii)(1:NLEN) = dn_blnk(1:NLEN)
365     ENDDO
366    
367 edhill 1.7 C Note that the "d_cw_name" variable is a hack that hides a
368     C subtlety within MNC. Basically, each MNC-wrapped file is
369     C caching its own concept of what each "grid name" (that is, a
370     C dimension group name) means. So one cannot re-use the same
371     C "grid" name for different collections of dimensions within a
372 jmc 1.15 C given file. By appending the "ndId" values to each name, we
373 edhill 1.7 C guarantee uniqueness within each MNC-produced file.
374 jmc 1.15 WRITE(d_cw_name,'(a,i6.6)') 'd_cw_',ndId
375 edhill 1.7
376 edhill 1.5 C XY dimensions
377     dim(1) = sNx + 2*OLx
378     dim(2) = sNy + 2*OLy
379     ib(1) = OLx + 1
380     ib(2) = OLy + 1
381 jmc 1.29 IF (gdiag(ndId)(2:2) .EQ. 'M') THEN
382 edhill 1.5 dn(1)(1:2) = 'X'
383     ie(1) = OLx + sNx
384     dn(2)(1:2) = 'Y'
385     ie(2) = OLy + sNy
386 jmc 1.15 ELSEIF (gdiag(ndId)(2:2) .EQ. 'U') THEN
387 edhill 1.5 dn(1)(1:3) = 'Xp1'
388     ie(1) = OLx + sNx + 1
389     dn(2)(1:2) = 'Y'
390     ie(2) = OLy + sNy
391 jmc 1.15 ELSEIF (gdiag(ndId)(2:2) .EQ. 'V') THEN
392 edhill 1.5 dn(1)(1:2) = 'X'
393     ie(1) = OLx + sNx
394     dn(2)(1:3) = 'Yp1'
395     ie(2) = OLy + sNy + 1
396 jmc 1.15 ELSEIF (gdiag(ndId)(2:2) .EQ. 'Z') THEN
397 edhill 1.5 dn(1)(1:3) = 'Xp1'
398     ie(1) = OLx + sNx + 1
399     dn(2)(1:3) = 'Yp1'
400     ie(2) = OLy + sNy + 1
401     ENDIF
402 jmc 1.29
403 jmc 1.3 C Z is special since it varies
404 jmc 1.30 WRITE(dn(3),'(a,i6.6)') 'Zd', nlevels(listId)
405 jmc 1.15 IF ( (gdiag(ndId)(10:10) .EQ. 'R')
406     & .AND. (gdiag(ndId)(9:9) .EQ. 'M') ) THEN
407 jmc 1.30 WRITE(dn(3),'(a,i6.6)') 'Zmd', nlevels(listId)
408 edhill 1.7 ENDIF
409 jmc 1.15 IF ( (gdiag(ndId)(10:10) .EQ. 'R')
410     & .AND. (gdiag(ndId)(9:9) .EQ. 'L') ) THEN
411 jmc 1.30 WRITE(dn(3),'(a,i6.6)') 'Zld', nlevels(listId)
412 edhill 1.7 ENDIF
413 jmc 1.15 IF ( (gdiag(ndId)(10:10) .EQ. 'R')
414     & .AND. (gdiag(ndId)(9:9) .EQ. 'U') ) THEN
415 jmc 1.30 WRITE(dn(3),'(a,i6.6)') 'Zud', nlevels(listId)
416 edhill 1.7 ENDIF
417 jmc 1.30 dim(3) = NrMax
418 jmc 1.3 ib(3) = 1
419 jmc 1.30 ie(3) = nlevels(listId)
420 jmc 1.1
421 edhill 1.5 C Time dimension
422     dn(4)(1:1) = 'T'
423     dim(4) = -1
424     ib(4) = 1
425     ie(4) = 1
426    
427 jmc 1.29 CALL MNC_CW_ADD_GNAME(d_cw_name, 4,
428 jmc 1.1 & dim, dn, ib, ie, myThid)
429 jmc 1.29 CALL MNC_CW_ADD_VNAME(cdiag(ndId), d_cw_name,
430 jmc 1.1 & 4,5, myThid)
431 jmc 1.15 CALL MNC_CW_ADD_VATTR_TEXT(cdiag(ndId),'description',
432     & tdiag(ndId),myThid)
433     CALL MNC_CW_ADD_VATTR_TEXT(cdiag(ndId),'units',
434     & udiag(ndId),myThid)
435 edhill 1.28
436     C Per the observations of Baylor, this has been commented out
437     C until we have code that can write missing_value attributes
438     C in a way thats compatible with most of the more popular
439     C netCDF tools including ferret. Using all-zeros completely
440     C breaks ferret.
441    
442     C CALL MNC_CW_ADD_VATTR_DBL(cdiag(ndId),'missing_value',
443     C & 0.0 _d 0,myThid)
444 jmc 1.1
445 edhill 1.22 IF ( ( (writeBinaryPrec .EQ. precFloat32)
446     & .AND. (fflags(listId)(1:1) .NE. 'D')
447     & .AND. (fflags(listId)(1:1) .NE. 'R') )
448 jmc 1.15 & .OR. (fflags(listId)(1:1) .EQ. 'R')) THEN
449 edhill 1.13 CALL MNC_CW_RL_W('R',diag_mnc_bn,0,0,
450 jmc 1.15 & cdiag(ndId), qtmp1, myThid)
451 jmc 1.29 ELSEIF ( (writeBinaryPrec .EQ. precFloat64)
452 edhill 1.22 & .OR. (fflags(listId)(1:1) .EQ. 'D') ) THEN
453 edhill 1.13 CALL MNC_CW_RL_W('D',diag_mnc_bn,0,0,
454 jmc 1.15 & cdiag(ndId), qtmp1, myThid)
455 edhill 1.13 ENDIF
456 jmc 1.29
457 jmc 1.15 CALL MNC_CW_DEL_VNAME(cdiag(ndId), myThid)
458 edhill 1.7 CALL MNC_CW_DEL_GNAME(d_cw_name, myThid)
459 jmc 1.1
460 jmc 1.3 _END_MASTER( myThid )
461 jmc 1.1
462 jmc 1.3 ENDIF
463 jmc 1.1 #endif /* ALLOW_MNC */
464    
465 jmc 1.29 ENDDO
466 jmc 1.15 C-- end of Processing Fld # md
467 jmc 1.3 ENDIF
468     ENDDO
469 jmc 1.1
470 jmc 1.31 #ifdef ALLOW_MDSIO
471     IF (diag_mdsio) THEN
472     C- Note: temporary: since it's a pain to add more arguments to
473     C all MDSIO S/R, uses instead this specific S/R to write only
474     C meta files but with more informations in it.
475 jmc 1.34 glf = globalFiles
476 jmc 1.31 nRec = nfields(listId)*averageCycle(listId)
477     CALL MDS_WR_METAFILES(fn, prec, glf, .FALSE.,
478     & 0, 0, nlevels(listId), ' ',
479     & nfields(listId), flds(1,listId), 1, myTime,
480     & nRec, myIter, myThid)
481     ENDIF
482     #endif /* ALLOW_MDSIO */
483    
484 jmc 1.15 RETURN
485 jmc 1.3 END
486 jmc 1.15
487 jmc 1.1 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
  ViewVC Help
Powered by ViewVC 1.1.22