/[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.14 - (show annotations) (download)
Wed Jul 6 02:13:52 2005 UTC (18 years, 10 months ago) by edhill
Branch: MAIN
CVS Tags: checkpoint57t_post, checkpoint57o_post, checkpoint57m_post, checkpoint57s_post, checkpoint57y_post, checkpoint57y_pre, checkpoint57v_post, checkpoint57r_post, checkpoint58, checkpoint57x_post, checkpoint57n_post, checkpoint57w_post, checkpoint57p_post, checkpint57u_post, checkpoint57q_post, checkpoint57z_post, checkpoint57l_post
Changes since 1.13: +3 -3 lines
 o add mnc output capability to diagnostics/diagstat and update
   our cvsignore files for the ACSII output generated

1 C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diagnostics_readparms.F,v 1.13 2005/06/26 16:51:49 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 iLen, 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 & dumpatlast, 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 dumpatlast = .FALSE.
102 diag_mnc = useMNC
103 diag_pickup_read = .FALSE.
104 diag_pickup_write = .FALSE.
105 diag_pickup_read_mnc = .FALSE.
106 diag_pickup_write_mnc = .FALSE.
107
108 DO l = 1,ldimLoc
109 stat_freq(l) = 0.
110 stat_phase(l) = UNSET_RL
111 stat_fname(l) = blkFilName
112 DO k = 1,rdimLoc
113 stat_region(k,l) = UNSET_I
114 ENDDO
115 DO m = 1,fdimLoc
116 stat_fields(m,l) = blk8c
117 ENDDO
118 ENDDO
119
120 WRITE(msgBuf,'(2A)')
121 & ' DIAGNOSTICS_READPARMS: opening data.diagnostics'
122 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,SQUEEZE_RIGHT,1)
123
124 CALL OPEN_COPY_DATA_FILE('data.diagnostics',
125 & 'DIAGNOSTICS_READPARMS', ku, myThid )
126
127 WRITE(msgBuf,'(2A)') 'S/R DIAGNOSTICS_READPARMS,',
128 & ' read namelist "diagnostics_list": start'
129 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
130 & SQUEEZE_RIGHT , 1)
131 READ (ku,NML=diagnostics_list)
132 WRITE(msgBuf,'(2A)') 'S/R DIAGNOSTICS_READPARMS,',
133 & ' read namelist "diagnostics_list": OK'
134 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
135 & SQUEEZE_RIGHT , 1)
136
137 C- set default for statistics output according to the main flag
138 diag_mnc = diag_mnc .AND. useMNC
139 diagSt_mnc = diag_mnc
140
141 WRITE(msgBuf,'(2A)') 'S/R DIAGNOSTICS_READPARMS,',
142 & ' read namelist "DIAG_STATIS_PARMS": start'
143 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
144 & SQUEEZE_RIGHT , 1)
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 (except pointers)
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 ENDDO
167 ENDDO
168
169 C useMNC is confusing (can be T at this point & turned off later, whereas
170 C for all other pkgs, model stops if use${PKG}= T with #undef ALLOW_${PKG})
171 #ifndef ALLOW_MNC
172 C Fix to avoid running without getting any output:
173 diag_mnc = .FALSE.
174 diagSt_mnc = .FALSE.
175 #endif
176
177 C Fill Diagnostics Common Block with Namelist Info
178 diagSt_mnc = diagSt_mnc .AND. useMNC
179 diag_mdsio = (.NOT. diag_mnc) .OR. outputTypesInclusive
180 diag_pickup_read_mnc = diag_pickup_read_mnc .AND. diag_mnc
181 diag_pickup_write_mnc = diag_pickup_write_mnc .AND. diag_mnc
182 diag_pickup_read_mdsio =
183 & diag_pickup_read .AND. (.NOT. diag_pickup_read_mnc)
184 diag_pickup_write_mdsio = diag_pickup_write .AND.
185 & ((.NOT. diag_pickup_write_mnc) .OR. outputTypesInclusive)
186 diagSt_ascii = (.NOT. diagSt_mnc) .OR. outputTypesInclusive
187
188 DO l = 1,ldimLoc
189 iLen = ILNBLNK(filename(l))
190 C- Only lists with non-empty file name (iLen>0) are considered
191 IF ( iLen.GE.1 .AND. nlists.LT.numlists ) THEN
192 n = nlists + 1
193 freq(n) = frequency(l)
194 IF ( timePhase(l).NE. UNSET_RL ) THEN
195 phase(n) = timePhase(l)
196 ELSEIF ( frequency(l) .LT. 0. ) THEN
197 phase(n) = -0.5 _d 0 * frequency(l)
198 ENDIF
199 fnames(n) = filename (l)
200 fflags(n) = fileflags(l)
201 nlevels(n) = 0
202 IF ( levels(1,l).NE.undef ) THEN
203 DO k=1,kdimLoc
204 IF ( levels(k,l).NE.undef .AND.
205 & nlevels(n).LT.numLevels ) THEN
206 nlevels(n) = nlevels(n) + 1
207 levs(nlevels(n),n) = levels(k,l)
208 ELSEIF ( levels(k,l).NE.undef ) THEN
209 WRITE(msgBuf,'(2A,I3)') 'DIAGNOSTICS_READPARMS: ',
210 & 'Exceed Max.Num. of Levels numLevels=', numLevels
211 CALL PRINT_ERROR( msgBuf , myThid )
212 WRITE(msgBuf,'(2A,I3,A,F3.0)') 'DIAGNOSTICS_READPARMS: ',
213 & 'when trying to add level(k=', k, ' )=', levels(k,l)
214 CALL PRINT_ERROR( msgBuf , myThid )
215 WRITE(msgBuf,'(2A,I3,2A)') 'DIAGNOSTICS_READPARMS: ',
216 & ' for list l=', l, ', filename: ', filename(l)
217 CALL PRINT_ERROR( msgBuf , myThid )
218 STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
219 ENDIF
220 ENDDO
221 ELSE
222 C- will set levels later, once the Nb of levels of each diag is known
223 nlevels(n) = -1
224 ENDIF
225 nfields(n) = 0
226 DO m=1,fdimLoc
227 IF ( fields(m,l).NE.blk8c .AND.
228 & nfields(n).LT.numperlist ) THEN
229 nfields(n) = nfields(n) + 1
230 flds(nfields(n),n) = fields(m,l)
231 ELSEIF ( fields(m,l).NE.blk8c ) THEN
232 WRITE(msgBuf,'(2A,I3)') 'DIAGNOSTICS_READPARMS: ',
233 & 'Exceed Max.Num. of Fields/list numperlist=', numperlist
234 CALL PRINT_ERROR( msgBuf , myThid )
235 WRITE(msgBuf,'(2A,I3,3A,I3,2A)') 'DIAGNOSTICS_READPARMS: ',
236 & 'when trying to add field (m=', m, ' ): ',fields(m,l)
237 CALL PRINT_ERROR( msgBuf , myThid )
238 WRITE(msgBuf,'(2A,I3,2A)') 'DIAGNOSTICS_READPARMS: ',
239 & ' in list l=', l, ', filename: ', filename(l)
240 CALL PRINT_ERROR( msgBuf , myThid )
241 STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
242 ENDIF
243 ENDDO
244 nlists = nlists + 1
245 c write(6,*) 'list summary:',n,nfields(n),nlevels(n)
246 ELSEIF ( iLen.GE.1 ) THEN
247 WRITE(msgBuf,'(2A,I3)') 'DIAGNOSTICS_READPARMS: ',
248 & 'Exceed Max.Num. of list numlists=', numlists
249 CALL PRINT_ERROR( msgBuf , myThid )
250 WRITE(msgBuf,'(2A,I3)') 'DIAGNOSTICS_READPARMS: ',
251 & 'when trying to add list l=', l
252 CALL PRINT_ERROR( msgBuf , myThid )
253 WRITE(msgBuf,'(2A,F17.6,2A)') 'DIAGNOSTICS_READPARMS: ',
254 & ' Frq=', frequency(l), ', filename: ', filename(l)
255 CALL PRINT_ERROR( msgBuf , myThid )
256 STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
257 ENDIF
258 ENDDO
259
260 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
261
262 C Initialise DIAG_STATIS common block (except pointers)
263 diagSt_nbLists = 0
264 DO n = 1,numlists
265 diagSt_freq(n) = 0.
266 diagSt_phase(n) = 0.
267 diagSt_nbFlds(n) = 0
268 diagSt_ioUnit(n) = 0
269 diagSt_Fname(n) = blkFilName
270 DO j = 0,nRegions
271 diagSt_region(j,n) = 0
272 ENDDO
273 DO m = 1,numperlist
274 diagSt_Flds(m,n) = blk8c
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 iLen = ILNBLNK(stat_fname(l))
283 C- Only lists with non-empty file name (iLen>0) are considered
284 IF ( iLen.GE.1 .AND. diagSt_nbLists.LT.numlists)THEN
285 n = diagSt_nbLists + 1
286 diagSt_freq(n) = stat_freq(l)
287 IF ( stat_phase(l).NE. UNSET_RL ) THEN
288 diagSt_phase(n) = stat_phase(l)
289 ELSEIF ( stat_freq(l) .LT. 0. ) THEN
290 diagSt_phase(n) = -0.5 _d 0 * stat_freq(l)
291 ENDIF
292 diagSt_Fname(n) = stat_fname(l)
293 regionCount = 0
294 DO k=1,rdimLoc
295 j = stat_region(k,l)
296 IF ( j.NE.UNSET_I .AND. j.GE.0 .AND. j.LE.nRegions ) THEN
297 diagSt_region(j,n) = 1
298 regionCount = regionCount + 1
299 ELSEIF ( j.NE.UNSET_I ) THEN
300 WRITE(msgBuf,'(A,I3,A,I3,2A)')
301 & 'DIAGNOSTICS_READPARMS: region=',j,
302 & ' in list l=', l, ', stat_fname: ', stat_fname(l)
303 CALL PRINT_ERROR( msgBuf , myThid )
304 WRITE(msgBuf,'(2A,I3,A,I3,2A)')
305 & 'DIAGNOSTICS_READPARMS: ==> exceed Max.Nb of regions',
306 & '(=',nRegions,' )'
307 CALL PRINT_ERROR( msgBuf , myThid )
308 STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
309 ENDIF
310 ENDDO
311 IF ( regionCount.EQ.0 ) THEN
312 C- no region selected => default is Global statistics (region Id: 0)
313 diagSt_region(0,n) = 1
314 ENDIF
315 diagSt_nbFlds(n) = 0
316 DO m=1,fdimLoc
317 IF ( stat_fields(m,l).NE.blk8c .AND.
318 & diagSt_nbFlds(n).LT.numperlist ) THEN
319 diagSt_nbFlds(n) = diagSt_nbFlds(n) + 1
320 diagSt_Flds(diagSt_nbFlds(n),n) = stat_fields(m,l)
321 ELSEIF ( stat_fields(m,l).NE.blk8c ) THEN
322 WRITE(msgBuf,'(2A,I3)') 'DIAGNOSTICS_READPARMS: ',
323 & 'Exceed Max.Num. of Fields/list numperlist=', numperlist
324 CALL PRINT_ERROR( msgBuf , myThid )
325 WRITE(msgBuf,'(2A,I3,3A,I3,2A)') 'DIAGNOSTICS_READPARMS: ',
326 & 'when trying to add stat_field (m=', m,
327 & ' ): ',stat_fields(m,l)
328 CALL PRINT_ERROR( msgBuf , myThid )
329 WRITE(msgBuf,'(2A,I3,2A)') 'DIAGNOSTICS_READPARMS: ',
330 & ' in list l=', l, ', stat_fname: ', stat_fname(l)
331 CALL PRINT_ERROR( msgBuf , myThid )
332 STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
333 ENDIF
334 ENDDO
335 diagSt_nbLists = diagSt_nbLists + 1
336 c write(6,*) 'stat-list summary:',n,diagSt_nbFlds(n),regionCount
337 ELSEIF ( iLen.GE.1 ) THEN
338 WRITE(msgBuf,'(2A,I3)') 'DIAGNOSTICS_READPARMS: ',
339 & 'Exceed Max.Num. of list numlists=', numlists
340 CALL PRINT_ERROR( msgBuf , myThid )
341 WRITE(msgBuf,'(2A,I3)') 'DIAGNOSTICS_READPARMS: ',
342 & 'when trying to add stat_list l=', l
343 CALL PRINT_ERROR( msgBuf , myThid )
344 WRITE(msgBuf,'(2A,F17.6,2A)') 'DIAGNOSTICS_READPARMS: ',
345 & ' Frq=', stat_freq(l), ', stat_fname: ', stat_fname(l)
346 CALL PRINT_ERROR( msgBuf , myThid )
347 STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
348 ENDIF
349 ENDDO
350
351 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
352 C Echo History List Data Structure
353 stdUnit = standardMessageUnit
354 WRITE(msgBuf,'(A)')
355 & '-----------------------------------------------------'
356 CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
357 WRITE(msgBuf,'(A)')
358 & ' DIAGNOSTICS_READPARMS: active diagnostics summary:'
359 CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
360 WRITE(msgBuf,'(A)')
361 & '-----------------------------------------------------'
362 CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
363 DO n = 1,nlists
364 WRITE(msgBuf,'(2a)') 'Creating Output Stream: ',fnames(n)
365 CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
366 WRITE(msgBuf,'(2(A,F17.6))') 'Frequency : ',freq(n),
367 & ' ; Phase: ', phase(n)
368 CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
369 IF ( nlevels(n).EQ.-1 ) THEN
370 WRITE(msgBuf,'(A,A)') ' Levels: ','will be set later'
371 CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
372 ELSE
373 DO l=1,nlevels(n),20
374 m = MIN(nlevels(n),l+19)
375 WRITE(msgBuf,'(A,20F5.0)') ' Levels: ', (levs(k,n),k=l,m)
376 CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
377 ENDDO
378 ENDIF
379 WRITE(msgBuf,*) 'Fields: ',(' ',flds(l,n),l=1,nfields(n))
380 CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
381 ENDDO
382 WRITE(msgBuf,'(A)')
383 & '-----------------------------------------------------'
384 CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
385 WRITE(msgBuf,'(A)')
386 & ' DIAGNOSTICS_READPARMS: statistics diags. summary:'
387 CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
388 DO n = 1,diagSt_nbLists
389 WRITE(msgBuf,'(2a)') 'Creating Stats. Output Stream: ',
390 & diagSt_Fname(n)
391 CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
392 WRITE(msgBuf,'(2(A,F17.6))') 'Frequency : ',diagSt_freq(n),
393 & ' ; Phase: ', diagSt_phase(n)
394 CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
395 WRITE(msgBuf,'(A)') ' Regions : '
396 l = 12
397 DO j=0,nRegions
398 IF ( diagSt_region(j,n).GE.1 ) THEN
399 IF (l+3.LE.MAX_LEN_MBUF) WRITE(msgBuf,'(A,I3)') msgBuf(1:l),j
400 l = l+3
401 ENDIF
402 ENDDO
403 CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
404 WRITE(msgBuf,*) 'Fields: ',
405 & (' ',diagSt_Flds(l,n),l=1,diagSt_nbFlds(n))
406 CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
407 ENDDO
408 WRITE(msgBuf,'(A)')
409 & '-----------------------------------------------------'
410 CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
411 WRITE(msgBuf,'(A)')
412 CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
413
414 _END_MASTER(myThid)
415
416 RETURN
417 END

  ViewVC Help
Powered by ViewVC 1.1.22