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

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

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


Revision 1.45 - (hide annotations) (download)
Wed Aug 9 15:23:38 2017 UTC (6 years, 9 months ago) by mlosch
Branch: MAIN
CVS Tags: checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, HEAD
Changes since 1.44: +7 -5 lines
replace CLOSE(nmlfileUnit) with CLOSE(nmlfileUnit,STATUS='DELETE') to remove
scratchfiles after closing, except for SINGLE_DISK_IO, when everything
stays the same

1 mlosch 1.45 C $Header$
2     C $Name$
3 jmc 1.1
4     #include "DIAG_OPTIONS.h"
5    
6     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7     CBOP 0
8     C !ROUTINE: DIAGNOSTICS_READPARMS
9    
10     C !INTERFACE:
11 jmc 1.35 SUBROUTINE DIAGNOSTICS_READPARMS( myThid )
12 jmc 1.1
13     C !DESCRIPTION:
14     C Read Diagnostics Namelists to specify output sequence.
15 jmc 1.3
16 jmc 1.1 C !USES:
17     IMPLICIT NONE
18     #include "SIZE.h"
19     #include "EEPARAMS.h"
20     #include "PARAMS.h"
21     #include "DIAGNOSTICS_SIZE.h"
22     #include "DIAGNOSTICS.h"
23 jmc 1.30 #include "DIAGNOSTICS_CALC.h"
24 jmc 1.15 #include "DIAGSTATS_REGIONS.h"
25 jmc 1.1
26     C !INPUT PARAMETERS:
27     INTEGER myThid
28     CEOP
29    
30 jmc 1.33 C !FUNCTIONS:
31     INTEGER ILNBLNK
32     EXTERNAL ILNBLNK
33 jmc 1.43 CHARACTER*(8) DIAGS_RENAMED
34     EXTERNAL DIAGS_RENAMED
35 jmc 1.33 #ifdef ALLOW_FIZHI
36     _RL getcon
37     EXTERNAL getcon
38     #endif
39    
40 jmc 1.1 C !LOCAL VARIABLES:
41 jmc 1.15 C ldimLoc :: Max Number of Lists (in data.diagnostics)
42     C kdimLoc :: Max Number of Levels (in data.diagnostics)
43     C fdimLoc :: Max Number of Fields (in data.diagnostics)
44 jmc 1.10 C frequency :: Frequency (in s) of Output (ouput every "frequency" second)
45     C timePhase :: phase (in s) within the "frequency" period to write output
46 jmc 1.18 C averagingFreq :: frequency (in s) for periodic averaging interval
47     C averagingPhase :: phase (in s) for periodic averaging interval
48     C repeatCycle :: number of averaging intervals in 1 cycle
49 jmc 1.27 C missing_value :: missing value for real-type fields in output file
50 jmc 1.33 C missing_value_int :: missing value for integers in output (not used)
51 jmc 1.1 C levels :: List Output Levels
52     C fields :: List Output Fields
53 jmc 1.27 C fileName :: List Output Filename
54 jmc 1.15 C-- for regional-statistics
55 jmc 1.16 C set_regMask(n) :: region-mask set-index that define the region "n"
56 jmc 1.15 C val_regMask(n) :: corresponding mask value of region "n" in the region-mask
57 jmc 1.10 C-- per level statistics output:
58 jmc 1.13 C stat_freq :: Frequency (in s) of statistics output
59 jmc 1.10 C stat_phase :: phase (in s) to write statistics output
60     C stat_region :: List of statistics output Regions
61     C stat_fields :: List of statistics output Fields
62 jmc 1.27 C stat_fName :: List of statistics output Filename
63 jmc 1.10 INTEGER ldimLoc, kdimLoc, fdimLoc, rdimLoc
64 jmc 1.28 PARAMETER ( ldimLoc = 2*numLists )
65 jmc 1.1 PARAMETER ( kdimLoc = 2*numLevels )
66 jmc 1.28 PARAMETER ( fdimLoc = 2*numperList )
67 jmc 1.15 PARAMETER ( rdimLoc = nRegions+21 )
68 jmc 1.9 _RL frequency(ldimLoc), timePhase(ldimLoc)
69 jmc 1.18 _RL averagingFreq(ldimLoc), averagingPhase(ldimLoc)
70     INTEGER repeatCycle(ldimLoc)
71 mlosch 1.22 _RL missing_value(ldimLoc)
72     INTEGER missing_value_int(ldimLoc)
73 jmc 1.1 _RL levels(kdimLoc,ldimLoc)
74 jmc 1.10 _RL stat_freq(ldimLoc), stat_phase(ldimLoc)
75 jmc 1.1 CHARACTER*8 fields(fdimLoc,ldimLoc)
76 jmc 1.10 CHARACTER*8 stat_fields(fdimLoc,ldimLoc)
77 jmc 1.27 CHARACTER*80 fileName(ldimLoc), blkFilName
78 jmc 1.10 CHARACTER*80 stat_fname(ldimLoc)
79 jmc 1.27 CHARACTER*8 fileFlags(ldimLoc)
80 jmc 1.43 CHARACTER*8 blk8c, diagName
81 jmc 1.1 CHARACTER*(MAX_LEN_MBUF) msgBuf
82 jmc 1.41 CHARACTER*(MAX_LEN_FNAM) namBuf
83 jmc 1.24 CHARACTER*12 suffix
84 jmc 1.10 INTEGER stat_region(rdimLoc,ldimLoc)
85 jmc 1.16 INTEGER set_regMask(rdimLoc)
86 jmc 1.15 _RS val_regMask(rdimLoc)
87 jmc 1.1 INTEGER ku, stdUnit
88 molod 1.17 INTEGER j,k,l,n,m,nf
89 jmc 1.13 INTEGER iLen, regionCount
90 jmc 1.1
91 jmc 1.10 C-- full level output:
92 jmc 1.18 NAMELIST / DIAGNOSTICS_LIST /
93     & frequency, timePhase,
94     & averagingFreq, averagingPhase, repeatCycle,
95 mlosch 1.22 & missing_value, missing_value_int,
96 jmc 1.27 & levels, fields, fileName, fileFlags,
97 jmc 1.28 & dumpAtLast, diag_mnc, useMissingValue,
98 jmc 1.31 & diagCG_maxIters, diagCG_resTarget,
99 jmc 1.37 & diagCG_pcOffDFac, diagCG_prtResFrq, xPsi0, yPsi0,
100 edhill 1.5 & diag_pickup_read, diag_pickup_write,
101 gforget 1.39 & diag_pickup_read_mnc, diag_pickup_write_mnc,
102     & diagMdsDir, diagMdsDirCreate
103 jmc 1.1
104 jmc 1.10 C-- per level statistics output:
105     NAMELIST / DIAG_STATIS_PARMS /
106 jmc 1.13 & stat_freq, stat_phase, stat_region, stat_fields,
107 jmc 1.15 & stat_fname, diagSt_mnc,
108 jmc 1.16 & set_regMask, val_regMask,
109     & diagSt_regMaskFile, nSetRegMskFile
110 jmc 1.10
111 jmc 1.34 IF ( .NOT.useDiagnostics ) THEN
112 jmc 1.36 C- pkg DIAGNOSTICS is not used
113 jmc 1.34 _BEGIN_MASTER(myThid)
114     C- Track diagnostics pkg activation status:
115     diag_pkgStatus = -1
116     C print a (weak) warning if data.diagnostics is found
117 jmc 1.36 CALL PACKAGES_UNUSED_MSG( 'useDiagnostics', ' ', ' ' )
118 jmc 1.34 _END_MASTER(myThid)
119 jmc 1.38 _BARRIER
120 jmc 1.34 RETURN
121     ENDIF
122    
123     C- Initialize and Read Diagnostics Namelist
124 jmc 1.1 _BEGIN_MASTER(myThid)
125    
126     blk8c = ' '
127 jmc 1.6 DO k=1,LEN(blkFilName)
128     blkFilName(k:k) = ' '
129     ENDDO
130 jmc 1.1
131     DO l = 1,ldimLoc
132 jmc 1.18 frequency(l) = 0.
133     timePhase(l) = UNSET_RL
134     averagingFreq(l) = 0.
135     averagingPhase(l)= 0.
136     repeatCycle(l) = 0
137 jmc 1.27 fileName(l) = blkFilName
138 jmc 1.33 C- Cannot use model standard Unset value since this was used previously
139     C as defaut missing value that one might want to recover;
140     C Use instead the unlikely missing value of One for the Undef-missing-Val
141     c missing_value(l) = UNSET_RL
142     missing_value(l) = oneRL
143 mlosch 1.22 missing_value_int(l) = UNSET_I
144 jmc 1.27 fileFlags(l) = blk8c
145 jmc 1.1 DO k = 1,kdimLoc
146 jmc 1.18 levels(k,l) = UNSET_RL
147 jmc 1.1 ENDDO
148     DO m = 1,fdimLoc
149 jmc 1.34 fields(m,l) = blkName
150 jmc 1.1 ENDDO
151     ENDDO
152 jmc 1.29 diagLoc_ioUnit = 0
153 jmc 1.25 dumpAtLast = .FALSE.
154     diag_mnc = useMNC
155 jmc 1.28 useMissingValue = .FALSE.
156 edhill 1.5 diag_pickup_read = .FALSE.
157     diag_pickup_write = .FALSE.
158     diag_pickup_read_mnc = .FALSE.
159     diag_pickup_write_mnc = .FALSE.
160 gforget 1.39 diagMdsDir = ' '
161     diagMdsDirCreate = .TRUE.
162 jmc 1.1
163 jmc 1.32 prtFirstCall = .TRUE.
164 jmc 1.31 diagCG_maxIters = cg2dMaxIters
165     diagCG_resTarget = cg2dTargetResidual
166     diagCG_prtResFrq = printResidualFreq
167 jmc 1.37 diagCG_pcOffDFac = 1.
168     IF ( cg2dpcOffDFac.GT.zeroRL )
169     & diagCG_pcOffDFac = 0.25 _d 0 /( cg2dpcOffDFac*cg2dpcOffDFac )
170 jmc 1.30 xPsi0 = UNSET_RS
171     yPsi0 = UNSET_RS
172    
173 jmc 1.15 diagSt_regMaskFile = ' '
174 jmc 1.16 nSetRegMskFile = 0
175 jmc 1.15 DO k = 1,rdimLoc
176 jmc 1.16 set_regMask(k) = 0
177 jmc 1.15 val_regMask(k) = 0.
178     ENDDO
179 jmc 1.10 DO l = 1,ldimLoc
180     stat_freq(l) = 0.
181     stat_phase(l) = UNSET_RL
182     stat_fname(l) = blkFilName
183     DO k = 1,rdimLoc
184     stat_region(k,l) = UNSET_I
185     ENDDO
186     DO m = 1,fdimLoc
187 jmc 1.34 stat_fields(m,l) = blkName
188 jmc 1.10 ENDDO
189     ENDDO
190 jmc 1.34 C- Track diagnostics pkg activation status:
191     diag_pkgStatus = 1
192 jmc 1.10
193     WRITE(msgBuf,'(2A)')
194 jmc 1.1 & ' DIAGNOSTICS_READPARMS: opening data.diagnostics'
195     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,SQUEEZE_RIGHT,1)
196 jmc 1.3
197     CALL OPEN_COPY_DATA_FILE('data.diagnostics',
198 jmc 1.1 & 'DIAGNOSTICS_READPARMS', ku, myThid )
199 jmc 1.10
200     WRITE(msgBuf,'(2A)') 'S/R DIAGNOSTICS_READPARMS,',
201     & ' read namelist "diagnostics_list": start'
202     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
203     & SQUEEZE_RIGHT , 1)
204 jmc 1.1 READ (ku,NML=diagnostics_list)
205 jmc 1.10 WRITE(msgBuf,'(2A)') 'S/R DIAGNOSTICS_READPARMS,',
206     & ' read namelist "diagnostics_list": OK'
207     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
208     & SQUEEZE_RIGHT , 1)
209    
210     C- set default for statistics output according to the main flag
211     diag_mnc = diag_mnc .AND. useMNC
212     diagSt_mnc = diag_mnc
213    
214     WRITE(msgBuf,'(2A)') 'S/R DIAGNOSTICS_READPARMS,',
215     & ' read namelist "DIAG_STATIS_PARMS": start'
216     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
217     & SQUEEZE_RIGHT , 1)
218     READ (ku,NML=DIAG_STATIS_PARMS)
219     WRITE(msgBuf,'(2A)') 'S/R DIAGNOSTICS_READPARMS,',
220     & ' read namelist "DIAG_STATIS_PARMS": OK'
221     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
222     & SQUEEZE_RIGHT , 1)
223    
224 mlosch 1.45 #ifdef SINGLE_DISK_IO
225     CLOSE(ku)
226     #else
227     CLOSE(ku,STATUS='DELETE')
228     #endif /* SINGLE_DISK_IO */
229 jmc 1.1
230 jmc 1.18 C Initialise DIAG_SELECT common block (except pointers)
231 jmc 1.1 nlists = 0
232 jmc 1.28 DO n = 1,numLists
233 molod 1.8 freq(n) = 0.
234 jmc 1.9 phase(n) = 0.
235 jmc 1.18 averageFreq(n) = 0.
236     averagePhase(n) = 0.
237     averageCycle(n) = 1
238 jmc 1.1 nlevels(n) = 0
239     nfields(n) = 0
240 jmc 1.6 fnames(n) = blkFilName
241 jmc 1.33 c misValFlt(n) = UNSET_RL
242     c misValInt(n) = UNSET_I
243     misValFlt(n) = -999. _d 0
244     #ifdef ALLOW_FIZHI
245     IF ( useFIZHI ) misValFlt(n) = getcon('UNDEF')
246     #endif
247 jmc 1.1 DO k = 1,numLevels
248     levs(k,n) = 0
249     ENDDO
250 jmc 1.28 DO m = 1,numperList
251 jmc 1.34 flds(m,n) = blkName
252 jmc 1.1 ENDDO
253 jmc 1.18 fflags(n) = blk8c
254 jmc 1.1 ENDDO
255    
256 jmc 1.10 C useMNC is confusing (can be T at this point & turned off later, whereas
257     C for all other pkgs, model stops if use${PKG}= T with #undef ALLOW_${PKG})
258     #ifndef ALLOW_MNC
259     C Fix to avoid running without getting any output:
260     diag_mnc = .FALSE.
261     diagSt_mnc = .FALSE.
262     #endif
263    
264 jmc 1.1 C Fill Diagnostics Common Block with Namelist Info
265 jmc 1.10 diagSt_mnc = diagSt_mnc .AND. useMNC
266 jmc 1.4 diag_mdsio = (.NOT. diag_mnc) .OR. outputTypesInclusive
267 edhill 1.5 diag_pickup_read_mnc = diag_pickup_read_mnc .AND. diag_mnc
268     diag_pickup_write_mnc = diag_pickup_write_mnc .AND. diag_mnc
269 jmc 1.10 diag_pickup_read_mdsio =
270 edhill 1.5 & diag_pickup_read .AND. (.NOT. diag_pickup_read_mnc)
271     diag_pickup_write_mdsio = diag_pickup_write .AND.
272     & ((.NOT. diag_pickup_write_mnc) .OR. outputTypesInclusive)
273 jmc 1.10 diagSt_ascii = (.NOT. diagSt_mnc) .OR. outputTypesInclusive
274 jmc 1.3
275 jmc 1.41 C remove trailing "/":
276     iLen = ILNBLNK( diagMdsDir )
277 jmc 1.42 IF ( iLen.GE.2 ) THEN
278     IF ( diagMdsDir(iLen:iLen).EQ.'/' ) THEN
279 jmc 1.41 namBuf = diagMdsDir
280     WRITE(diagMdsDir,'(A)') namBuf(1:iLen-1)
281 jmc 1.42 ENDIF
282 jmc 1.41 ENDIF
283    
284 jmc 1.1 DO l = 1,ldimLoc
285 jmc 1.27 iLen = ILNBLNK(fileName(l))
286 jmc 1.13 C- Only lists with non-empty file name (iLen>0) are considered
287 jmc 1.28 IF ( iLen.GE.1 .AND. nlists.LT.numLists ) THEN
288 jmc 1.1 n = nlists + 1
289     freq(n) = frequency(l)
290 jmc 1.9 IF ( timePhase(l).NE. UNSET_RL ) THEN
291     phase(n) = timePhase(l)
292     ELSEIF ( frequency(l) .LT. 0. ) THEN
293     phase(n) = -0.5 _d 0 * frequency(l)
294     ENDIF
295 jmc 1.18 IF ( averagingFreq(l).GT.0. .AND. repeatCycle(l).GT.1 ) THEN
296     averageFreq(n) = averagingFreq(l)
297     averagePhase(n) = averagingPhase(l)
298     averageCycle(n) = repeatCycle(l)
299     ELSEIF (averagingFreq(l).NE.0. .OR. repeatCycle(l).NE.0) THEN
300 jmc 1.21 WRITE(msgBuf,'(2A,F18.6,I4)') 'DIAGNOSTICS_READPARMS: ',
301 jmc 1.18 & 'unvalid Average-Freq & Cycle:',
302     & averagingFreq(l), repeatCycle(l)
303     CALL PRINT_ERROR( msgBuf , myThid )
304 jmc 1.21 WRITE(msgBuf,'(2A,I4,2A)') 'DIAGNOSTICS_READPARMS: ',
305 jmc 1.27 & ' for list l=', l, ', fileName: ', fileName(l)
306 jmc 1.18 CALL PRINT_ERROR( msgBuf , myThid )
307     STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
308     ELSEIF ( frequency(l) .EQ. 0. ) THEN
309     averageFreq(n) = nTimeSteps*deltaTClock
310     averagePhase(n) = phase(n)
311     ELSEIF ( frequency(l) .GT. 0. ) THEN
312     averageFreq(n) = frequency(l)
313     averagePhase(n) = phase(n)
314     ENDIF
315 jmc 1.33 c IF ( missing_value(l) .NE. UNSET_RL )
316     c & misValFlt(n) = missing_value(l)
317     c IF ( missing_value_int(l) .NE. UNSET_I )
318     c & misValInt(n) = missing_value_int(l)
319     IF ( missing_value(l) .NE. oneRL )
320     & misValFlt(n) = missing_value(l)
321 jmc 1.27 fnames(n) = fileName (l)
322     fflags(n) = fileFlags(l)
323 jmc 1.1 nlevels(n) = 0
324 jmc 1.18 IF ( levels(1,l).NE.UNSET_RL ) THEN
325 jmc 1.1 DO k=1,kdimLoc
326 jmc 1.18 IF ( levels(k,l).NE.UNSET_RL .AND.
327 jmc 1.1 & nlevels(n).LT.numLevels ) THEN
328     nlevels(n) = nlevels(n) + 1
329     levs(nlevels(n),n) = levels(k,l)
330 jmc 1.18 ELSEIF ( levels(k,l).NE.UNSET_RL ) THEN
331 jmc 1.21 WRITE(msgBuf,'(2A,I4)') 'DIAGNOSTICS_READPARMS: ',
332 jmc 1.1 & 'Exceed Max.Num. of Levels numLevels=', numLevels
333     CALL PRINT_ERROR( msgBuf , myThid )
334 jmc 1.21 WRITE(msgBuf,'(2A,I4,A,F8.0)') 'DIAGNOSTICS_READPARMS: ',
335 jmc 1.3 & 'when trying to add level(k=', k, ' )=', levels(k,l)
336 jmc 1.1 CALL PRINT_ERROR( msgBuf , myThid )
337 jmc 1.21 WRITE(msgBuf,'(2A,I4,2A)') 'DIAGNOSTICS_READPARMS: ',
338 jmc 1.27 & ' for list l=', l, ', fileName: ', fileName(l)
339 jmc 1.1 CALL PRINT_ERROR( msgBuf , myThid )
340 jmc 1.18 STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
341 jmc 1.1 ENDIF
342     ENDDO
343     ELSE
344 jmc 1.3 C- will set levels later, once the Nb of levels of each diag is known
345     nlevels(n) = -1
346 jmc 1.1 ENDIF
347     nfields(n) = 0
348     DO m=1,fdimLoc
349 jmc 1.43 diagName = DIAGS_RENAMED( fields(m,l), myThid )
350     IF ( diagName.NE.blkName .AND.
351 jmc 1.28 & nfields(n).LT.numperList ) THEN
352 jmc 1.1 nfields(n) = nfields(n) + 1
353 jmc 1.43 flds(nfields(n),n) = diagName
354     ELSEIF ( diagName.NE.blkName ) THEN
355 jmc 1.21 WRITE(msgBuf,'(2A,I4)') 'DIAGNOSTICS_READPARMS: ',
356 jmc 1.28 & 'Exceed Max.Num. of Fields/list numperList=', numperList
357 jmc 1.1 CALL PRINT_ERROR( msgBuf , myThid )
358 jmc 1.21 WRITE(msgBuf,'(2A,I4,3A,I4,2A)') 'DIAGNOSTICS_READPARMS: ',
359 jmc 1.43 & 'when trying to add field (m=', m, ' ): ', diagName
360 jmc 1.1 CALL PRINT_ERROR( msgBuf , myThid )
361 jmc 1.21 WRITE(msgBuf,'(2A,I4,2A)') 'DIAGNOSTICS_READPARMS: ',
362 jmc 1.27 & ' in list l=', l, ', fileName: ', fileName(l)
363 jmc 1.1 CALL PRINT_ERROR( msgBuf , myThid )
364     STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
365     ENDIF
366     ENDDO
367     nlists = nlists + 1
368 jmc 1.2 c write(6,*) 'list summary:',n,nfields(n),nlevels(n)
369 jmc 1.13 ELSEIF ( iLen.GE.1 ) THEN
370 jmc 1.21 WRITE(msgBuf,'(2A,I4)') 'DIAGNOSTICS_READPARMS: ',
371 jmc 1.28 & 'Exceed Max.Num. of list numLists=', numLists
372 jmc 1.1 CALL PRINT_ERROR( msgBuf , myThid )
373 jmc 1.21 WRITE(msgBuf,'(2A,I4)') 'DIAGNOSTICS_READPARMS: ',
374 jmc 1.1 & 'when trying to add list l=', l
375     CALL PRINT_ERROR( msgBuf , myThid )
376 jmc 1.20 WRITE(msgBuf,'(2A,F18.6,2A)') 'DIAGNOSTICS_READPARMS: ',
377 jmc 1.27 & ' Frq=', frequency(l), ', fileName: ', fileName(l)
378 jmc 1.1 CALL PRINT_ERROR( msgBuf , myThid )
379     STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
380     ENDIF
381     ENDDO
382    
383     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
384 jmc 1.10
385 jmc 1.15 C- Initialise DIAG_STATS_REGMASK common block (except the mask)
386 jmc 1.16 nSetRegMask = 0
387 jmc 1.15 DO j = 0,nRegions
388     diagSt_kRegMsk(j) = 0
389     diagSt_vRegMsk(j) = 0.
390     ENDDO
391     C Global statistics (region # 0)
392     diagSt_kRegMsk(0) = 1
393    
394     C- Initialise DIAG_STATIS common block (except pointers)
395 jmc 1.10 diagSt_nbLists = 0
396 jmc 1.28 DO n = 1,numLists
397 jmc 1.10 diagSt_freq(n) = 0.
398     diagSt_phase(n) = 0.
399     diagSt_nbFlds(n) = 0
400     diagSt_ioUnit(n) = 0
401     diagSt_Fname(n) = blkFilName
402     DO j = 0,nRegions
403     diagSt_region(j,n) = 0
404     ENDDO
405 jmc 1.28 DO m = 1,numperList
406 jmc 1.34 diagSt_Flds(m,n) = blkName
407 jmc 1.10 ENDDO
408     ENDDO
409    
410     C Fill Diagnostics Common Block with Namelist Info
411     diagSt_ascii = (.NOT. diagSt_mnc) .OR. outputTypesInclusive
412    
413 jmc 1.15 C- Region mask correspondence table:
414     C note: this table should be build when regions are defined ;
415     C for now, simpler just to read it from namelist in data.diagnostics
416     j = 0
417     DO k = 1,rdimLoc
418 jmc 1.16 IF ( set_regMask(k).NE.0 .OR. val_regMask(k).NE.0. ) THEN
419 jmc 1.15 j = j+1
420     IF ( j.LE.nRegions ) THEN
421 jmc 1.16 diagSt_kRegMsk(j) = set_regMask(k)
422 jmc 1.15 diagSt_vRegMsk(j) = val_regMask(k)
423     ENDIF
424     ENDIF
425     ENDDO
426     IF ( j.GT.nRegions ) THEN
427 jmc 1.21 WRITE(msgBuf,'(2A,I4,A)') 'DIAGNOSTICS_READPARMS: ',
428 jmc 1.16 & 'set_regMask & val_regMask lists assume at least',j,' regions'
429 jmc 1.15 CALL PRINT_ERROR( msgBuf , myThid )
430     WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_READPARMS: ',
431     & 'Need to increase "nRegions" in DIAGNOSTICS_SIZE.h'
432     CALL PRINT_ERROR( msgBuf , myThid )
433     STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
434     ENDIF
435    
436 jmc 1.10 DO l = 1,ldimLoc
437 jmc 1.13 iLen = ILNBLNK(stat_fname(l))
438     C- Only lists with non-empty file name (iLen>0) are considered
439 jmc 1.28 IF ( iLen.GE.1 .AND. diagSt_nbLists.LT.numLists)THEN
440 jmc 1.10 n = diagSt_nbLists + 1
441     diagSt_freq(n) = stat_freq(l)
442     IF ( stat_phase(l).NE. UNSET_RL ) THEN
443     diagSt_phase(n) = stat_phase(l)
444     ELSEIF ( stat_freq(l) .LT. 0. ) THEN
445     diagSt_phase(n) = -0.5 _d 0 * stat_freq(l)
446     ENDIF
447     diagSt_Fname(n) = stat_fname(l)
448     regionCount = 0
449     DO k=1,rdimLoc
450     j = stat_region(k,l)
451     IF ( j.NE.UNSET_I .AND. j.GE.0 .AND. j.LE.nRegions ) THEN
452 jmc 1.15 IF ( diagSt_region(j,n).EQ.0 ) THEN
453 jmc 1.10 diagSt_region(j,n) = 1
454     regionCount = regionCount + 1
455 jmc 1.15 ELSE
456 jmc 1.21 WRITE(msgBuf,'(2A,I4,2A)')
457 jmc 1.15 & 'DIAGNOSTICS_READPARMS:',
458     & ' in list l=', l, ', stat_fname: ', stat_fname(l)
459     CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
460     & SQUEEZE_RIGHT , myThid )
461 jmc 1.21 WRITE(msgBuf,'(A,I4,A)')
462 jmc 1.15 & 'DIAGNOSTICS_READPARMS: region=',j,
463     & ' can only be selected once => ignore 2nd selection'
464     CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
465     & SQUEEZE_RIGHT , myThid )
466     ENDIF
467 jmc 1.10 ELSEIF ( j.NE.UNSET_I ) THEN
468 jmc 1.21 WRITE(msgBuf,'(A,I4,A,I4,2A)')
469 jmc 1.10 & 'DIAGNOSTICS_READPARMS: region=',j,
470     & ' in list l=', l, ', stat_fname: ', stat_fname(l)
471     CALL PRINT_ERROR( msgBuf , myThid )
472 jmc 1.21 WRITE(msgBuf,'(2A,I4,A,I4,2A)')
473 jmc 1.10 & 'DIAGNOSTICS_READPARMS: ==> exceed Max.Nb of regions',
474     & '(=',nRegions,' )'
475     CALL PRINT_ERROR( msgBuf , myThid )
476     STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
477     ENDIF
478     ENDDO
479     IF ( regionCount.EQ.0 ) THEN
480     C- no region selected => default is Global statistics (region Id: 0)
481     diagSt_region(0,n) = 1
482     ENDIF
483     diagSt_nbFlds(n) = 0
484     DO m=1,fdimLoc
485 jmc 1.43 diagName = DIAGS_RENAMED( stat_fields(m,l), myThid )
486     IF ( diagName.NE.blkName .AND.
487 jmc 1.28 & diagSt_nbFlds(n).LT.numperList ) THEN
488 jmc 1.10 diagSt_nbFlds(n) = diagSt_nbFlds(n) + 1
489 jmc 1.43 diagSt_Flds(diagSt_nbFlds(n),n) = diagName
490     ELSEIF ( diagName.NE.blkName ) THEN
491 jmc 1.21 WRITE(msgBuf,'(2A,I4)') 'DIAGNOSTICS_READPARMS: ',
492 jmc 1.28 & 'Exceed Max.Num. of Fields/list numperList=', numperList
493 jmc 1.10 CALL PRINT_ERROR( msgBuf , myThid )
494 jmc 1.21 WRITE(msgBuf,'(2A,I4,3A,I4,2A)') 'DIAGNOSTICS_READPARMS: ',
495 jmc 1.43 & 'when trying to add stat_field (m=', m, ' ): ', diagName
496 jmc 1.10 CALL PRINT_ERROR( msgBuf , myThid )
497 jmc 1.21 WRITE(msgBuf,'(2A,I4,2A)') 'DIAGNOSTICS_READPARMS: ',
498 jmc 1.10 & ' in list l=', l, ', stat_fname: ', stat_fname(l)
499     CALL PRINT_ERROR( msgBuf , myThid )
500     STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
501     ENDIF
502     ENDDO
503     diagSt_nbLists = diagSt_nbLists + 1
504     c write(6,*) 'stat-list summary:',n,diagSt_nbFlds(n),regionCount
505 jmc 1.13 ELSEIF ( iLen.GE.1 ) THEN
506 jmc 1.21 WRITE(msgBuf,'(2A,I4)') 'DIAGNOSTICS_READPARMS: ',
507 jmc 1.28 & 'Exceed Max.Num. of list numLists=', numLists
508 jmc 1.10 CALL PRINT_ERROR( msgBuf , myThid )
509 jmc 1.21 WRITE(msgBuf,'(2A,I4)') 'DIAGNOSTICS_READPARMS: ',
510 jmc 1.10 & 'when trying to add stat_list l=', l
511     CALL PRINT_ERROR( msgBuf , myThid )
512 jmc 1.20 WRITE(msgBuf,'(2A,F18.6,2A)') 'DIAGNOSTICS_READPARMS: ',
513 jmc 1.10 & ' Frq=', stat_freq(l), ', stat_fname: ', stat_fname(l)
514     CALL PRINT_ERROR( msgBuf , myThid )
515     STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
516     ENDIF
517     ENDDO
518    
519     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
520 jmc 1.1 C Echo History List Data Structure
521     stdUnit = standardMessageUnit
522     WRITE(msgBuf,'(A)')
523 jmc 1.28 & ' DIAGNOSTICS_READPARMS: global parameter summary:'
524     CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
525     CALL WRITE_0D_L( dumpAtLast, INDEX_NONE,
526     & ' dumpAtLast =',' /* always write time-ave diags at the end */')
527     CALL WRITE_0D_L( diag_mnc, INDEX_NONE,
528     & ' diag_mnc =', ' /* write NetCDF output files */')
529 gforget 1.39 IF ( diag_mdsio.AND.(diagMdsDir.NE.' ') ) THEN
530 jmc 1.40 CALL WRITE_0D_C( diagMdsDir, -1, INDEX_NONE,
531 jmc 1.41 & ' diagMdsDir =', ' /* directory for mds diagnostics output */')
532 jmc 1.40 CALL WRITE_0D_L( diagMdsDirCreate, INDEX_NONE,
533 gforget 1.39 & ' diagMdsDirCreate =', ' /* call mkdir to create diagMdsDir */')
534     ENDIF
535 jmc 1.28 CALL WRITE_0D_L( useMissingValue, INDEX_NONE,
536     & ' useMissingValue =', ' /* put MissingValue where mask = 0 */')
537 jmc 1.31 CALL WRITE_0D_I( diagCG_maxIters, INDEX_NONE,
538     & ' diagCG_maxIters =', ' /* max number of iters in diag_cg2d */')
539     CALL WRITE_0D_RL( diagCG_resTarget, INDEX_NONE,
540     & ' diagCG_resTarget =', ' /* residual target for diag_cg2d */')
541 jmc 1.37 CALL WRITE_0D_RL( diagCG_pcOffDFac, INDEX_NONE,
542     & ' diagCG_pcOffDFac =',
543     & ' /* preconditioner off-diagonal factor */')
544 jmc 1.28 WRITE(msgBuf,'(A)')
545 jmc 1.1 & '-----------------------------------------------------'
546     CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
547     WRITE(msgBuf,'(A)')
548     & ' DIAGNOSTICS_READPARMS: active diagnostics summary:'
549     CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
550     WRITE(msgBuf,'(A)')
551     & '-----------------------------------------------------'
552     CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
553     DO n = 1,nlists
554 jmc 1.20 WRITE(msgBuf,'(2A)') 'Creating Output Stream: ', fnames(n)
555 jmc 1.1 CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
556 jmc 1.20 WRITE(msgBuf,'(2(A,F18.6))') 'Output Frequency:', freq(n),
557 jmc 1.9 & ' ; Phase: ', phase(n)
558 jmc 1.1 CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
559 jmc 1.21 WRITE(msgBuf,'(2(A,F18.6),A,I4)')
560 jmc 1.18 & ' Averaging Freq.:', averageFreq(n),
561     & ' , Phase: ', averagePhase(n), ' , Cycle:', averageCycle(n)
562     CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
563 jmc 1.24 IF ( fflags(n).EQ.blk8c ) THEN
564 jmc 1.33 c WRITE(msgBuf,'(A,1PE20.12,A,I12,3A)')
565     c & ' missing value:', misValFlt(n),
566     c & ' ; for integers:', misValInt(n)
567     WRITE(msgBuf,'(A,1PE20.12,3A)')
568     & ' missing value:', misValFlt(n)
569 jmc 1.24 ELSE
570 jmc 1.33 c WRITE(msgBuf,'(A,1PE20.12,A,I12,3A)')
571     c & ' missing value:', misValFlt(n),
572     c & ' ; for integers:', misValInt(n),
573     c & ' ; F-Flags="', fflags(n),'"'
574     WRITE(msgBuf,'(A,1PE20.12,3A)')
575     & ' missing value:', misValFlt(n),
576 jmc 1.24 & ' ; F-Flags="', fflags(n),'"'
577     ENDIF
578 mlosch 1.22 CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
579 jmc 1.24 IF ( nlevels(n).EQ.-1 .AND. fflags(n)(2:2).EQ.'I' ) THEN
580     WRITE(msgBuf,'(A)') ' Cumulate all Levels (to be set later)'
581     CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
582     ELSEIF ( nlevels(n).EQ.-1 ) THEN
583 jmc 1.3 WRITE(msgBuf,'(A,A)') ' Levels: ','will be set later'
584     CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
585 jmc 1.19 ELSEIF ( fflags(n)(2:2).EQ.'P' ) THEN
586     DO l=1,nlevels(n),10
587     m = MIN(nlevels(n),l+9)
588     WRITE(msgBuf,'(A,1P10E10.3)')' interp: ', (levs(k,n),k=l,m)
589     CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
590     ENDDO
591 jmc 1.3 ELSE
592 jmc 1.24 suffix = ' Levels: '
593     IF ( fflags(n)(2:2).EQ.'I' ) suffix = ' Sum Levels:'
594 jmc 1.3 DO l=1,nlevels(n),20
595 jmc 1.1 m = MIN(nlevels(n),l+19)
596 jmc 1.24 WRITE(msgBuf,'(A,20F5.0)') suffix, (levs(k,n),k=l,m)
597 jmc 1.1 CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
598 jmc 1.3 ENDDO
599     ENDIF
600 molod 1.17 DO nf = 1,nfields(n),10
601 jmc 1.19 m = MIN(nfields(n),nf+9)
602 jmc 1.20 WRITE(msgBuf,'(21A)') ' Fields: ',(' ',flds(l,n),l=nf,m)
603 jmc 1.19 CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
604 molod 1.17 ENDDO
605 jmc 1.1 ENDDO
606     WRITE(msgBuf,'(A)')
607     & '-----------------------------------------------------'
608     CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
609     WRITE(msgBuf,'(A)')
610 jmc 1.10 & ' DIAGNOSTICS_READPARMS: statistics diags. summary:'
611     CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
612     DO n = 1,diagSt_nbLists
613 jmc 1.20 WRITE(msgBuf,'(2A)') 'Creating Stats. Output Stream: ',
614 jmc 1.10 & diagSt_Fname(n)
615     CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
616 jmc 1.20 WRITE(msgBuf,'(2(A,F18.6))') 'Output Frequency:',
617 jmc 1.18 & diagSt_freq(n), ' ; Phase: ', diagSt_phase(n)
618 jmc 1.10 CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
619 jmc 1.20 WRITE(msgBuf,'(A)') ' Regions: '
620     l = 10
621 jmc 1.10 DO j=0,nRegions
622     IF ( diagSt_region(j,n).GE.1 ) THEN
623     l = l+3
624 jmc 1.20 IF (l.LE.MAX_LEN_MBUF) WRITE(msgBuf(l-2:l),'(I3)') j
625 jmc 1.10 ENDIF
626     ENDDO
627     CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
628 jmc 1.20 DO nf = 1,diagSt_nbFlds(n),10
629     m = MIN(diagSt_nbFlds(n),nf+9)
630     WRITE(msgBuf,'(21A)') ' Fields: ',
631     & (' ',diagSt_Flds(l,n),l=nf,m)
632     CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
633     ENDDO
634 jmc 1.10 ENDDO
635     WRITE(msgBuf,'(A)')
636     & '-----------------------------------------------------'
637     CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
638     WRITE(msgBuf,'(A)')
639 jmc 1.1 CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
640    
641     _END_MASTER(myThid)
642    
643 jmc 1.26 C-- Everyone else must wait for the parameters to be loaded
644     _BARRIER
645    
646 jmc 1.1 RETURN
647     END

  ViewVC Help
Powered by ViewVC 1.1.22