/[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.10 by jmc, Fri May 20 07:28:50 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 iL, 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,       &     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 84  C       eight spaces:        12345678 Line 104  C       eight spaces:        12345678
104        diag_pickup_read_mnc  = .FALSE.        diag_pickup_read_mnc  = .FALSE.
105        diag_pickup_write_mnc = .FALSE.        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
# Line 110  C     Initialise diag_choices common blo Line 167  C     Initialise diag_choices common blo
167          ENDDO          ENDDO
168        ENDDO        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  C     Fill Diagnostics Common Block with Namelist Info
179        diag_mnc = diag_mnc .AND. useMNC        diagSt_mnc = diagSt_mnc .AND. useMNC
180        diag_mdsio = (.NOT. diag_mnc) .OR. outputTypesInclusive        diag_mdsio = (.NOT. diag_mnc) .OR. outputTypesInclusive
181        diag_pickup_read_mnc  = diag_pickup_read_mnc .AND. diag_mnc        diag_pickup_read_mnc  = diag_pickup_read_mnc .AND. diag_mnc
182        diag_pickup_write_mnc = diag_pickup_write_mnc .AND. diag_mnc        diag_pickup_write_mnc = diag_pickup_write_mnc .AND. diag_mnc
183        diag_pickup_read_mdsio  =        diag_pickup_read_mdsio  =
184       &     diag_pickup_read .AND. (.NOT. diag_pickup_read_mnc)       &     diag_pickup_read .AND. (.NOT. diag_pickup_read_mnc)
185        diag_pickup_write_mdsio = diag_pickup_write .AND.        diag_pickup_write_mdsio = diag_pickup_write .AND.
186       &     ((.NOT. diag_pickup_write_mnc) .OR. outputTypesInclusive)       &     ((.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         iL = ILNBLNK(filename(l))         iL = ILNBLNK(filename(l))
191         IF ( frequency(l).NE.0. .AND. iL.EQ.0 ) THEN         IF ( frequency(l).NE.0. .AND. iL.EQ.0 ) THEN
192           WRITE(msgBuf,'(2A,I3,A,I6)') 'DIAGNOSTICS_READPARMS: ',           WRITE(msgBuf,'(2A,I3,A,F17.6)') 'DIAGNOSTICS_READPARMS: ',
193       &    'Empty File-name ! (list l=', l, ' ), freq:',frequency(l)       &    'Empty File-name ! (list l=', l, ' ), freq:',frequency(l)
194           CALL PRINT_ERROR( msgBuf , myThid )           CALL PRINT_ERROR( msgBuf , myThid )
195           STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'           STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
# Line 190  c        write(6,*) 'list summary:',n,nf Line 256  c        write(6,*) 'list summary:',n,nf
256           WRITE(msgBuf,'(2A,I3)') 'DIAGNOSTICS_READPARMS: ',           WRITE(msgBuf,'(2A,I3)') 'DIAGNOSTICS_READPARMS: ',
257       &    'when trying to add list l=', l       &    'when trying to add list l=', l
258           CALL PRINT_ERROR( msgBuf , myThid )           CALL PRINT_ERROR( msgBuf , myThid )
259           WRITE(msgBuf,'(2A,I6,2A)') 'DIAGNOSTICS_READPARMS: ',           WRITE(msgBuf,'(2A,F17.6,2A)') 'DIAGNOSTICS_READPARMS: ',
260       &    ' Frq=', frequency(l), ', filename: ', filename(l)       &    ' Frq=', frequency(l), ', filename: ', filename(l)
261           CALL PRINT_ERROR( msgBuf , myThid )           CALL PRINT_ERROR( msgBuf , myThid )
262           STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'           STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
# Line 198  c        write(6,*) 'list summary:',n,nf Line 264  c        write(6,*) 'list summary:',n,nf
264        ENDDO        ENDDO
265    
266  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
267    
268    C     Initialise DIAG_STATIS common block
269          diagSt_nbLists = 0
270          DO n = 1,numlists
271            diagSt_freq(n) = 0.
272            diagSt_phase(n) = 0.
273            diagSt_nbFlds(n) = 0
274            diagSt_ioUnit(n) = 0
275            diagSt_Fname(n) = blkFilName
276            DO j = 0,nRegions
277              diagSt_region(j,n) = 0
278            ENDDO
279            DO m = 1,numperlist
280              diagSt_Flds(m,n) = blk8c
281              jSdiag(m,n) = 0
282            ENDDO
283          ENDDO
284    
285    C     Fill Diagnostics Common Block with Namelist Info
286          diagSt_ascii = (.NOT. diagSt_mnc) .OR. outputTypesInclusive
287    
288          DO l = 1,ldimLoc
289           iL = ILNBLNK(stat_fname(l))
290           IF ( stat_freq(l).NE.0. .AND. iL.EQ.0 ) THEN
291             WRITE(msgBuf,'(2A,I3,A,F17.6)') 'DIAGNOSTICS_READPARMS: ',
292         &    'Empty File-name ! (list l=', l, ' ), stat_freq:',stat_freq(l)
293             CALL PRINT_ERROR( msgBuf , myThid )
294             STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
295           ENDIF
296           IF ( stat_freq(l).NE.0. .AND. diagSt_nbLists.LT.numlists ) THEN
297             n = diagSt_nbLists + 1
298             diagSt_freq(n) = stat_freq(l)
299             IF ( stat_phase(l).NE. UNSET_RL ) THEN
300               diagSt_phase(n) = stat_phase(l)
301             ELSEIF ( stat_freq(l) .LT. 0. ) THEN
302               diagSt_phase(n) = -0.5 _d 0 * stat_freq(l)
303             ENDIF
304             diagSt_Fname(n)  = stat_fname(l)
305             regionCount = 0
306             DO k=1,rdimLoc
307               j = stat_region(k,l)
308               IF ( j.NE.UNSET_I .AND. j.GE.0 .AND. j.LE.nRegions ) THEN
309                 diagSt_region(j,n) = 1
310                 regionCount = regionCount + 1
311               ELSEIF ( j.NE.UNSET_I ) THEN
312                 WRITE(msgBuf,'(A,I3,A,I3,2A)')
313         &       'DIAGNOSTICS_READPARMS: region=',j,
314         &         ' in list l=', l, ', stat_fname: ', stat_fname(l)
315                 CALL PRINT_ERROR( msgBuf , myThid )
316                 WRITE(msgBuf,'(2A,I3,A,I3,2A)')
317         &       'DIAGNOSTICS_READPARMS: ==> exceed Max.Nb of regions',
318         &       '(=',nRegions,' )'
319                 CALL PRINT_ERROR( msgBuf , myThid )
320                 STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
321               ENDIF
322             ENDDO
323             IF ( regionCount.EQ.0 ) THEN
324    C-       no region selected => default is Global statistics (region Id: 0)
325               diagSt_region(0,n) = 1
326             ENDIF
327             diagSt_nbFlds(n) = 0
328             DO m=1,fdimLoc
329               IF ( stat_fields(m,l).NE.blk8c .AND.
330         &          diagSt_nbFlds(n).LT.numperlist ) THEN
331                 diagSt_nbFlds(n) = diagSt_nbFlds(n) + 1
332                 diagSt_Flds(diagSt_nbFlds(n),n) = stat_fields(m,l)
333               ELSEIF ( stat_fields(m,l).NE.blk8c ) THEN
334                 WRITE(msgBuf,'(2A,I3)') 'DIAGNOSTICS_READPARMS: ',
335         &        'Exceed Max.Num. of Fields/list numperlist=', numperlist
336                 CALL PRINT_ERROR( msgBuf , myThid )
337                 WRITE(msgBuf,'(2A,I3,3A,I3,2A)') 'DIAGNOSTICS_READPARMS: ',
338         &        'when trying to add stat_field (m=', m,
339         &        ' ): ',stat_fields(m,l)
340                 CALL PRINT_ERROR( msgBuf , myThid )
341                 WRITE(msgBuf,'(2A,I3,2A)') 'DIAGNOSTICS_READPARMS: ',
342         &        ' in list l=', l, ', stat_fname: ', stat_fname(l)
343                 CALL PRINT_ERROR( msgBuf , myThid )
344                 STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
345               ENDIF
346             ENDDO
347             diagSt_nbLists = diagSt_nbLists + 1
348    c        write(6,*) 'stat-list summary:',n,diagSt_nbFlds(n),regionCount
349           ELSEIF ( stat_freq(l).NE.0. ) THEN
350             WRITE(msgBuf,'(2A,I3)') 'DIAGNOSTICS_READPARMS: ',
351         &            'Exceed Max.Num. of list numlists=', numlists
352             CALL PRINT_ERROR( msgBuf , myThid )
353             WRITE(msgBuf,'(2A,I3)') 'DIAGNOSTICS_READPARMS: ',
354         &    'when trying to add stat_list l=', l
355             CALL PRINT_ERROR( msgBuf , myThid )
356             WRITE(msgBuf,'(2A,F17.6,2A)') 'DIAGNOSTICS_READPARMS: ',
357         &    ' Frq=', stat_freq(l), ', stat_fname: ', stat_fname(l)
358             CALL PRINT_ERROR( msgBuf , myThid )
359             STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
360           ENDIF
361          ENDDO
362    
363    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
364  C     Echo History List Data Structure  C     Echo History List Data Structure
365        stdUnit = standardMessageUnit        stdUnit = standardMessageUnit
366        WRITE(msgBuf,'(A)')        WRITE(msgBuf,'(A)')
# Line 212  C     Echo History List Data Structure Line 375  C     Echo History List Data Structure
375        DO n = 1,nlists        DO n = 1,nlists
376          WRITE(msgBuf,'(2a)') 'Creating Output Stream: ',fnames(n)          WRITE(msgBuf,'(2a)') 'Creating Output Stream: ',fnames(n)
377          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
 c       WRITE(msgBuf,*) 'Frequency: ',freq(n)  
378          WRITE(msgBuf,'(2(A,F17.6))') 'Frequency : ',freq(n),          WRITE(msgBuf,'(2(A,F17.6))') 'Frequency : ',freq(n),
379       &                               ' ; Phase: ', phase(n)       &                               ' ; Phase: ', phase(n)
380          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
# Line 230  c       WRITE(msgBuf,*) 'Frequency: ',fr Line 392  c       WRITE(msgBuf,*) 'Frequency: ',fr
392          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
393        ENDDO        ENDDO
394        WRITE(msgBuf,'(A)')        WRITE(msgBuf,'(A)')
395         & '-----------------------------------------------------'
396          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
397          WRITE(msgBuf,'(A)')
398         &     ' DIAGNOSTICS_READPARMS: statistics diags. summary:'
399          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
400          DO n = 1,diagSt_nbLists
401            WRITE(msgBuf,'(2a)') 'Creating Stats. Output Stream: ',
402         &                       diagSt_Fname(n)
403            CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
404            WRITE(msgBuf,'(2(A,F17.6))') 'Frequency : ',diagSt_freq(n),
405         &                               ' ; Phase: ', diagSt_phase(n)
406            CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
407            WRITE(msgBuf,'(A)') ' Regions : '
408            l = 12
409            DO j=0,nRegions
410             IF ( diagSt_region(j,n).GE.1 ) THEN
411              IF (l+3.LE.MAX_LEN_MBUF) WRITE(msgBuf,'(A,I3)') msgBuf(1:l),j
412              l = l+3
413             ENDIF
414            ENDDO
415            CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
416            WRITE(msgBuf,*) 'Fields:   ',
417         &                 (' ',diagSt_Flds(l,n),l=1,diagSt_nbFlds(n))
418            CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
419          ENDDO
420          WRITE(msgBuf,'(A)')
421       & '-----------------------------------------------------'       & '-----------------------------------------------------'
422        CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)        CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
423        WRITE(msgBuf,'(A)')        WRITE(msgBuf,'(A)')
Legend:
Removed from v.1.9  
changed lines
  Added in v.1.10
  ViewVC Help
Powered by ViewVC 1.1.22