/[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.6 by jmc, Thu Mar 17 01:22:43 2005 UTC revision 1.25 by jmc, Fri Jan 15 00:24:37 2010 UTC
# Line 20  C     !USES: Line 20  C     !USES:
20  #include "PARAMS.h"  #include "PARAMS.h"
21  #include "DIAGNOSTICS_SIZE.h"  #include "DIAGNOSTICS_SIZE.h"
22  #include "DIAGNOSTICS.h"  #include "DIAGNOSTICS.h"
23    #include "DIAGSTATS_REGIONS.h"
24    
25  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
26        INTEGER myThid        INTEGER myThid
27  CEOP  CEOP
28    
29  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
30  C     ldimLoc :: Max Number of Lists  C     ldimLoc :: Max Number of Lists  (in data.diagnostics)
31  C     kdimLoc :: Max Number of Levels  C     kdimLoc :: Max Number of Levels (in data.diagnostics)
32  C     fdimLoc :: Max Number of Fields  C     fdimLoc :: Max Number of Fields (in data.diagnostics)
33  C     frequency :: Frequency of Output (ouput every "frequency" iteration)  C     frequency :: Frequency (in s) of Output (ouput every "frequency" second)
34    C     timePhase :: phase (in s) within the "frequency" period to write output
35    C     averagingFreq  :: frequency (in s) for periodic averaging interval
36    C     averagingPhase :: phase     (in s) for periodic averaging interval
37    C     repeatCycle    :: number of averaging intervals in 1 cycle
38    C     mising_value     :: missing value for floats   in output
39    C     mising_value_int :: missing value for integers in output
40  C     levels    :: List Output Levels  C     levels    :: List Output Levels
41  C     fields    :: List Output Fields  C     fields    :: List Output Fields
42  C     filename  :: List Output Filename  C     filename  :: List Output Filename
43        INTEGER     ldimLoc, kdimLoc, fdimLoc  C--   for regional-statistics
44    C     set_regMask(n) :: region-mask set-index that define the region "n"
45    C     val_regMask(n) :: corresponding mask value of region "n" in the region-mask
46    C--   per level statistics output:
47    C     stat_freq   :: Frequency (in s) of statistics output
48    C     stat_phase  :: phase (in s) to write statistics output
49    C     stat_region :: List of statistics output Regions
50    C     stat_fields :: List of statistics output Fields
51    C     stat_fname  :: List of statistics output Filename
52          INTEGER     ldimLoc, kdimLoc, fdimLoc, rdimLoc
53        PARAMETER ( ldimLoc = 2*numlists )        PARAMETER ( ldimLoc = 2*numlists )
54        PARAMETER ( kdimLoc = 2*numLevels )        PARAMETER ( kdimLoc = 2*numLevels )
55        PARAMETER ( fdimLoc = 2*numperlist )        PARAMETER ( fdimLoc = 2*numperlist )
56        INTEGER     frequency(ldimLoc)        PARAMETER ( rdimLoc = nRegions+21 )
57          _RL         frequency(ldimLoc), timePhase(ldimLoc)
58          _RL         averagingFreq(ldimLoc), averagingPhase(ldimLoc)
59          INTEGER     repeatCycle(ldimLoc)
60          _RL         missing_value(ldimLoc)
61          INTEGER     missing_value_int(ldimLoc)
62        _RL         levels(kdimLoc,ldimLoc)        _RL         levels(kdimLoc,ldimLoc)
63          _RL         stat_freq(ldimLoc), stat_phase(ldimLoc)
64        CHARACTER*8 fields(fdimLoc,ldimLoc)        CHARACTER*8 fields(fdimLoc,ldimLoc)
65          CHARACTER*8 stat_fields(fdimLoc,ldimLoc)
66        CHARACTER*80 filename(ldimLoc), blkFilName        CHARACTER*80 filename(ldimLoc), blkFilName
67          CHARACTER*80 stat_fname(ldimLoc)
68          CHARACTER*8 fileflags(ldimLoc)
69        CHARACTER*8 blk8c        CHARACTER*8 blk8c
70        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
71          CHARACTER*12 suffix
72          INTEGER stat_region(rdimLoc,ldimLoc)
73          INTEGER set_regMask(rdimLoc)
74          _RS     val_regMask(rdimLoc)
75        INTEGER ku, stdUnit        INTEGER ku, stdUnit
76        INTEGER k,l,n,m,iL        INTEGER j,k,l,n,m,nf
77        _RL undef, getcon        INTEGER iLen, regionCount
78        INTEGER  ILNBLNK        INTEGER  ILNBLNK
79        EXTERNAL ILNBLNK        EXTERNAL ILNBLNK
80    
81        NAMELIST / diagnostics_list /  C--   full level output:
82       &     frequency, levels, fields, filename,        NAMELIST / DIAGNOSTICS_LIST /
83       &     diag_mnc,       &     frequency, timePhase,
84         &     averagingFreq, averagingPhase, repeatCycle,
85         &     missing_value, missing_value_int,
86         &     levels, fields, filename, fileflags,
87         &     dumpAtLast, diag_mnc,
88       &     diag_pickup_read,     diag_pickup_write,       &     diag_pickup_read,     diag_pickup_write,
89       &     diag_pickup_read_mnc, diag_pickup_write_mnc       &     diag_pickup_read_mnc, diag_pickup_write_mnc
90    
91    C--   per level statistics output:
92          NAMELIST / DIAG_STATIS_PARMS /
93         &     stat_freq, stat_phase, stat_region, stat_fields,
94         &     stat_fname, diagSt_mnc,
95         &     set_regMask, val_regMask,
96         &     diagSt_regMaskFile, nSetRegMskFile
97    
98  C     Initialize and Read Diagnostics Namelist  C     Initialize and Read Diagnostics Namelist
99        _BEGIN_MASTER(myThid)        _BEGIN_MASTER(myThid)
100    
       undef = getcon('UNDEF')  
101        blk8c  = '        '        blk8c  = '        '
102        DO k=1,LEN(blkFilName)        DO k=1,LEN(blkFilName)
103          blkFilName(k:k) = ' '          blkFilName(k:k) = ' '
104        ENDDO        ENDDO
105    
106        DO l = 1,ldimLoc        DO l = 1,ldimLoc
107          frequency(l) = 0          frequency(l)  = 0.
108          filename (l) = blkFilName          timePhase(l)  = UNSET_RL
109            averagingFreq(l) = 0.
110            averagingPhase(l)= 0.
111            repeatCycle(l)   = 0
112            filename(l)   = blkFilName
113            missing_value(l)     = UNSET_RL
114            missing_value_int(l) = UNSET_I
115            fileflags(l)  = blk8c
116          DO k = 1,kdimLoc          DO k = 1,kdimLoc
117            levels (k,l) = undef            levels(k,l) = UNSET_RL
118          ENDDO          ENDDO
119          DO m = 1,fdimLoc          DO m = 1,fdimLoc
120            fields (m,l) = blk8c            fields(m,l) = blk8c
121          ENDDO          ENDDO
122        ENDDO        ENDDO
123        diag_mnc = useMNC        settingDiags = .FALSE.
124          dumpAtLast   = .FALSE.
125          diag_mnc     = useMNC
126        diag_pickup_read      = .FALSE.        diag_pickup_read      = .FALSE.
127        diag_pickup_write     = .FALSE.        diag_pickup_write     = .FALSE.
128        diag_pickup_read_mnc  = .FALSE.        diag_pickup_read_mnc  = .FALSE.
129        diag_pickup_write_mnc = .FALSE.        diag_pickup_write_mnc = .FALSE.
130    
131        WRITE(msgBuf,'(A)')        diagSt_regMaskFile = ' '
132          nSetRegMskFile = 0
133          DO k = 1,rdimLoc
134            set_regMask(k) = 0
135            val_regMask(k) = 0.
136          ENDDO
137          DO l = 1,ldimLoc
138            stat_freq(l)  = 0.
139            stat_phase(l) = UNSET_RL
140            stat_fname(l) = blkFilName
141            DO k = 1,rdimLoc
142              stat_region(k,l) = UNSET_I
143            ENDDO
144            DO m = 1,fdimLoc
145              stat_fields(m,l) = blk8c
146            ENDDO
147          ENDDO
148    
149          WRITE(msgBuf,'(2A)')
150       &     ' DIAGNOSTICS_READPARMS: opening data.diagnostics'       &     ' DIAGNOSTICS_READPARMS: opening data.diagnostics'
151        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,SQUEEZE_RIGHT,1)        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,SQUEEZE_RIGHT,1)
152    
153        CALL OPEN_COPY_DATA_FILE('data.diagnostics',        CALL OPEN_COPY_DATA_FILE('data.diagnostics',
154       &     'DIAGNOSTICS_READPARMS', ku, myThid )       &     'DIAGNOSTICS_READPARMS', ku, myThid )
155    
156          WRITE(msgBuf,'(2A)') 'S/R DIAGNOSTICS_READPARMS,',
157         &     ' read namelist "diagnostics_list": start'
158          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
159         &                    SQUEEZE_RIGHT , 1)
160        READ  (ku,NML=diagnostics_list)        READ  (ku,NML=diagnostics_list)
161          WRITE(msgBuf,'(2A)') 'S/R DIAGNOSTICS_READPARMS,',
162         &     ' read namelist "diagnostics_list": OK'
163          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
164         &                    SQUEEZE_RIGHT , 1)
165    
166    C-    set default for statistics output according to the main flag
167          diag_mnc = diag_mnc .AND. useMNC
168          diagSt_mnc = diag_mnc
169    
170          WRITE(msgBuf,'(2A)') 'S/R DIAGNOSTICS_READPARMS,',
171         &     ' read namelist "DIAG_STATIS_PARMS": start'
172          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
173         &                    SQUEEZE_RIGHT , 1)
174          READ  (ku,NML=DIAG_STATIS_PARMS)
175          WRITE(msgBuf,'(2A)') 'S/R DIAGNOSTICS_READPARMS,',
176         &     ' read namelist "DIAG_STATIS_PARMS": OK'
177          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
178         &                    SQUEEZE_RIGHT , 1)
179    
180        CLOSE (ku)        CLOSE (ku)
181    
182  C     Initialise diag_choices common block  C     Initialise DIAG_SELECT common block (except pointers)
183        nlists = 0        nlists = 0
184        DO n = 1,numlists        DO n = 1,numlists
185          freq(n) = 0          freq(n) = 0.
186            phase(n) = 0.
187            averageFreq(n)  = 0.
188            averagePhase(n) = 0.
189            averageCycle(n) = 1
190          nlevels(n) = 0          nlevels(n) = 0
191          nfields(n) = 0          nfields(n) = 0
192          fnames(n) = blkFilName          fnames(n) = blkFilName
193            misvalFlt(n) = UNSET_RL
194            misvalInt(n) = UNSET_I
195          DO k = 1,numLevels          DO k = 1,numLevels
196            levs(k,n) = 0            levs(k,n) = 0
197          ENDDO          ENDDO
198          DO m = 1,numperlist          DO m = 1,numperlist
199            flds(m,n) = blk8c            flds(m,n) = blk8c
           jdiag(m,n) = 0  
