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

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

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


Revision 1.11 - (show annotations) (download)
Tue Jun 14 22:30:02 2005 UTC (18 years, 11 months ago) by molod
Branch: MAIN
Changes since 1.10: +7 -20 lines
Provide option to set diagnostic freq to 0 and get output at last time step only

1 C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diagnostics_readparms.F,v 1.10 2005/05/20 07:28:50 jmc Exp $
2 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_READPARMS
9
10 C !INTERFACE:
11 SUBROUTINE DIAGNOSTICS_READPARMS(myThid)
12
13 C !DESCRIPTION:
14 C Read Diagnostics Namelists to specify output sequence.
15
16 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
24 C !INPUT PARAMETERS:
25 INTEGER myThid
26 CEOP
27
28 C !LOCAL VARIABLES:
29 C ldimLoc :: Max Number of Lists
30 C kdimLoc :: Max Number of Levels
31 C fdimLoc :: Max Number of Fields
32 C frequency :: Frequency (in s) of Output (ouput every "frequency" second)
33 C timePhase :: phase (in s) within the "frequency" period to write output
34 C levels :: List Output Levels
35 C fields :: List Output Fields
36 C filename :: List Output Filename
37 C-- per level statistics output:
38 C stat_freq :: Frequency (in s) of statistics output
39 C stat_phase :: phase (in s) to write statistics output
40 C stat_region :: List of statistics output Regions
41 C stat_fields :: List of statistics output Fields
42 C stat_fname :: List of statistics output Filename
43 INTEGER ldimLoc, kdimLoc, fdimLoc, rdimLoc
44 PARAMETER ( ldimLoc = 2*numlists )
45 PARAMETER ( kdimLoc = 2*numLevels )
46 PARAMETER ( fdimLoc = 2*numperlist )
47 PARAMETER ( rdimLoc = 2*nRegions+1 )
48 _RL frequency(ldimLoc), timePhase(ldimLoc)
49 _RL levels(kdimLoc,ldimLoc)
50 _RL stat_freq(ldimLoc), stat_phase(ldimLoc)
51 CHARACTER*8 fields(fdimLoc,ldimLoc)
52 CHARACTER*8 stat_fields(fdimLoc,ldimLoc)
53 CHARACTER*80 filename(ldimLoc), blkFilName
54 CHARACTER*80 stat_fname(ldimLoc)
55 CHARACTER*8 fileflags(ldimLoc)
56 CHARACTER*8 blk8c
57 CHARACTER*(MAX_LEN_MBUF) msgBuf
58 INTEGER stat_region(rdimLoc,ldimLoc)
59 INTEGER ku, stdUnit
60 INTEGER j,k,l,n,m
61 INTEGER regionCount
62 _RL undef, getcon
63 INTEGER ILNBLNK
64 EXTERNAL ILNBLNK
65
66 C-- full level output:
67 NAMELIST / diagnostics_list /
68 & frequency, timePhase, levels, fields, filename, fileflags,
69 & diag_mnc,
70 & diag_pickup_read, diag_pickup_write,
71 & diag_pickup_read_mnc, diag_pickup_write_mnc
72
73 C-- per level statistics output:
74 NAMELIST / DIAG_STATIS_PARMS /
75 & stat_freq, stat_phase, stat_region, stat_fields,
76 & stat_fname,
77 & diagSt_mnc
78
79 C Initialize and Read Diagnostics Namelist
80 _BEGIN_MASTER(myThid)
81
82 undef = getcon('UNDEF')
83 blk8c = ' '
84 DO k=1,LEN(blkFilName)
85 blkFilName(k:k) = ' '
86 ENDDO
87
88 DO l = 1,ldimLoc
89 frequency(l) = 0.
90 timePhase(l) = UNSET_RL
91 filename (l) = blkFilName
92 C eight spaces: 12345678
93 fileflags(l)(1:8) = ' '
94 DO k = 1,kdimLoc
95 levels (k,l) = undef
96 ENDDO
97 DO m = 1,fdimLoc
98 fields (m,l) = blk8c
99 ENDDO
100 ENDDO
101 diag_mnc = useMNC
102 diag_pickup_read = .FALSE.
103 diag_pickup_write = .FALSE.
104 diag_pickup_read_mnc = .FALSE.
105 diag_pickup_write_mnc = .FALSE.
106
107 DO l = 1,ldimLoc
108 stat_freq(l) = 0.
109 stat_phase(l) = UNSET_RL
110 stat_fname(l) = blkFilName
111 DO k = 1,rdimLoc
112 stat_region(k,l) = UNSET_I
113 ENDDO
114 DO m = 1,fdimLoc
115 stat_fields(m,l) = blk8c
116 ENDDO
117 ENDDO
118
119 WRITE(msgBuf,'(2A)')
120 & ' DIAGNOSTICS_READPARMS: opening data.diagnostics'
121 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,SQUEEZE_RIGHT,1)
122
123 CALL OPEN_COPY_DATA_FILE('data.diagnostics',
124 & 'DIAGNOSTICS_READPARMS', ku, myThid )
125
126 WRITE(msgBuf,'(2A)') 'S/R DIAGNOSTICS_READPARMS,',
127 & ' read namelist "diagnostics_list": start'
128 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
129 & SQUEEZE_RIGHT , 1)
130 READ (ku,NML=diagnostics_list)
131 WRITE(msgBuf,'(2A)') 'S/R DIAGNOSTICS_READPARMS,',
132 & ' read namelist "diagnostics_list": OK'
133 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
134 & SQUEEZE_RIGHT , 1)
135
136 C- set default for statistics output according to the main flag
137 diag_mnc = diag_mnc .AND. useMNC
138 diagSt_mnc = diag_mnc
139
140 WRITE(msgBuf,'(2A)') 'S/R DIAGNOSTICS_READPARMS,',
141 & ' read namelist "DIAG_STATIS_PARMS": start'
142 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
143 & SQUEEZE_RIGHT , 1)
144 c STOP 'before reading namelist: DIAG_STATIS_PARMS'
145 READ (ku,NML=DIAG_STATIS_PARMS)
146 WRITE(msgBuf,'(2A)') 'S/R DIAGNOSTICS_READPARMS,',
147 & ' read namelist "DIAG_STATIS_PARMS": OK'
148 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
149 & SQUEEZE_RIGHT , 1)
150
151 CLOSE (ku)
152
153 C Initialise diag_choices common block
154 nlists = 0
155 DO n = 1,numlists
156 freq(n) = 0.
157 phase(n) = 0.
158 nlevels(n) = 0
159 nfields(n) = 0
160 fnames(n) = blkFilName
161 DO k = 1,numLevels
162 levs(k,n) = 0
163 ENDDO
164 DO m = 1,numperlist
165 flds(m,n) = blk8c
166 jdiag(m,n) = 0
167 ENDDO
168 ENDDO
169
170 C useMNC is confusing (can be T at this point & turned off later, whereas
171 C for all other pkgs, model stops if use${PKG}= T with #undef ALLOW_${PKG})
172 #ifndef ALLOW_MNC
173 C Fix to avoid running without getting any output:
174 diag_mnc = .FALSE.
175 diagSt_mnc = .FALSE.
176 #endif
177
178 C Fill Diagnostics Common Block with Namelist Info
179 diagSt_mnc = diagSt_mnc .AND. useMNC
180 diag_mdsio = (.NOT. diag_mnc) .OR. outputTypesInclusive
181 diag_pickup_read_mnc = diag_pickup_read_mnc .AND. diag_mnc
182 diag_pickup_write_mnc = diag_pickup_write_mnc .AND. diag_mnc
183 diag_pickup_read_mdsio =
184 & diag_pickup_read .AND. (.NOT. diag_pickup_read_mnc)
185 diag_pickup_write_mdsio = diag_pickup_write .AND.
186 & ((.NOT. diag_pickup_write_mnc) .OR. outputTypesInclusive)
187 diagSt_ascii = (.NOT. diagSt_mnc) .OR. outputTypesInclusive
188
189 DO l = 1,ldimLoc
190 IF ( filename(L).NE.blkFilName .and. nlists.LT.numlists ) THEN
191 n = nlists + 1
192 freq(n) = frequency(l)
193 IF ( timePhase(l).NE. UNSET_RL ) THEN
194 phase(n) = timePhase(l)
195 ELSEIF ( frequency(l) .LT. 0. ) THEN
196 phase(n) = -0.5 _d 0 * frequency(l)
197 ENDIF
198 fnames(n) = filename (l)
199 fflags(n) = fileflags(l)
200 nlevels(n) = 0
201 IF ( levels(1,l).NE.undef ) THEN
202 DO k=1,kdimLoc
203 IF ( levels(k,l).NE.undef .AND.
204 & nlevels(n).LT.numLevels ) THEN
205 nlevels(n) = nlevels(n) + 1
206 levs(nlevels(n),n) = levels(k,l)
207 ELSEIF ( levels(k,l).NE.undef ) THEN
208 WRITE(msgBuf,'(2A,I3)') 'DIAGNOSTICS_READPARMS: ',
209 & 'Exceed Max.Num. of Levels numLevels=', numLevels
210 CALL PRINT_ERROR( msgBuf , myThid )
211 WRITE(msgBuf,'(2A,I3,A,F3.0)') 'DIAGNOSTICS_READPARMS: ',
212 & 'when trying to add level(k=', k, ' )=', levels(k,l)
213 CALL PRINT_ERROR( msgBuf , myThid )
214 WRITE(msgBuf,'(2A,I3,2A)') 'DIAGNOSTICS_READPARMS: ',
215 & ' for list l=', l, ', filename: ', filename(l)
216 CALL PRINT_ERROR( msgBuf , myThid )
217 STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
218 ENDIF
219 ENDDO
220 ELSE
221 C- will set levels later, once the Nb of levels of each diag is known
222 nlevels(n) = -1
223 ENDIF
224 nfields(n) = 0
225 DO m=1,fdimLoc
226 IF ( fields(m,l).NE.blk8c .AND.
227 & nfields(n).LT.numperlist ) THEN
228 nfields(n) = nfields(n) + 1
229 flds(nfields(n),n) = fields(m,l)
230 ELSEIF ( fields(m,l).NE.blk8c ) THEN
231 WRITE(msgBuf,'(2A,I3)') 'DIAGNOSTICS_READPARMS: ',
232 & 'Exceed Max.Num. of Fields/list numperlist=', numperlist
233 CALL PRINT_ERROR( msgBuf , myThid )
234 WRITE(msgBuf,'(2A,I3,3A,I3,2A)') 'DIAGNOSTICS_READPARMS: ',
235 & 'when trying to add field (m=', m, ' ): ',fields(m,l)
236 CALL PRINT_ERROR( msgBuf , myThid )
237 WRITE(msgBuf,'(2A,I3,2A)') 'DIAGNOSTICS_READPARMS: ',
238 & ' in list l=', l, ', filename: ', filename(l)
239 CALL PRINT_ERROR( msgBuf , myThid )
240 STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
241 ENDIF
242 ENDDO
243 nlists = nlists + 1
244 c write(6,*) 'list summary:',n,nfields(n),nlevels(n)
245 ELSEIF (filename(L).NE.blkFilName) THEN
246 WRITE(msgBuf,'(2A,I3)') 'DIAGNOSTICS_READPARMS: ',
247 & 'Exceed Max.Num. of list numlists=', numlists
248 CALL PRINT_ERROR( msgBuf , myThid )
249 WRITE(msgBuf,'(2A,I3)') 'DIAGNOSTICS_READPARMS: ',
250 & 'when trying to add list l=', l
251 CALL PRINT_ERROR( msgBuf , myThid )
252 WRITE(msgBuf,'(2A,F17.6,2A)') 'DIAGNOSTICS_READPARMS: ',
253 & ' Frq=', frequency(l), ', filename: ', filename(l)
254 CALL PRINT_ERROR( msgBuf , myThid )
255 STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
256 ENDIF
257 ENDDO
258
259 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
260
261 C Initialise DIAG_STATIS common block
262 diagSt_nbLists = 0
263 DO n = 1,numlists
264 diagSt_freq(n) = 0.
265 diagSt_phase(n) = 0.
266 diagSt_nbFlds(n) = 0
267 diagSt_ioUnit(n) = 0
268 diagSt_Fname(n) = blkFilName
269 DO j = 0,nRegions
270 diagSt_region(j,n) = 0
271 ENDDO
272 DO m = 1,numperlist
273 diagSt_Flds(m,n) = blk8c
274 jSdiag(m,n) = 0
275 ENDDO
276 ENDDO
277
278 C Fill Diagnostics Common Block with Namelist Info
279 diagSt_ascii = (.NOT. diagSt_mnc) .OR. outputTypesInclusive
280
281 DO l = 1,ldimLoc
282 IF(stat_fname(L).NE.blkFilName.AND.
283 . diagSt_nbLists.LT.numlists)THEN
284 n = diagSt_nbLists + 1
285 diagSt_freq(n) = stat_freq(l)
286 IF ( stat_phase(l).NE. UNSET_RL ) THEN
287 diagSt_phase(n) = stat_phase(l)
288 ELSEIF ( stat_freq(l) .LT. 0. ) THEN
289 diagSt_phase(n) = -0.5 _d 0 * stat_freq(l)
290 ENDIF
291 diagSt_Fname(n) = stat_fname(l)
292 regionCount = 0
293 DO k=1,rdimLoc
294 j = stat_region(k,l)
295 IF ( j.NE.UNSET_I .AND. j.GE.0 .AND. j.LE.nRegions ) THEN
296 diagSt_region(j,n) = 1
297 regionCount = regionCount + 1
298 ELSEIF ( j.NE.UNSET_I ) THEN
299 WRITE(msgBuf,'(A,I3,A,I3,2A)')
300 & 'DIAGNOSTICS_READPARMS: region=',j,
301 & ' in list l=', l, ', stat_fname: ', stat_fname(l)
302 CALL PRINT_ERROR( msgBuf , myThid )
303 WRITE(msgBuf,'(2A,I3,A,I3,2A)')
304 & 'DIAGNOSTICS_READPARMS: ==> exceed Max.Nb of regions',
305 & '(=',nRegions,' )'
306 CALL PRINT_ERROR( msgBuf , myThid )
307 STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
308 ENDIF
309 ENDDO
310 IF ( regionCount.EQ.0 ) THEN
311 C- no region selected => default is Global statistics (region Id: 0)
312 diagSt_region(0,n) = 1
313 ENDIF
314 diagSt_nbFlds(n) = 0
315 DO m=1,fdimLoc
316 IF ( stat_fields(m,l).NE.blk8c .AND.
317 & diagSt_nbFlds(n).LT.numperlist ) THEN
318 diagSt_nbFlds(n) = diagSt_nbFlds(n) + 1
319 diagSt_Flds(diagSt_nbFlds(n),n) = stat_fields(m,l)
320 ELSEIF ( stat_fields(m,l).NE.blk8c ) THEN
321 WRITE(msgBuf,'(2A,I3)') 'DIAGNOSTICS_READPARMS: ',
322 & 'Exceed Max.Num. of Fields/list numperlist=', numperlist
323 CALL PRINT_ERROR( msgBuf , myThid )
324 WRITE(msgBuf,'(2A,I3,3A,I3,2A)') 'DIAGNOSTICS_READPARMS: ',
325 & 'when trying to add stat_field (m=', m,
326 & ' ): ',stat_fields(m,l)
327 CALL PRINT_ERROR( msgBuf , myThid )
328 WRITE(msgBuf,'(2A,I3,2A)') 'DIAGNOSTICS_READPARMS: ',
329 & ' in list l=', l, ', stat_fname: ', stat_fname(l)
330 CALL PRINT_ERROR( msgBuf , myThid )
331 STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
332 ENDIF
333 ENDDO
334 diagSt_nbLists = diagSt_nbLists + 1
335 c write(6,*) 'stat-list summary:',n,diagSt_nbFlds(n),regionCount
336 ELSEIF ( stat_fname(L).NE.blkFilName ) THEN
337 WRITE(msgBuf,'(2A,I3)') 'DIAGNOSTICS_READPARMS: ',
338 & 'Exceed Max.Num. of list numlists=', numlists
339 CALL PRINT_ERROR( msgBuf , myThid )
340 WRITE(msgBuf,'(2A,I3)') 'DIAGNOSTICS_READPARMS: ',
341 & 'when trying to add stat_list l=', l
342 CALL PRINT_ERROR( msgBuf , myThid )
343 WRITE(msgBuf,'(2A,F17.6,2A)') 'DIAGNOSTICS_READPARMS: ',
344 & ' Frq=', stat_freq(l), ', stat_fname: ', stat_fname(l)
345 CALL PRINT_ERROR( msgBuf , myThid )
346 STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
347 ENDIF
348 ENDDO
349
350 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
351 C Echo History List Data Structure
352 stdUnit = standardMessageUnit
353 WRITE(msgBuf,'(A)')
354 & '-----------------------------------------------------'
355 CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
356 WRITE(msgBuf,'(A)')
357 & ' DIAGNOSTICS_READPARMS: active diagnostics summary:'
358 CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
359 WRITE(msgBuf,'(A)')
360 & '-----------------------------------------------------'
361 CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
362 DO n = 1,nlists
363 WRITE(msgBuf,'(2a)') 'Creating Output Stream: ',fnames(n)
364 CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
365 WRITE(msgBuf,'(2(A,F17.6))') 'Frequency : ',freq(n),
366 & ' ; Phase: ', phase(n)
367 CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
368 IF ( nlevels(n).EQ.-1 ) THEN
369 WRITE(msgBuf,'(A,A)') ' Levels: ','will be set later'
370 CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
371 ELSE
372 DO l=1,nlevels(n),20
373 m = MIN(nlevels(n),l+19)
374 WRITE(msgBuf,'(A,20F5.0)') ' Levels: ', (levs(k,n),k=l,m)
375 CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
376 ENDDO
377 ENDIF
378 WRITE(msgBuf,*) 'Fields: ',(' ',flds(l,n),l=1,nfields(n))
379 CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
380 ENDDO
381 WRITE(msgBuf,'(A)')
382 & '-----------------------------------------------------'
383 CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
384 WRITE(msgBuf,'(A)')
385 & ' DIAGNOSTICS_READPARMS: statistics diags. summary:'
386 CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
387 DO n = 1,diagSt_nbLists
388 WRITE(msgBuf,'(2a)') 'Creating Stats. Output Stream: ',
389 & diagSt_Fname(n)
390 CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
391 WRITE(msgBuf,'(2(A,F17.6))') 'Frequency : ',diagSt_freq(n),
392 & ' ; Phase: ', diagSt_phase(n)
393 CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
394 WRITE(msgBuf,'(A)') ' Regions : '
395 l = 12
396 DO j=0,nRegions
397 IF ( diagSt_region(j,n).GE.1 ) THEN
398 IF (l+3.LE.MAX_LEN_MBUF) WRITE(msgBuf,'(A,I3)') msgBuf(1:l),j
399 l = l+3
400 ENDIF
401 ENDDO
402 CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
403 WRITE(msgBuf,*) 'Fields: ',
404 & (' ',diagSt_Flds(l,n),l=1,diagSt_nbFlds(n))
405 CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
406 ENDDO
407 WRITE(msgBuf,'(A)')
408 & '-----------------------------------------------------'
409 CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
410 WRITE(msgBuf,'(A)')
411 CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
412
413 _END_MASTER(myThid)
414
415 RETURN
416 END

  ViewVC Help
Powered by ViewVC 1.1.22