/[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.11 - (hide 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 molod 1.11 C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diagnostics_readparms.F,v 1.10 2005/05/20 07:28:50 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_READPARMS
9    
10     C !INTERFACE:
11     SUBROUTINE DIAGNOSTICS_READPARMS(myThid)
12    
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    
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 jmc 1.10 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 jmc 1.1 C levels :: List Output Levels
35     C fields :: List Output Fields
36     C filename :: List Output Filename
37 jmc 1.10 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 jmc 1.1 PARAMETER ( ldimLoc = 2*numlists )
45     PARAMETER ( kdimLoc = 2*numLevels )
46     PARAMETER ( fdimLoc = 2*numperlist )
47 jmc 1.10 PARAMETER ( rdimLoc = 2*nRegions+1 )
48 jmc 1.9 _RL frequency(ldimLoc), timePhase(ldimLoc)
49 jmc 1.1 _RL levels(kdimLoc,ldimLoc)
50 jmc 1.10 _RL stat_freq(ldimLoc), stat_phase(ldimLoc)
51 jmc 1.1 CHARACTER*8 fields(fdimLoc,ldimLoc)
52 jmc 1.10 CHARACTER*8 stat_fields(fdimLoc,ldimLoc)
53 jmc 1.6 CHARACTER*80 filename(ldimLoc), blkFilName
54 jmc 1.10 CHARACTER*80 stat_fname(ldimLoc)
55 edhill 1.7 CHARACTER*8 fileflags(ldimLoc)
56 jmc 1.1 CHARACTER*8 blk8c
57     CHARACTER*(MAX_LEN_MBUF) msgBuf
58 jmc 1.10 INTEGER stat_region(rdimLoc,ldimLoc)
59 jmc 1.1 INTEGER ku, stdUnit
60 jmc 1.10 INTEGER j,k,l,n,m
61 molod 1.11 INTEGER regionCount
62 jmc 1.1 _RL undef, getcon
63 jmc 1.6 INTEGER ILNBLNK
64     EXTERNAL ILNBLNK
65 jmc 1.1
66 jmc 1.10 C-- full level output:
67 jmc 1.1 NAMELIST / diagnostics_list /
68 jmc 1.9 & frequency, timePhase, levels, fields, filename, fileflags,
69 edhill 1.5 & diag_mnc,
70     & diag_pickup_read, diag_pickup_write,
71     & diag_pickup_read_mnc, diag_pickup_write_mnc
72 jmc 1.1
73 jmc 1.10 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 jmc 1.1 C Initialize and Read Diagnostics Namelist
80     _BEGIN_MASTER(myThid)
81    
82     undef = getcon('UNDEF')
83     blk8c = ' '
84 jmc 1.6 DO k=1,LEN(blkFilName)
85     blkFilName(k:k) = ' '
86     ENDDO
87 jmc 1.1
88     DO l = 1,ldimLoc
89 molod 1.8 frequency(l) = 0.
90 jmc 1.9 timePhase(l) = UNSET_RL
91 jmc 1.6 filename (l) = blkFilName
92 edhill 1.7 C eight spaces: 12345678
93     fileflags(l)(1:8) = ' '
94 jmc 1.1 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 jmc 1.4 diag_mnc = useMNC
102 edhill 1.5 diag_pickup_read = .FALSE.
103     diag_pickup_write = .FALSE.
104     diag_pickup_read_mnc = .FALSE.
105     diag_pickup_write_mnc = .FALSE.
106 jmc 1.1
107 jmc 1.10 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 jmc 1.1 & ' DIAGNOSTICS_READPARMS: opening data.diagnostics'
121     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,SQUEEZE_RIGHT,1)
122 jmc 1.3
123     CALL OPEN_COPY_DATA_FILE('data.diagnostics',
124 jmc 1.1 & 'DIAGNOSTICS_READPARMS', ku, myThid )
125 jmc 1.10
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 jmc 1.1 READ (ku,NML=diagnostics_list)
131 jmc 1.10 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 jmc 1.1 CLOSE (ku)
152    
153     C Initialise diag_choices common block
154     nlists = 0
155     DO n = 1,numlists
156 molod 1.8 freq(n) = 0.
157 jmc 1.9 phase(n) = 0.
158 jmc 1.1 nlevels(n) = 0
159     nfields(n) = 0
160 jmc 1.6 fnames(n) = blkFilName
161 jmc 1.1 DO k = 1,numLevels
162     levs(k,n) = 0
163     ENDDO
164     DO m = 1,numperlist
165 jmc 1.6 flds(m,n) = blk8c
166 jmc 1.1 jdiag(m,n) = 0
167     ENDDO
168     ENDDO
169    
170 jmc 1.10 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 jmc 1.1 C Fill Diagnostics Common Block with Namelist Info
179 jmc 1.10 diagSt_mnc = diagSt_mnc .AND. useMNC
180 jmc 1.4 diag_mdsio = (.NOT. diag_mnc) .OR. outputTypesInclusive
181 edhill 1.5 diag_pickup_read_mnc = diag_pickup_read_mnc .AND. diag_mnc
182     diag_pickup_write_mnc = diag_pickup_write_mnc .AND. diag_mnc
183 jmc 1.10 diag_pickup_read_mdsio =
184 edhill 1.5 & 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 jmc 1.10 diagSt_ascii = (.NOT. diagSt_mnc) .OR. outputTypesInclusive
188 jmc 1.3
189 jmc 1.1 DO l = 1,ldimLoc
190 molod 1.11 IF ( filename(L).NE.blkFilName .and. nlists.LT.numlists ) THEN
191 jmc 1.1 n = nlists + 1
192     freq(n) = frequency(l)
193 jmc 1.9 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 jmc 1.1 fnames(n) = filename (l)
199 edhill 1.7 fflags(n) = fileflags(l)
200 jmc 1.1 nlevels(n) = 0
201     IF ( levels(1,l).NE.undef ) THEN
202     DO k=1,kdimLoc
203 jmc 1.3 IF ( levels(k,l).NE.undef .AND.
204 jmc 1.1 & 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 jmc 1.3 & 'when trying to add level(k=', k, ' )=', levels(k,l)
213 jmc 1.1 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 jmc 1.3 C- will set levels later, once the Nb of levels of each diag is known
222     nlevels(n) = -1
223 jmc 1.1 ENDIF
224     nfields(n) = 0
225     DO m=1,fdimLoc
226 jmc 1.3 IF ( fields(m,l).NE.blk8c .AND.
227 jmc 1.1 & nfields(n).LT.numperlist ) THEN
228     nfields(n) = nfields(n) + 1
229     flds(nfields(n),n) = fields(m,l)
230 jmc 1.2 ELSEIF ( fields(m,l).NE.blk8c ) THEN
231 jmc 1.1 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 jmc 1.2 c write(6,*) 'list summary:',n,nfields(n),nlevels(n)
245 molod 1.11 ELSEIF (filename(L).NE.blkFilName) THEN
246 jmc 1.1 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 jmc 1.10 WRITE(msgBuf,'(2A,F17.6,2A)') 'DIAGNOSTICS_READPARMS: ',
253 jmc 1.1 & ' 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 jmc 1.10
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 molod 1.11 IF(stat_fname(L).NE.blkFilName.AND.
283     . diagSt_nbLists.LT.numlists)THEN
284 jmc 1.10 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 molod 1.11 ELSEIF ( stat_fname(L).NE.blkFilName ) THEN
337 jmc 1.10 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 jmc 1.1 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 jmc 1.9 WRITE(msgBuf,'(2(A,F17.6))') 'Frequency : ',freq(n),
366     & ' ; Phase: ', phase(n)
367 jmc 1.1 CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
368 jmc 1.3 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 jmc 1.1 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 jmc 1.3 ENDDO
377     ENDIF
378 jmc 1.1 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 jmc 1.10 & ' 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 jmc 1.1 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