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

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

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

revision 1.3 by jmc, Mon Dec 20 01:52:58 2004 UTC revision 1.11 by molod, Tue Jun 14 22:30:02 2005 UTC
# Line 29  C     !LOCAL VARIABLES: Line 29  C     !LOCAL VARIABLES:
29  C     ldimLoc :: Max Number of Lists  C     ldimLoc :: Max Number of Lists
30  C     kdimLoc :: Max Number of Levels  C     kdimLoc :: Max Number of Levels
31  C     fdimLoc :: Max Number of Fields  C     fdimLoc :: Max Number of Fields
32  C     frequency :: Frequency of Output (ouput every "frequency" iteration)  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  C     levels    :: List Output Levels
35  C     fields    :: List Output Fields  C     fields    :: List Output Fields
36  C     filename  :: List Output Filename  C     filename  :: List Output Filename
37        INTEGER     ldimLoc, kdimLoc, fdimLoc  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 )        PARAMETER ( ldimLoc = 2*numlists )
45        PARAMETER ( kdimLoc = 2*numLevels )        PARAMETER ( kdimLoc = 2*numLevels )
46        PARAMETER ( fdimLoc = 2*numperlist )        PARAMETER ( fdimLoc = 2*numperlist )
47        INTEGER     frequency(ldimLoc)        PARAMETER ( rdimLoc = 2*nRegions+1 )
48          _RL         frequency(ldimLoc), timePhase(ldimLoc)
49        _RL         levels(kdimLoc,ldimLoc)        _RL         levels(kdimLoc,ldimLoc)
50          _RL         stat_freq(ldimLoc), stat_phase(ldimLoc)
51        CHARACTER*8 fields(fdimLoc,ldimLoc)        CHARACTER*8 fields(fdimLoc,ldimLoc)
52        CHARACTER*8 filename(ldimLoc)        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        CHARACTER*8 blk8c
57        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
58          INTEGER stat_region(rdimLoc,ldimLoc)
59        INTEGER ku, stdUnit        INTEGER ku, stdUnit
60        INTEGER k,l,n,m        INTEGER j,k,l,n,m
61          INTEGER regionCount
62        _RL undef, getcon        _RL undef, getcon
63          INTEGER  ILNBLNK
64          EXTERNAL ILNBLNK
65    
66    C--   full level output:
67        NAMELIST / diagnostics_list /        NAMELIST / diagnostics_list /
68       &     frequency, levels, fields, filename,       &     frequency, timePhase, levels, fields, filename, fileflags,
69       &     diag_mnc       &     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  C     Initialize and Read Diagnostics Namelist
80        _BEGIN_MASTER(myThid)        _BEGIN_MASTER(myThid)
81    
82        undef = getcon('UNDEF')        undef = getcon('UNDEF')
83        blk8c  = '        '        blk8c  = '        '
84          DO k=1,LEN(blkFilName)
85            blkFilName(k:k) = ' '
86          ENDDO
87    
88        DO l = 1,ldimLoc        DO l = 1,ldimLoc
89          frequency(l) = 0          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          DO k = 1,kdimLoc
95            levels (k,l) = undef            levels (k,l) = undef
96          ENDDO          ENDDO
# Line 66  C     Initialize and Read Diagnostics Na Line 98  C     Initialize and Read Diagnostics Na
98            fields (m,l) = blk8c            fields (m,l) = blk8c
99          ENDDO          ENDDO
100        ENDDO        ENDDO
101        diag_mnc   = .FALSE.        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        WRITE(msgBuf,'(A)')        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'       &     ' DIAGNOSTICS_READPARMS: opening data.diagnostics'
121        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,SQUEEZE_RIGHT,1)        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,SQUEEZE_RIGHT,1)
122    
123        CALL OPEN_COPY_DATA_FILE('data.diagnostics',        CALL OPEN_COPY_DATA_FILE('data.diagnostics',
124       &     'DIAGNOSTICS_READPARMS', ku, myThid )       &     '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)        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)        CLOSE (ku)
152    
153  C     Initialise diag_choices common block  C     Initialise diag_choices common block
154        nlists = 0        nlists = 0
155        DO n = 1,numlists        DO n = 1,numlists
156          freq(n) = 0          freq(n) = 0.
157            phase(n) = 0.
158          nlevels(n) = 0          nlevels(n) = 0
159          nfields(n) = 0          nfields(n) = 0
160          fnames(n) = blk8c          fnames(n) = blkFilName
161          DO k = 1,numLevels          DO k = 1,numLevels
162            levs(k,n) = 0            levs(k,n) = 0
163          ENDDO          ENDDO
164          DO m = 1,numperlist          DO m = 1,numperlist
165            flds(m,n) = '        '            flds(m,n) = blk8c
166            jdiag(m,n) = 0            jdiag(m,n) = 0
167          ENDDO          ENDDO
168        ENDDO        ENDDO
169        diag_mdsio = .TRUE.  
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  C     Fill Diagnostics Common Block with Namelist Info
179        IF ( useMNC .AND. diag_mnc        diagSt_mnc = diagSt_mnc .AND. useMNC
180       &            .AND. (.NOT. outputTypesInclusive)) THEN        diag_mdsio = (.NOT. diag_mnc) .OR. outputTypesInclusive
181          diag_mdsio = .FALSE.        diag_pickup_read_mnc  = diag_pickup_read_mnc .AND. diag_mnc
182        ENDIF        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        DO l = 1,ldimLoc
190         IF ( frequency(l).NE.0 .AND. nlists.LT.numlists ) THEN         IF ( filename(L).NE.blkFilName .and. nlists.LT.numlists ) THEN
191           n = nlists + 1           n = nlists + 1
192           freq(n)    = frequency(l)           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)           fnames(n)  = filename (l)
199             fflags(n)  = fileflags(l)
200           nlevels(n) = 0           nlevels(n) = 0
201           IF ( levels(1,l).NE.undef ) THEN           IF ( levels(1,l).NE.undef ) THEN
202             DO k=1,kdimLoc             DO k=1,kdimLoc
# Line 150  C-       will set levels later, once the Line 242  C-       will set levels later, once the
242           ENDDO           ENDDO
243           nlists = nlists + 1           nlists = nlists + 1
244  c        write(6,*) 'list summary:',n,nfields(n),nlevels(n)  c        write(6,*) 'list summary:',n,nfields(n),nlevels(n)
245         ELSEIF ( frequency(l).NE.0 ) THEN         ELSEIF (filename(L).NE.blkFilName) THEN
246           WRITE(msgBuf,'(2A,I3)') 'DIAGNOSTICS_READPARMS: ',           WRITE(msgBuf,'(2A,I3)') 'DIAGNOSTICS_READPARMS: ',
247       &            'Exceed Max.Num. of list numlists=', numlists       &            'Exceed Max.Num. of list numlists=', numlists
248           CALL PRINT_ERROR( msgBuf , myThid )           CALL PRINT_ERROR( msgBuf , myThid )
249           WRITE(msgBuf,'(2A,I3)') 'DIAGNOSTICS_READPARMS: ',           WRITE(msgBuf,'(2A,I3)') 'DIAGNOSTICS_READPARMS: ',
250       &    'when trying to add list l=', l       &    'when trying to add list l=', l
251           CALL PRINT_ERROR( msgBuf , myThid )           CALL PRINT_ERROR( msgBuf , myThid )
252           WRITE(msgBuf,'(2A,I6,2A)') 'DIAGNOSTICS_READPARMS: ',           WRITE(msgBuf,'(2A,F17.6,2A)') 'DIAGNOSTICS_READPARMS: ',
253       &    ' Frq=', frequency(l), ', filename: ', filename(l)       &    ' Frq=', frequency(l), ', filename: ', filename(l)
254           CALL PRINT_ERROR( msgBuf , myThid )           CALL PRINT_ERROR( msgBuf , myThid )
255           STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'           STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
# Line 165  c        write(6,*) 'list summary:',n,nf Line 257  c        write(6,*) 'list summary:',n,nf
257        ENDDO        ENDDO
258    
259  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  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  C     Echo History List Data Structure
352        stdUnit = standardMessageUnit        stdUnit = standardMessageUnit
353        WRITE(msgBuf,'(A)')        WRITE(msgBuf,'(A)')
# Line 179  C     Echo History List Data Structure Line 362  C     Echo History List Data Structure
362        DO n = 1,nlists        DO n = 1,nlists
363          WRITE(msgBuf,'(2a)') 'Creating Output Stream: ',fnames(n)          WRITE(msgBuf,'(2a)') 'Creating Output Stream: ',fnames(n)
364          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
365          WRITE(msgBuf,*) 'Frequency: ',freq(n)          WRITE(msgBuf,'(2(A,F17.6))') 'Frequency : ',freq(n),
366         &                               ' ; Phase: ', phase(n)
367          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
368          IF ( nlevels(n).EQ.-1 ) THEN          IF ( nlevels(n).EQ.-1 ) THEN
369            WRITE(msgBuf,'(A,A)') ' Levels:    ','will be set later'            WRITE(msgBuf,'(A,A)') ' Levels:    ','will be set later'
# Line 195  C     Echo History List Data Structure Line 379  C     Echo History List Data Structure
379          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
380        ENDDO        ENDDO
381        WRITE(msgBuf,'(A)')        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)        CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
410        WRITE(msgBuf,'(A)')        WRITE(msgBuf,'(A)')
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.11
  ViewVC Help
Powered by ViewVC 1.1.22