200          ENDDO          ENDDO
201            fflags(n)   = blk8c
202        ENDDO        ENDDO
203    
204    C     useMNC is confusing (can be T at this point & turned off later, whereas
205    C     for all other pkgs, model stops if use${PKG}= T with #undef ALLOW_${PKG})
206    #ifndef ALLOW_MNC
207    C     Fix to avoid running without getting any output:
208          diag_mnc   = .FALSE.
209          diagSt_mnc = .FALSE.
210    #endif
211    
212  C     Fill Diagnostics Common Block with Namelist Info  C     Fill Diagnostics Common Block with Namelist Info
213        diag_mnc = diag_mnc .AND. useMNC        diagSt_mnc = diagSt_mnc .AND. useMNC
214        diag_mdsio = (.NOT. diag_mnc) .OR. outputTypesInclusive        diag_mdsio = (.NOT. diag_mnc) .OR. outputTypesInclusive
215        diag_pickup_read_mnc  = diag_pickup_read_mnc .AND. diag_mnc        diag_pickup_read_mnc  = diag_pickup_read_mnc .AND. diag_mnc
216        diag_pickup_write_mnc = diag_pickup_write_mnc .AND. diag_mnc        diag_pickup_write_mnc = diag_pickup_write_mnc .AND. diag_mnc
217        diag_pickup_read_mdsio  =        diag_pickup_read_mdsio  =
218       &     diag_pickup_read .AND. (.NOT. diag_pickup_read_mnc)       &     diag_pickup_read .AND. (.NOT. diag_pickup_read_mnc)
219        diag_pickup_write_mdsio = diag_pickup_write .AND.        diag_pickup_write_mdsio = diag_pickup_write .AND.
220       &     ((.NOT. diag_pickup_write_mnc) .OR. outputTypesInclusive)       &     ((.NOT. diag_pickup_write_mnc) .OR. outputTypesInclusive)
221          diagSt_ascii = (.NOT. diagSt_mnc) .OR. outputTypesInclusive
222    
223        DO l = 1,ldimLoc        DO l = 1,ldimLoc
224         iL = ILNBLNK(filename(l))         iLen = ILNBLNK(filename(l))
225         IF ( frequency(l).NE.0 .AND. iL.EQ.0 ) THEN  C-     Only lists with non-empty file name (iLen>0) are considered
226           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  
227           n = nlists + 1           n = nlists + 1
228           freq(n)    = frequency(l)           freq(n)    = frequency(l)
229             IF ( timePhase(l).NE. UNSET_RL ) THEN
230               phase(n) = timePhase(l)
231             ELSEIF ( frequency(l) .LT. 0. ) THEN
232               phase(n) = -0.5 _d 0 * frequency(l)
233             ENDIF
234             IF ( averagingFreq(l).GT.0. .AND. repeatCycle(l).GT.1 ) THEN
235               averageFreq(n)  = averagingFreq(l)
236               averagePhase(n) = averagingPhase(l)
237               averageCycle(n) = repeatCycle(l)
238             ELSEIF (averagingFreq(l).NE.0. .OR. repeatCycle(l).NE.0) THEN
239               WRITE(msgBuf,'(2A,F18.6,I4)') 'DIAGNOSTICS_READPARMS: ',
240         &       'unvalid Average-Freq & Cycle:',
241         &       averagingFreq(l), repeatCycle(l)
242               CALL PRINT_ERROR( msgBuf , myThid )
243               WRITE(msgBuf,'(2A,I4,2A)') 'DIAGNOSTICS_READPARMS: ',
244         &         ' for list l=', l, ', filename: ', filename(l)
245               CALL PRINT_ERROR( msgBuf , myThid )
246               STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
247             ELSEIF ( frequency(l) .EQ. 0. ) THEN
248               averageFreq(n)  = nTimeSteps*deltaTClock
249               averagePhase(n) = phase(n)
250             ELSEIF ( frequency(l) .GT. 0. ) THEN
251               averageFreq(n)  = frequency(l)
252               averagePhase(n) = phase(n)
253             ENDIF
254             IF ( missing_value(l) .NE. UNSET_RL )
255         &        misvalFlt(n) = missing_value(l)
256             IF ( missing_value_int(l) .NE. UNSET_I )
257         &        misvalInt(n) = missing_value_int(l)
258           fnames(n)  = filename (l)           fnames(n)  = filename (l)
259             fflags(n)  = fileflags(l)
260           nlevels(n) = 0           nlevels(n) = 0
261           IF ( levels(1,l).NE.undef ) THEN           IF ( levels(1,l).NE.UNSET_RL ) THEN
262             DO k=1,kdimLoc             DO k=1,kdimLoc
263               IF ( levels(k,l).NE.undef .AND.               IF ( levels(k,l).NE.UNSET_RL .AND.
264       &            nlevels(n).LT.numLevels ) THEN       &            nlevels(n).LT.numLevels ) THEN
265                 nlevels(n) = nlevels(n) + 1                 nlevels(n) = nlevels(n) + 1
266                 levs(nlevels(n),n) = levels(k,l)                 levs(nlevels(n),n) = levels(k,l)
267               ELSEIF ( levels(k,l).NE.undef ) THEN               ELSEIF ( levels(k,l).NE.UNSET_RL ) THEN
268                WRITE(msgBuf,'(2A,I3)') 'DIAGNOSTICS_READPARMS: ',                WRITE(msgBuf,'(2A,I4)') 'DIAGNOSTICS_READPARMS: ',
269       &         'Exceed Max.Num. of Levels numLevels=', numLevels       &         'Exceed Max.Num. of Levels numLevels=', numLevels
270                CALL PRINT_ERROR( msgBuf , myThid )                CALL PRINT_ERROR( msgBuf , myThid )
271                WRITE(msgBuf,'(2A,I3,A,F3.0)') 'DIAGNOSTICS_READPARMS: ',                WRITE(msgBuf,'(2A,I4,A,F8.0)') 'DIAGNOSTICS_READPARMS: ',
272       &         'when trying to add level(k=', k, ' )=', levels(k,l)       &         'when trying to add level(k=', k, ' )=', levels(k,l)
273                CALL PRINT_ERROR( msgBuf , myThid )                CALL PRINT_ERROR( msgBuf , myThid )
274                WRITE(msgBuf,'(2A,I3,2A)') 'DIAGNOSTICS_READPARMS: ',                WRITE(msgBuf,'(2A,I4,2A)') 'DIAGNOSTICS_READPARMS: ',
275       &         ' for list l=', l, ', filename: ', filename(l)       &         ' for list l=', l, ', filename: ', filename(l)
276                CALL PRINT_ERROR( msgBuf , myThid )                CALL PRINT_ERROR( msgBuf , myThid )
277                 STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'                STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
278               ENDIF               ENDIF
279             ENDDO             ENDDO
280           ELSE           ELSE
# Line 158  C-       will set levels later, once the Line 288  C-       will set levels later, once the
288               nfields(n) = nfields(n) + 1               nfields(n) = nfields(n) + 1
289               flds(nfields(n),n) = fields(m,l)               flds(nfields(n),n) = fields(m,l)
290             ELSEIF ( fields(m,l).NE.blk8c ) THEN             ELSEIF ( fields(m,l).NE.blk8c ) THEN
291               WRITE(msgBuf,'(2A,I3)') 'DIAGNOSTICS_READPARMS: ',               WRITE(msgBuf,'(2A,I4)') 'DIAGNOSTICS_READPARMS: ',
292       &        'Exceed Max.Num. of Fields/list numperlist=', numperlist       &        'Exceed Max.Num. of Fields/list numperlist=', numperlist
293               CALL PRINT_ERROR( msgBuf , myThid )               CALL PRINT_ERROR( msgBuf , myThid )
294               WRITE(msgBuf,'(2A,I3,3A,I3,2A)') 'DIAGNOSTICS_READPARMS: ',               WRITE(msgBuf,'(2A,I4,3A,I4,2A)') 'DIAGNOSTICS_READPARMS: ',
295       &        'when trying to add field (m=', m, ' ): ',fields(m,l)       &        'when trying to add field (m=', m, ' ): ',fields(m,l)
296               CALL PRINT_ERROR( msgBuf , myThid )               CALL PRINT_ERROR( msgBuf , myThid )
297               WRITE(msgBuf,'(2A,I3,2A)') 'DIAGNOSTICS_READPARMS: ',               WRITE(msgBuf,'(2A,I4,2A)') 'DIAGNOSTICS_READPARMS: ',
298       &        ' in list l=', l, ', filename: ', filename(l)       &        ' in list l=', l, ', filename: ', filename(l)
299               CALL PRINT_ERROR( msgBuf , myThid )               CALL PRINT_ERROR( msgBuf , myThid )
300               STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'               STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
# Line 172  C-       will set levels later, once the Line 302  C-       will set levels later, once the
302           ENDDO           ENDDO
303           nlists = nlists + 1           nlists = nlists + 1
304  c        write(6,*) 'list summary:',n,nfields(n),nlevels(n)  c        write(6,*) 'list summary:',n,nfields(n),nlevels(n)
305         ELSEIF ( frequency(l).NE.0 ) THEN         ELSEIF ( iLen.GE.1 ) THEN
306           WRITE(msgBuf,'(2A,I3)') 'DIAGNOSTICS_READPARMS: ',           WRITE(msgBuf,'(2A,I4)') 'DIAGNOSTICS_READPARMS: ',
307       &            'Exceed Max.Num. of list numlists=', numlists       &            'Exceed Max.Num. of list numlists=', numlists
308           CALL PRINT_ERROR( msgBuf , myThid )           CALL PRINT_ERROR( msgBuf , myThid )
309           WRITE(msgBuf,'(2A,I3)') 'DIAGNOSTICS_READPARMS: ',           WRITE(msgBuf,'(2A,I4)') 'DIAGNOSTICS_READPARMS: ',
310       &    'when trying to add list l=', l       &    'when trying to add list l=', l
311           CALL PRINT_ERROR( msgBuf , myThid )           CALL PRINT_ERROR( msgBuf , myThid )
312           WRITE(msgBuf,'(2A,I6,2A)') 'DIAGNOSTICS_READPARMS: ',           WRITE(msgBuf,'(2A,F18.6,2A)') 'DIAGNOSTICS_READPARMS: ',
313       &    ' Frq=', frequency(l), ', filename: ', filename(l)       &    ' Frq=', frequency(l), ', filename: ', filename(l)
314           CALL PRINT_ERROR( msgBuf , myThid )           CALL PRINT_ERROR( msgBuf , myThid )
315           STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'           STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
# Line 187  c        write(6,*) 'list summary:',n,nf Line 317  c        write(6,*) 'list summary:',n,nf
317        ENDDO        ENDDO
318    
319  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
320    
321    C-    Initialise DIAG_STATS_REGMASK common block (except the mask)
322          nSetRegMask = 0
323          DO j = 0,nRegions
324            diagSt_kRegMsk(j) = 0
325            diagSt_vRegMsk(j) = 0.
326          ENDDO
327    C     Global statistics (region # 0)
328          diagSt_kRegMsk(0) = 1
329    
330    C-    Initialise DIAG_STATIS common block (except pointers)
331          diagSt_nbLists = 0
332          DO n = 1,numlists
333            diagSt_freq(n) = 0.
334            diagSt_phase(n) = 0.
335            diagSt_nbFlds(n) = 0
336            diagSt_ioUnit(n) = 0
337            diagSt_Fname(n) = blkFilName
338            DO j = 0,nRegions
339              diagSt_region(j,n) = 0
340            ENDDO
341            DO m = 1,numperlist
342              diagSt_Flds(m,n) = blk8c
343            ENDDO
344          ENDDO
345    
346    C     Fill Diagnostics Common Block with Namelist Info
347          diagSt_ascii = (.NOT. diagSt_mnc) .OR. outputTypesInclusive
348    
349    C-    Region mask correspondence table:
350    C     note: this table should be build when regions are defined ;
351    C     for now, simpler just to read it from namelist in data.diagnostics
352          j = 0
353          DO k = 1,rdimLoc
354           IF ( set_regMask(k).NE.0 .OR. val_regMask(k).NE.0. ) THEN
355             j = j+1
356             IF ( j.LE.nRegions ) THEN
357               diagSt_kRegMsk(j) = set_regMask(k)
358               diagSt_vRegMsk(j) = val_regMask(k)
359             ENDIF
360           ENDIF
361          ENDDO
362          IF ( j.GT.nRegions ) THEN
363             WRITE(msgBuf,'(2A,I4,A)') 'DIAGNOSTICS_READPARMS: ',
364         &   'set_regMask & val_regMask lists assume at least',j,' regions'
365             CALL PRINT_ERROR( msgBuf , myThid )
366             WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_READPARMS: ',
367         &   'Need to increase "nRegions" in DIAGNOSTICS_SIZE.h'
368             CALL PRINT_ERROR( msgBuf , myThid )
369             STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
370          ENDIF
371    
372          DO l = 1,ldimLoc
373           iLen = ILNBLNK(stat_fname(l))
374    C-     Only lists with non-empty file name (iLen>0) are considered
375           IF ( iLen.GE.1 .AND. diagSt_nbLists.LT.numlists)THEN
376             n = diagSt_nbLists + 1
377             diagSt_freq(n) = stat_freq(l)
378             IF ( stat_phase(l).NE. UNSET_RL ) THEN
379               diagSt_phase(n) = stat_phase(l)
380             ELSEIF ( stat_freq(l) .LT. 0. ) THEN
381               diagSt_phase(n) = -0.5 _d 0 * stat_freq(l)
382             ENDIF
383             diagSt_Fname(n)  = stat_fname(l)
384             regionCount = 0
385             DO k=1,rdimLoc
386               j = stat_region(k,l)
387               IF ( j.NE.UNSET_I .AND. j.GE.0 .AND. j.LE.nRegions ) THEN
388                IF ( diagSt_region(j,n).EQ.0 ) THEN
389                 diagSt_region(j,n) = 1
390                 regionCount = regionCount + 1
391                ELSE
392                 WRITE(msgBuf,'(2A,I4,2A)')
393         &        'DIAGNOSTICS_READPARMS:',
394         &        ' in list l=', l, ', stat_fname: ', stat_fname(l)
395                 CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
396         &                           SQUEEZE_RIGHT , myThid )
397                 WRITE(msgBuf,'(A,I4,A)')
398         &        'DIAGNOSTICS_READPARMS: region=',j,
399         &        ' can only be selected once => ignore 2nd selection'
400                 CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
401         &                           SQUEEZE_RIGHT , myThid )
402                ENDIF
403               ELSEIF ( j.NE.UNSET_I ) THEN
404                 WRITE(msgBuf,'(A,I4,A,I4,2A)')
405         &       'DIAGNOSTICS_READPARMS: region=',j,
406         &         ' in list l=', l, ', stat_fname: ', stat_fname(l)
407                 CALL PRINT_ERROR( msgBuf , myThid )
408                 WRITE(msgBuf,'(2A,I4,A,I4,2A)')
409         &       'DIAGNOSTICS_READPARMS: ==> exceed Max.Nb of regions',
410         &       '(=',nRegions,' )'
411                 CALL PRINT_ERROR( msgBuf , myThid )
412                 STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
413               ENDIF
414             ENDDO
415             IF ( regionCount.EQ.0 ) THEN
416    C-       no region selected => default is Global statistics (region Id: 0)
417               diagSt_region(0,n) = 1
418             ENDIF
419             diagSt_nbFlds(n) = 0
420             DO m=1,fdimLoc
421               IF ( stat_fields(m,l).NE.blk8c .AND.
422         &          diagSt_nbFlds(n).LT.numperlist ) THEN
423                 diagSt_nbFlds(n) = diagSt_nbFlds(n) + 1
424                 diagSt_Flds(diagSt_nbFlds(n),n) = stat_fields(m,l)
425               ELSEIF ( stat_fields(m,l).NE.blk8c ) THEN
426                 WRITE(msgBuf,'(2A,I4)') 'DIAGNOSTICS_READPARMS: ',
427         &        'Exceed Max.Num. of Fields/list numperlist=', numperlist
428                 CALL PRINT_ERROR( msgBuf , myThid )
429                 WRITE(msgBuf,'(2A,I4,3A,I4,2A)') 'DIAGNOSTICS_READPARMS: ',
430         &        'when trying to add stat_field (m=', m,
431         &        ' ): ',stat_fields(m,l)
432                 CALL PRINT_ERROR( msgBuf , myThid )
433                 WRITE(msgBuf,'(2A,I4,2A)') 'DIAGNOSTICS_READPARMS: ',
434         &        ' in list l=', l, ', stat_fname: ', stat_fname(l)
435                 CALL PRINT_ERROR( msgBuf , myThid )
436                 STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
437               ENDIF
438             ENDDO
439             diagSt_nbLists = diagSt_nbLists + 1
440    c        write(6,*) 'stat-list summary:',n,diagSt_nbFlds(n),regionCount
441           ELSEIF ( iLen.GE.1 ) THEN
442             WRITE(msgBuf,'(2A,I4)') 'DIAGNOSTICS_READPARMS: ',
443         &            'Exceed Max.Num. of list numlists=', numlists
444             CALL PRINT_ERROR( msgBuf , myThid )
445             WRITE(msgBuf,'(2A,I4)') 'DIAGNOSTICS_READPARMS: ',
446         &    'when trying to add stat_list l=', l
447             CALL PRINT_ERROR( msgBuf , myThid )
448             WRITE(msgBuf,'(2A,F18.6,2A)') 'DIAGNOSTICS_READPARMS: ',
449         &    ' Frq=', stat_freq(l), ', stat_fname: ', stat_fname(l)
450             CALL PRINT_ERROR( msgBuf , myThid )
451             STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
452           ENDIF
453          ENDDO
454    
455    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
456  C     Echo History List Data Structure  C     Echo History List Data Structure
457        stdUnit = standardMessageUnit        stdUnit = standardMessageUnit
458        WRITE(msgBuf,'(A)')        WRITE(msgBuf,'(A)')
# Line 199  C     Echo History List Data Structure Line 465  C     Echo History List Data Structure
465       & '-----------------------------------------------------'       & '-----------------------------------------------------'
466        CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)        CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
467        DO n = 1,nlists        DO n = 1,nlists
468          WRITE(msgBuf,'(2a)') 'Creating Output Stream: ',fnames(n)          WRITE(msgBuf,'(2A)') 'Creating Output Stream: ', fnames(n)
469          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
470          WRITE(msgBuf,*) 'Frequency: ',freq(n)          WRITE(msgBuf,'(2(A,F18.6))') 'Output Frequency:', freq(n),
471         &                               ' ; Phase: ', phase(n)
472          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
473          IF ( nlevels(n).EQ.-1 ) THEN          WRITE(msgBuf,'(2(A,F18.6),A,I4)')
474         &    ' Averaging Freq.:', averageFreq(n),
475         &    ' , Phase: ', averagePhase(n), ' , Cycle:', averageCycle(n)
476            CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
477            IF ( fflags(n).EQ.blk8c ) THEN
478              WRITE(msgBuf,'(A,1PE20.12,A,I12,3A)')
479         &       ' missing value:',  misvalFlt(n),
480         &       ' ; for integers:', misvalInt(n)
481            ELSE
482              WRITE(msgBuf,'(A,1PE20.12,A,I12,3A)')
483         &       ' missing value:',  misvalFlt(n),
484         &       ' ; for integers:', misvalInt(n),
485         &       ' ; F-Flags="', fflags(n),'"'
486            ENDIF
487            CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
488            IF ( nlevels(n).EQ.-1 .AND. fflags(n)(2:2).EQ.'I' ) THEN
489              WRITE(msgBuf,'(A)') ' Cumulate all Levels (to be set later)'
490              CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
491            ELSEIF ( nlevels(n).EQ.-1 ) THEN
492            WRITE(msgBuf,'(A,A)') ' Levels:    ','will be set later'            WRITE(msgBuf,'(A,A)') ' Levels:    ','will be set later'
493            CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)            CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
494            ELSEIF ( fflags(n)(2:2).EQ.'P' ) THEN
495             DO l=1,nlevels(n),10
496              m = MIN(nlevels(n),l+9)
497              WRITE(msgBuf,'(A,1P10E10.3)')' interp:  ', (levs(k,n),k=l,m)
498              CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
499             ENDDO
500          ELSE          ELSE
501             suffix = ' Levels:    '
502             IF ( fflags(n)(2:2).EQ.'I' ) suffix = ' Sum Levels:'
503           DO l=1,nlevels(n),20           DO l=1,nlevels(n),20
504            m = MIN(nlevels(n),l+19)            m = MIN(nlevels(n),l+19)
505            WRITE(msgBuf,'(A,20F5.0)') ' Levels:    ', (levs(k,n),k=l,m)            WRITE(msgBuf,'(A,20F5.0)') suffix, (levs(k,n),k=l,m)
506            CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)            CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
507           ENDDO           ENDDO
508          ENDIF          ENDIF
509          WRITE(msgBuf,*) 'Fields:   ',(' ',flds(l,n),l=1,nfields(n))          DO nf = 1,nfields(n),10
510              m = MIN(nfields(n),nf+9)
511              WRITE(msgBuf,'(21A)') ' Fields:   ',(' ',flds(l,n),l=nf,m)
512              CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
513            ENDDO
514          ENDDO
515          WRITE(msgBuf,'(A)')
516         & '-----------------------------------------------------'
517          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
518          WRITE(msgBuf,'(A)')
519         &     ' DIAGNOSTICS_READPARMS: statistics diags. summary:'
520          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
521          DO n = 1,diagSt_nbLists
522            WRITE(msgBuf,'(2A)') 'Creating Stats. Output Stream: ',
523         &                       diagSt_Fname(n)
524            CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
525            WRITE(msgBuf,'(2(A,F18.6))') 'Output Frequency:',
526         &               diagSt_freq(n), ' ; Phase: ', diagSt_phase(n)
527          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
528            WRITE(msgBuf,'(A)') ' Regions: '
529            l = 10
530            DO j=0,nRegions
531             IF ( diagSt_region(j,n).GE.1 ) THEN
532              l = l+3
533              IF (l.LE.MAX_LEN_MBUF) WRITE(msgBuf(l-2:l),'(I3)') j
534             ENDIF
535            ENDDO
536            CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
537            DO nf = 1,diagSt_nbFlds(n),10
538              m = MIN(diagSt_nbFlds(n),nf+9)
539              WRITE(msgBuf,'(21A)') ' Fields:   ',
540         &                 (' ',diagSt_Flds(l,n),l=nf,m)
541              CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
542            ENDDO
543        ENDDO        ENDDO
544        WRITE(msgBuf,'(A)')        WRITE(msgBuf,'(A)')
545       & '-----------------------------------------------------'       & '-----------------------------------------------------'
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.25
  ViewVC Help
Powered by ViewVC 1.1.22