/[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.58 - (hide annotations) (download)
Fri Jul 1 18:49:35 2011 UTC (12 years, 10 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint63
Changes since 1.57: +51 -13 lines 
- Switch to write qtmp2 (instead of always qtmp1) for Post-Processed diag from
  an other Post-Processed diag.
- Skip computation of 2nd Post-Processed diag if it's still stored in qtmp2 ;
1 jmc 1.58 C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diagnostics_out.F,v 1.57 2011/06/27 22:27:23 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 jmc 1.47 SUBROUTINE DIAGNOSTICS_OUT(
12 jmc 1.15 I listId,
13 jmc 1.50 I myTime,
14 jmc 1.1 I myIter,
15     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.40 C !FUNCTIONS:
42     INTEGER ILNBLNK
43     EXTERNAL ILNBLNK
44     #ifdef ALLOW_FIZHI
45     _RL getcon
46     EXTERNAL getcon
47     #endif
48    
49 jmc 1.3 C !LOCAL VARIABLES:
50 jmc 1.15 C i,j,k :: loop indices
51 jmc 1.47 C bi,bj :: tile indices
52 jmc 1.29 C lm :: loop index (averageCycle)
53 jmc 1.15 C md :: field number in the list "listId".
54     C ndId :: diagnostics Id number (in available diagnostics list)
55     C ip :: diagnostics pointer to storage array
56     C im :: counter-mate pointer to storage array
57 jmc 1.58 C mate :: counter mate Id number (in available diagnostics list)
58     C mDbl :: processing mate Id number (in case processing requires 2 diags)
59     C mVec :: vector mate Id number
60     C ppFld :: post-processed diag or not (=0): =1 stored in qtmp1 ; =2 in qtmp2
61     C isComputed :: previous post-processed diag (still available in qtmp)
62 jmc 1.47 C nLevOutp :: number of levels to write in output file
63 jmc 1.32 C
64     C-- COMMON /LOCAL_DIAGNOSTICS_OUT/ local common block (for multi-threaded)
65 jmc 1.52 C qtmp1 :: temporary array; used to store a copy of diag. output field.
66     C qtmp2 :: temporary array; used to store a copy of a 2nd diag. field.
67     C- Note: local common block no longer needed.
68     c COMMON /LOCAL_DIAGNOSTICS_OUT/ qtmp1
69 jmc 1.32 _RL qtmp1(1-OLx:sNx+OLx,1-OLy:sNy+OLy,NrMax,nSx,nSy)
70 jmc 1.52 _RL qtmp2(1-OLx:sNx+OLx,1-OLy:sNy+OLy,NrMax,nSx,nSy)
71 jmc 1.32
72 jmc 1.43 INTEGER i, j, k, lm
73 jmc 1.15 INTEGER bi, bj
74 jmc 1.54 INTEGER md, ndId, nn, ip, im
75     INTEGER mate, mDbl, mVec
76 jmc 1.58 INTEGER ppFld, isComputed
77 jmc 1.35 CHARACTER*10 gcode
78 jmc 1.52 _RL undefRL
79     INTEGER nLevOutp, kLev
80    
81 jmc 1.50 INTEGER iLen
82 jmc 1.6 INTEGER ioUnit
83 jmc 1.11 CHARACTER*(MAX_LEN_FNAM) fn
84 jmc 1.1 CHARACTER*(MAX_LEN_MBUF) suff
85 jmc 1.3 CHARACTER*(MAX_LEN_MBUF) msgBuf
86 jmc 1.44 INTEGER prec, nRec, nTimRec
87     _RL timeRec(2)
88 jmc 1.52 _RL tmpLoc
89 jmc 1.29 #ifdef ALLOW_MDSIO
90 jmc 1.3 LOGICAL glf
91 jmc 1.29 #endif
92 jmc 1.1 #ifdef ALLOW_MNC
93     CHARACTER*(MAX_LEN_FNAM) diag_mnc_bn
94     #endif /* ALLOW_MNC */
95    
96 jmc 1.3 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
97    
98 jmc 1.44 C--- set file properties
99 jmc 1.6 ioUnit= standardMessageUnit
100 jmc 1.52 undefRL = UNSET_RL
101 jmc 1.40 #ifdef ALLOW_FIZHI
102 jmc 1.52 IF ( useFIZHI ) undefRL = getcon('UNDEF')
103 jmc 1.40 #endif
104 jmc 1.56 IF ( misvalFlt(listId).NE.UNSET_RL ) undefRL = misvalFlt(listId)
105    
106 jmc 1.1 WRITE(suff,'(I10.10)') myIter
107 jmc 1.50 iLen = ILNBLNK(fnames(listId))
108     WRITE( fn, '(A,A,A)' ) fnames(listId)(1:iLen),'.',suff(1:10)
109 jmc 1.47 C- for now, if integrate vertically, output field has just 1 level:
110     nLevOutp = nlevels(listId)
111     IF ( fflags(listId)(2:2).EQ.'I' ) nLevOutp = 1
112 jmc 1.1
113 jmc 1.44 C-- Set time information:
114     IF ( freq(listId).LT.0. ) THEN
115     C- Snap-shot: store a unique time (which is consistent with State-Var timing)
116     nTimRec = 1
117     timeRec(1) = myTime
118     ELSE
119     C- Time-average: store the 2 edges of the time-averaging interval.
120     C this time is consitent with intermediate Var (i.e., non-state, e.g, flux,
121     C tendencies) timing. For State-Var, this is shifted by + halt time-step.
122     nTimRec = 2
123    
124     C- end of time-averaging interval:
125     timeRec(2) = myTime
126    
127     C- begining of time-averaging interval:
128     c timeRec(1) = myTime - freq(listId)
129     C a) find the time of the previous multiple of output freq:
130     timeRec(1) = myTime-deltaTClock*0.5 _d 0
131     timeRec(1) = (timeRec(1)-phase(listId))/freq(listId)
132     i = INT( timeRec(1) )
133 jmc 1.46 IF ( timeRec(1).LT.0. ) THEN
134 jmc 1.52 tmpLoc = FLOAT(i)
135     IF ( timeRec(1).NE.tmpLoc ) i = i - 1
136 jmc 1.46 ENDIF
137 jmc 1.44 timeRec(1) = phase(listId) + freq(listId)*FLOAT(i)
138     c if ( listId.eq.2 ) write(0,*) 'f',i,timeRec(1)/deltaTClock
139     timeRec(1) = MAX( timeRec(1), startTime )
140    
141     C b) round off to nearest multiple of time-step:
142     timeRec(1) = (timeRec(1)-baseTime)/deltaTClock
143     i = NINT( timeRec(1) )
144     C if just half way, NINT will return the next time-step: correct this
145 jmc 1.52 tmpLoc = FLOAT(i) - 0.5 _d 0
146     IF ( timeRec(1).EQ.tmpLoc ) i = i - 1
147 jmc 1.44 timeRec(1) = baseTime + deltaTClock*FLOAT(i)
148     c if ( listId.eq.2 ) write(0,*) i,timeRec(1)/deltaTClock
149     ENDIF
150 jmc 1.46 C-- Convert time to iteration number (debug)
151     c DO i=1,nTimRec
152     c timeRec(i) = timeRec(i)/deltaTClock
153     c ENDDO
154 jmc 1.44
155 jmc 1.55 C-- Place the loop on lm (= averagePeriod) outside the loop on md (= field):
156     DO lm=1,averageCycle(listId)
157    
158 jmc 1.1 #ifdef ALLOW_MNC
159 jmc 1.41 IF (useMNC .AND. diag_mnc) THEN
160 jmc 1.50 CALL DIAGNOSTICS_MNC_SET(
161 jmc 1.55 I nLevOutp, listId, lm,
162 jmc 1.57 O diag_mnc_bn,
163 jmc 1.56 I undefRL, myTime, myIter, myThid )
164 jmc 1.41 ENDIF
165 jmc 1.1 #endif /* ALLOW_MNC */
166    
167 jmc 1.29 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
168    
169 jmc 1.58 isComputed = 0
170 jmc 1.41 DO md = 1,nfields(listId)
171 jmc 1.15 ndId = jdiag(md,listId)
172 jmc 1.35 gcode = gdiag(ndId)(1:10)
173 jmc 1.29 mate = 0
174     mVec = 0
175 jmc 1.54 mDbl = 0
176 jmc 1.58 ppFld = 0
177 jmc 1.35 IF ( gcode(5:5).EQ.'C' ) THEN
178 jmc 1.29 C- Check for Mate of a Counter Diagnostic
179 jmc 1.35 mate = hdiag(ndId)
180 jmc 1.54 ELSEIF ( gcode(5:5).EQ.'P' ) THEN
181 jmc 1.58 ppFld = 1
182     IF ( gdiag(hdiag(ndId))(5:5).EQ.'P' ) ppFld = 2
183 jmc 1.54 C- Also load the mate (if stored) for Post-Processing
184     nn = ndId
185     DO WHILE ( gdiag(nn)(5:5).EQ.'P' )
186     nn = hdiag(nn)
187     ENDDO
188     IF ( mdiag(md,listId).NE.0 ) mDbl = hdiag(nn)
189 jmc 1.58 c write(0,*) ppFld,' ndId=', ndId, nn, mDbl, isComputed
190 jmc 1.35 ELSEIF ( gcode(1:1).EQ.'U' .OR. gcode(1:1).EQ.'V' ) THEN
191 jmc 1.29 C- Check for Mate of a Vector Diagnostic
192 jmc 1.36 mVec = hdiag(ndId)
193 jmc 1.29 ENDIF
194 jmc 1.35 IF ( idiag(md,listId).NE.0 .AND. gcode(5:5).NE.'D' ) THEN
195 jmc 1.3 C-- Start processing 1 Fld :
196    
197 jmc 1.29 ip = ABS(idiag(md,listId)) + kdiag(ndId)*(lm-1)
198 jmc 1.15 im = mdiag(md,listId)
199 jmc 1.29 IF (mate.GT.0) im = im + kdiag(mate)*(lm-1)
200 jmc 1.54 IF (mDbl.GT.0) im = im + kdiag(mDbl)*(lm-1)
201 jmc 1.29 IF (mVec.GT.0) im = im + kdiag(mVec)*(lm-1)
202    
203 jmc 1.58 IF ( ppFld.EQ.2 .AND. isComputed.EQ.hdiag(ndId) ) THEN
204     C- Post-Processed diag from an other Post-Processed diag -and-
205     C both of them have just been calculated and are still stored in qtmp:
206     C => skip computation and just write qtmp2
207     IF ( debugLevel.GE.debLevB .AND. myThid.EQ.1 ) THEN
208     WRITE(ioUnit,'(A,I6,3A,I6)')
209     & ' get Post-Proc. Diag # ', ndId, ' ', cdiag(ndId),
210     & ' from previous computation of Diag # ', isComputed
211     ENDIF
212     isComputed = 0
213     ELSEIF ( ndiag(ip,1,1).EQ.0 ) THEN
214 jmc 1.3 C- Empty diagnostics case :
215 jmc 1.58 isComputed = 0
216 jmc 1.3
217     _BEGIN_MASTER( myThid )
218     WRITE(msgBuf,'(A,I10)')
219     & '- WARNING - from DIAGNOSTICS_OUT at iter=', myIter
220 jmc 1.15 CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
221 jmc 1.3 & SQUEEZE_RIGHT, myThid)
222 jmc 1.35 WRITE(msgBuf,'(A,I6,3A,I4,2A)')
223 jmc 1.15 & '- WARNING - diag.#',ndId, ' : ',flds(md,listId),
224     & ' (#',md,' ) in outp.Stream: ',fnames(listId)
225     CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
226 jmc 1.3 & SQUEEZE_RIGHT, myThid)
227 jmc 1.29 IF ( averageCycle(listId).GT.1 ) THEN
228 jmc 1.35 WRITE(msgBuf,'(A,2(I3,A))')
229 jmc 1.29 & '- WARNING - has not been filled (ndiag(lm=',lm,')=',
230     & ndiag(ip,1,1), ' )'
231     ELSE
232 jmc 1.35 WRITE(msgBuf,'(A,2(I3,A))')
233 jmc 1.29 & '- WARNING - has not been filled (ndiag=',
234     & ndiag(ip,1,1), ' )'
235     ENDIF
236 jmc 1.15 CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
237 jmc 1.3 & SQUEEZE_RIGHT, myThid)
238     WRITE(msgBuf,'(A)')
239     & 'WARNING DIAGNOSTICS_OUT => write ZEROS instead'
240 jmc 1.15 CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
241 jmc 1.3 & SQUEEZE_RIGHT, myThid)
242     _END_MASTER( myThid )
243     DO bj = myByLo(myThid), myByHi(myThid)
244     DO bi = myBxLo(myThid), myBxHi(myThid)
245 jmc 1.47 DO k = 1,nLevOutp
246 jmc 1.3 DO j = 1-OLy,sNy+OLy
247     DO i = 1-OLx,sNx+OLx
248     qtmp1(i,j,k,bi,bj) = 0. _d 0
249     ENDDO
250     ENDDO
251     ENDDO
252     ENDDO
253     ENDDO
254    
255 jmc 1.54 ELSE
256 jmc 1.3 C- diagnostics is not empty :
257 jmc 1.58 isComputed = 0
258 jmc 1.3
259 jmc 1.49 IF ( debugLevel.GE.debLevB .AND. myThid.EQ.1 ) THEN
260 jmc 1.58 IF ( ppFld.GE.1 ) THEN
261 jmc 1.54 WRITE(ioUnit,'(A,I6,7A,I8,2A)')
262     & ' Post-Processing Diag # ', ndId, ' ', cdiag(ndId),
263     & ' Parms: ',gdiag(ndId)
264     IF ( mDbl.EQ.0 ) THEN
265     WRITE(ioUnit,'(2(3A,I6,A,I8))') ' from diag: ',
266     & cdiag(nn), ' (#', nn, ') Cnt=', ndiag(ip,1,1)
267     ELSE
268     WRITE(ioUnit,'(2(3A,I6,A,I8))') ' from diag: ',
269     & cdiag(nn), ' (#', nn, ') Cnt=', ndiag(ip,1,1),
270     & ' and diag: ',
271     & cdiag(mDbl),' (#',mDbl,') Cnt=',ndiag(im,1,1)
272     ENDIF
273     ELSE
274     WRITE(ioUnit,'(A,I6,3A,I8,2A)')
275 jmc 1.15 & ' Computing Diagnostic # ', ndId, ' ', cdiag(ndId),
276     & ' Counter:',ndiag(ip,1,1),' Parms: ',gdiag(ndId)
277 jmc 1.54 ENDIF
278 jmc 1.29 IF ( mate.GT.0 ) THEN
279 jmc 1.35 WRITE(ioUnit,'(3A,I6,2A)')
280 jmc 1.15 & ' use Counter Mate for ', cdiag(ndId),
281     & ' Diagnostic # ',mate, ' ', cdiag(mate)
282 jmc 1.29 ELSEIF ( mVec.GT.0 ) THEN
283 jmc 1.15 IF ( im.GT.0 .AND. ndiag(MAX(1,im),1,1).GT.0 ) THEN
284 jmc 1.35 WRITE(ioUnit,'(3A,I6,3A)')
285 jmc 1.15 & ' Vector Mate for ', cdiag(ndId),
286     & ' Diagnostic # ',mVec, ' ', cdiag(mVec),
287     & ' exists '
288 jmc 1.3 ELSE
289 jmc 1.35 WRITE(ioUnit,'(3A,I6,3A)')
290 jmc 1.15 & ' Vector Mate for ', cdiag(ndId),
291     & ' Diagnostic # ',mVec, ' ', cdiag(mVec),
292     & ' not enabled'
293 jmc 1.3 ENDIF
294     ENDIF
295 jmc 1.6 ENDIF
296 jmc 1.3
297 jmc 1.52 IF ( fflags(listId)(2:2).EQ.' ' ) THEN
298     C- get only selected levels:
299 jmc 1.30 DO bj = myByLo(myThid), myByHi(myThid)
300     DO bi = myBxLo(myThid), myBxHi(myThid)
301 jmc 1.52 DO k = 1,nlevels(listId)
302     kLev = NINT(levs(k,listId))
303     CALL DIAGNOSTICS_GET_DIAG(
304     I kLev, undefRL,
305 jmc 1.30 O qtmp1(1-OLx,1-OLy,k,bi,bj),
306 jmc 1.54 I ndId, mate, ip, im, bi, bj, myThid )
307 jmc 1.30 ENDDO
308     ENDDO
309     ENDDO
310 jmc 1.54 IF ( mDbl.GT.0 ) THEN
311     DO bj = myByLo(myThid), myByHi(myThid)
312     DO bi = myBxLo(myThid), myBxHi(myThid)
313     DO k = 1,nlevels(listId)
314     kLev = NINT(levs(k,listId))
315     CALL DIAGNOSTICS_GET_DIAG(
316     I kLev, undefRL,
317     O qtmp2(1-OLx,1-OLy,k,bi,bj),
318     I mDbl, 0, im, 0, bi, bj, myThid )
319     ENDDO
320     ENDDO
321     ENDDO
322     ENDIF
323 jmc 1.30 ELSE
324 jmc 1.52 C- get all the levels (for vertical post-processing)
325 jmc 1.30 DO bj = myByLo(myThid), myByHi(myThid)
326     DO bi = myBxLo(myThid), myBxHi(myThid)
327 jmc 1.52 CALL DIAGNOSTICS_GET_DIAG(
328     I 0, undefRL,
329     O qtmp1(1-OLx,1-OLy,1,bi,bj),
330 jmc 1.54 I ndId, mate, ip, im, bi, bj, myThid )
331 jmc 1.30 ENDDO
332 jmc 1.3 ENDDO
333 jmc 1.54 IF ( mDbl.GT.0 ) THEN
334     DO bj = myByLo(myThid), myByHi(myThid)
335     DO bi = myBxLo(myThid), myBxHi(myThid)
336     DO k = 1,nlevels(listId)
337     CALL DIAGNOSTICS_GET_DIAG(
338     I 0, undefRL,
339     O qtmp2(1-OLx,1-OLy,k,bi,bj),
340     I mDbl, 0, im, 0, bi, bj, myThid )
341     ENDDO
342     ENDDO
343     ENDDO
344     ENDIF
345 jmc 1.30 ENDIF
346 jmc 1.1
347 molod 1.17 C-----------------------------------------------------------------------
348 jmc 1.47 C-- Apply specific post-processing (e.g., interpolate) before output
349 molod 1.17 C-----------------------------------------------------------------------
350 jmc 1.47 IF ( fflags(listId)(2:2).EQ.'P' ) THEN
351     C- Do vertical interpolation:
352     IF ( fluidIsAir ) THEN
353 jmc 1.29 C jmc: for now, this can only work in an atmospheric set-up (fluidIsAir);
354 jmc 1.47 CALL DIAGNOSTICS_INTERP_VERT(
355     I listId, md, ndId, ip, im, lm,
356 jmc 1.52 U qtmp1, qtmp2,
357     I undefRL, myTime, myIter, myThid )
358 jmc 1.47 ELSE
359     WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_OUT: ',
360     & 'INTERP_VERT not allowed in this config'
361     CALL PRINT_ERROR( msgBuf , myThid )
362     STOP 'ABNORMAL END: S/R DIAGNOSTICS_OUT'
363     ENDIF
364     ENDIF
365     IF ( fflags(listId)(2:2).EQ.'I' ) THEN
366     C- Integrate vertically: for now, output field has just 1 level:
367     CALL DIAGNOSTICS_SUM_LEVELS(
368     I listId, md, ndId, ip, im, lm,
369     U qtmp1,
370 jmc 1.52 I undefRL, myTime, myIter, myThid )
371 jmc 1.47 ENDIF
372 jmc 1.58 IF ( ppFld.GE.1 ) THEN
373 jmc 1.54 C- Do Post-Processing:
374     IF ( flds(md,listId).EQ.'PhiVEL '
375 jmc 1.58 & .OR. flds(md,listId).EQ.'PsiVEL '
376 jmc 1.54 & ) THEN
377     CALL DIAGNOSTICS_CALC_PHIVEL(
378     I listId, md, ndId, ip, im, lm,
379 jmc 1.58 I NrMax,
380 jmc 1.54 U qtmp1, qtmp2,
381     I myTime, myIter, myThid )
382 jmc 1.58 isComputed = ndId
383 jmc 1.54 ELSE
384     WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_OUT: ',
385     & 'unknown Processing method for diag="',cdiag(ndId),'"'
386     CALL PRINT_ERROR( msgBuf , myThid )
387     STOP 'ABNORMAL END: S/R DIAGNOSTICS_OUT'
388     ENDIF
389     ENDIF
390 jmc 1.47
391     C-- End of empty diag / not-empty diag block
392 jmc 1.29 ENDIF
393 molod 1.17
394 jmc 1.47 C-- Ready to write field "md", element "lm" in averageCycle(listId)
395 jmc 1.31
396     C- write to binary file, using MDSIO pkg:
397 jmc 1.34 IF ( diag_mdsio ) THEN
398 jmc 1.58 c nRec = lm + (md-1)*averageCycle(listId)
399     nRec = md + (lm-1)*nfields(listId)
400     C default precision for output files
401     prec = writeBinaryPrec
402     C fFlag(1)=R(or D): force it to be 32-bit(or 64) precision
403     IF ( fflags(listId)(1:1).EQ.'R' ) prec = precFloat32
404     IF ( fflags(listId)(1:1).EQ.'D' ) prec = precFloat64
405 jmc 1.34 C a hack not to write meta files now: pass -nRec < 0 to MDS_WRITE S/R
406 jmc 1.58 IF ( ppFld.LE.1 ) THEN
407 jmc 1.34 CALL WRITE_REC_LEV_RL(
408     I fn, prec,
409 jmc 1.47 I NrMax, 1, nLevOutp,
410 jmc 1.34 I qtmp1, -nRec, myIter, myThid )
411 jmc 1.58 ELSE
412     CALL WRITE_REC_LEV_RL(
413     I fn, prec,
414     I NrMax, 1, nLevOutp,
415     I qtmp2, -nRec, myIter, myThid )
416     ENDIF
417 jmc 1.3 ENDIF
418 jmc 1.1
419     #ifdef ALLOW_MNC
420 jmc 1.3 IF (useMNC .AND. diag_mnc) THEN
421 jmc 1.58 IF ( ppFld.LE.1 ) THEN
422 jmc 1.50 CALL DIAGNOSTICS_MNC_OUT(
423 jmc 1.56 I NrMax, nLevOutp, listId, ndId, mate,
424 jmc 1.57 I diag_mnc_bn, qtmp1,
425     I undefRL, myTime, myIter, myThid )
426 jmc 1.58 ELSE
427     CALL DIAGNOSTICS_MNC_OUT(
428     I NrMax, nLevOutp, listId, ndId, mate,
429     I diag_mnc_bn, qtmp2,
430     I undefRL, myTime, myIter, myThid )
431     ENDIF
432 jmc 1.3 ENDIF
433 jmc 1.1 #endif /* ALLOW_MNC */
434    
435 jmc 1.15 C-- end of Processing Fld # md
436 jmc 1.3 ENDIF
437 jmc 1.41 ENDDO
438    
439 jmc 1.55 C-- end loop on lm counter (= averagePeriod)
440 jmc 1.3 ENDDO
441 jmc 1.1
442 jmc 1.31 #ifdef ALLOW_MDSIO
443     IF (diag_mdsio) THEN
444 jmc 1.48 C- Note: temporary: since it is a pain to add more arguments to
445 jmc 1.31 C all MDSIO S/R, uses instead this specific S/R to write only
446     C meta files but with more informations in it.
447 jmc 1.34 glf = globalFiles
448 jmc 1.55 nRec = averageCycle(listId)*nfields(listId)
449 jmc 1.31 CALL MDS_WR_METAFILES(fn, prec, glf, .FALSE.,
450 jmc 1.47 & 0, 0, nLevOutp, ' ',
451 jmc 1.44 & nfields(listId), flds(1,listId), nTimRec, timeRec,
452 jmc 1.31 & nRec, myIter, myThid)
453     ENDIF
454     #endif /* ALLOW_MDSIO */
455    
456 jmc 1.15 RETURN
457 jmc 1.3 END
458 jmc 1.15
459 jmc 1.1 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
  ViewVC Help
Powered by ViewVC 1.1.22