/[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.9 by jmc, Sat May 14 20:45:28 2005 UTC revision 1.14 by edhill, Wed Jul 6 02:13:52 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          PARAMETER ( rdimLoc = 2*nRegions+1 )
48        _RL         frequency(ldimLoc), timePhase(ldimLoc)        _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 stat_fields(fdimLoc,ldimLoc)
53        CHARACTER*80 filename(ldimLoc), blkFilName        CHARACTER*80 filename(ldimLoc), blkFilName
54          CHARACTER*80 stat_fname(ldimLoc)
55        CHARACTER*8 fileflags(ldimLoc)        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,iL        INTEGER j,k,l,n,m
61          INTEGER iLen, regionCount
62        _RL undef, getcon        _RL undef, getcon
63        INTEGER  ILNBLNK        INTEGER  ILNBLNK
64        EXTERNAL ILNBLNK        EXTERNAL ILNBLNK
65    
66    C--   full level output:
67        NAMELIST / diagnostics_list /        NAMELIST / diagnostics_list /
68       &     frequency, timePhase, levels, fields, filename, fileflags,       &     frequency, timePhase, levels, fields, filename, fileflags,
69       &     diag_mnc,       &     dumpatlast, diag_mnc,
70       &     diag_pickup_read,     diag_pickup_write,       &     diag_pickup_read,     diag_pickup_write,
71       &     diag_pickup_read_mnc, diag_pickup_write_mnc       &     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    
# Line 78  C       eight spaces:        12345678 Line 98  C       eight spaces:        12345678
98            fields (m,l) = blk8c            fields (m,l) = blk8c
99          ENDDO          ENDDO
100        ENDDO        ENDDO
101        diag_mnc = useMNC        dumpatlast            = .FALSE.
102          diag_mnc              = useMNC
103        diag_pickup_read      = .FALSE.        diag_pickup_read      = .FALSE.
104        diag_pickup_write     = .FALSE.        diag_pickup_write     = .FALSE.
105        diag_pickup_read_mnc  = .FALSE.        diag_pickup_read_mnc  = .FALSE.
106        diag_pickup_write_mnc = .FALSE.        diag_pickup_write_mnc = .FALSE.
107    
108        WRITE(msgBuf,'(A)')        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'       &     ' DIAGNOSTICS_READPARMS: opening data.diagnostics'
122        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,SQUEEZE_RIGHT,1)        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,SQUEEZE_RIGHT,1)
123    
124        CALL OPEN_COPY_DATA_FILE('data.diagnostics',        CALL OPEN_COPY_DATA_FILE('data.diagnostics',
125       &     'DIAGNOSTICS_READPARMS', ku, myThid )       &     '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)        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)        CLOSE (ku)
152    
153  C     Initialise diag_choices common block  C     Initialise diag_choices common block (except pointers)
154        nlists = 0        nlists = 0
155        DO n = 1,numlists        DO n = 1,numlists
156          freq(n) = 0.          freq(n) = 0.
# Line 106  C     Initialise diag_choices common blo Line 163  C     Initialise diag_choices common blo
163          ENDDO          ENDDO
164          DO m = 1,numperlist          DO m = 1,numperlist
165            flds(m,n) = blk8c            flds(m,n) = blk8c
           jdiag(m,n) = 0  
166          ENDDO          ENDDO
167        ENDDO        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  C     Fill Diagnostics Common Block with Namelist Info
178        diag_mnc = diag_mnc .AND. useMNC        diagSt_mnc = diagSt_mnc .AND. useMNC
179        diag_mdsio = (.NOT. diag_mnc) .OR. outputTypesInclusive        diag_mdsio = (.NOT. diag_mnc) .OR. outputTypesInclusive
180        diag_pickup_read_mnc  = diag_pickup_read_mnc .AND. diag_mnc        diag_pickup_read_mnc  = diag_pickup_read_mnc .AND. diag_mnc
181        diag_pickup_write_mnc = diag_pickup_write_mnc .AND. diag_mnc        diag_pickup_write_mnc = diag_pickup_write_mnc .AND. diag_mnc
182        diag_pickup_read_mdsio  =        diag_pickup_read_mdsio  =
183       &     diag_pickup_read .AND. (.NOT. diag_pickup_read_mnc)       &     diag_pickup_read .AND. (.NOT. diag_pickup_read_mnc)
184        diag_pickup_write_mdsio = diag_pickup_write .AND.        diag_pickup_write_mdsio = diag_pickup_write .AND.
185       &     ((.NOT. diag_pickup_write_mnc) .OR. outputTypesInclusive)       &     ((.NOT. diag_pickup_write_mnc) .OR. outputTypesInclusive)
186          diagSt_ascii = (.NOT. diagSt_mnc) .OR. outputTypesInclusive
187    
188        DO l = 1,ldimLoc        DO l = 1,ldimLoc
189         iL = ILNBLNK(filename(l))         iLen = ILNBLNK(filename(l))
190         IF ( frequency(l).NE.0. .AND. iL.EQ.0 ) THEN  C-     Only lists with non-empty file name (iLen>0) are considered
191           WRITE(msgBuf,'(2A,I3,A,I6)') 'DIAGNOSTICS_READPARMS: ',         IF ( iLen.GE.1 .AND. nlists.LT.numlists ) THEN
      &    'Empty File-name ! (list l=', l, ' ), freq:',frequency(l)  
          CALL PRINT_ERROR( msgBuf , myThid )  
          STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'  
        ENDIF  
        IF ( frequency(l).NE.0. .AND. nlists.LT.numlists ) THEN  
192           n = nlists + 1           n = nlists + 1
193           freq(n)    = frequency(l)           freq(n)    = frequency(l)
194           IF ( timePhase(l).NE. UNSET_RL ) THEN           IF ( timePhase(l).NE. UNSET_RL ) THEN
# Line 183  C-       will set levels later, once the Line 243  C-       will set levels later, once the
243           ENDDO           ENDDO
244           nlists = nlists + 1           nlists = nlists + 1
245  c        write(6,*) 'list summary:',n,nfields(n),nlevels(n)  c        write(6,*) 'list summary:',n,nfields(n),nlevels(n)
246         ELSEIF ( frequency(l).NE.0. ) THEN         ELSEIF ( iLen.GE.1 ) THEN
247           WRITE(msgBuf,'(2A,I3)') 'DIAGNOSTICS_READPARMS: ',           WRITE(msgBuf,'(2A,I3)') 'DIAGNOSTICS_READPARMS: ',
248       &            'Exceed Max.Num. of list numlists=', numlists       &            'Exceed Max.Num. of list numlists=', numlists
249           CALL PRINT_ERROR( msgBuf , myThid )           CALL PRINT_ERROR( msgBuf , myThid )
250           WRITE(msgBuf,'(2A,I3)') 'DIAGNOSTICS_READPARMS: ',           WRITE(msgBuf,'(2A,I3)') 'DIAGNOSTICS_READPARMS: ',
251       &    'when trying to add list l=', l       &    'when trying to add list l=', l
252           CALL PRINT_ERROR( msgBuf , myThid )           CALL PRINT_ERROR( msgBuf , myThid )
253           WRITE(msgBuf,'(2A,I6,2A)') 'DIAGNOSTICS_READPARMS: ',           WRITE(msgBuf,'(2A,F17.6,2A)') 'DIAGNOSTICS_READPARMS: ',
254       &    ' Frq=', frequency(l), ', filename: ', filename(l)       &    ' Frq=', frequency(l), ', filename: ', filename(l)
255           CALL PRINT_ERROR( msgBuf , myThid )           CALL PRINT_ERROR( msgBuf , myThid )
256           STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'           STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
# Line 198  c        write(6,*) 'list summary:',n,nf Line 258  c        write(6,*) 'list summary:',n,nf
258        ENDDO        ENDDO
259    
260  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  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  C     Echo History List Data Structure
353        stdUnit = standardMessageUnit        stdUnit = standardMessageUnit
354        WRITE(msgBuf,'(A)')        WRITE(msgBuf,'(A)')
# Line 212  C     Echo History List Data Structure Line 363  C     Echo History List Data Structure
363        DO n = 1,nlists        DO n = 1,nlists
364          WRITE(msgBuf,'(2a)') 'Creating Output Stream: ',fnames(n)          WRITE(msgBuf,'(2a)') 'Creating Output Stream: ',fnames(n)
365          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
 c       WRITE(msgBuf,*) 'Frequency: ',freq(n)  
366          WRITE(msgBuf,'(2(A,F17.6))') 'Frequency : ',freq(n),          WRITE(msgBuf,'(2(A,F17.6))') 'Frequency : ',freq(n),
367       &                               ' ; Phase: ', phase(n)       &                               ' ; Phase: ', phase(n)
368          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
# Line 230  c       WRITE(msgBuf,*) 'Frequency: ',fr Line 380  c       WRITE(msgBuf,*) 'Frequency: ',fr
380          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
381        ENDDO        ENDDO
382        WRITE(msgBuf,'(A)')        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)        CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
411        WRITE(msgBuf,'(A)')        WRITE(msgBuf,'(A)')
Legend:
Removed from v.1.9  
changed lines
  Added in v.1.14
  ViewVC Help
Powered by ViewVC 1.1.22