/[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.5 by edhill, Sun Feb 20 04:31:54 2005 UTC revision 1.44 by jmc, Sun Jul 23 00:42:28 2017 UTC
# Line 8  CBOP 0 Line 8  CBOP 0
8  C     !ROUTINE: DIAGNOSTICS_READPARMS  C     !ROUTINE: DIAGNOSTICS_READPARMS
9    
10  C     !INTERFACE:  C     !INTERFACE:
11        SUBROUTINE DIAGNOSTICS_READPARMS(myThid)        SUBROUTINE DIAGNOSTICS_READPARMS( myThid )
12    
13  C     !DESCRIPTION:  C     !DESCRIPTION:
14  C     Read Diagnostics Namelists to specify output sequence.  C     Read Diagnostics Namelists to specify output sequence.
# 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 "DIAGNOSTICS_CALC.h"
24    #include "DIAGSTATS_REGIONS.h"
25    
26  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
27        INTEGER myThid        INTEGER myThid
28  CEOP  CEOP
29    
30    C     !FUNCTIONS:
31          INTEGER  ILNBLNK
32          EXTERNAL ILNBLNK
33          CHARACTER*(8) DIAGS_RENAMED
34          EXTERNAL DIAGS_RENAMED
35    #ifdef ALLOW_FIZHI
36          _RL      getcon
37          EXTERNAL getcon
38    #endif
39    
40  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
41  C     ldimLoc :: Max Number of Lists  C     ldimLoc :: Max Number of Lists  (in data.diagnostics)
42  C     kdimLoc :: Max Number of Levels  C     kdimLoc :: Max Number of Levels (in data.diagnostics)
43  C     fdimLoc :: Max Number of Fields  C     fdimLoc :: Max Number of Fields (in data.diagnostics)
44  C     frequency :: Frequency of Output (ouput every "frequency" iteration)  C     frequency :: Frequency (in s) of Output (ouput every "frequency" second)
45    C     timePhase :: phase (in s) within the "frequency" period to write output
46    C     averagingFreq  :: frequency (in s) for periodic averaging interval
47    C     averagingPhase :: phase     (in s) for periodic averaging interval
48    C     repeatCycle    :: number of averaging intervals in 1 cycle
49    C     missing_value  :: missing value for real-type fields in output file
50    C     missing_value_int :: missing value for integers in output (not used)
51  C     levels    :: List Output Levels  C     levels    :: List Output Levels
52  C     fields    :: List Output Fields  C     fields    :: List Output Fields
53  C     filename  :: List Output Filename  C     fileName  :: List Output Filename
54        INTEGER     ldimLoc, kdimLoc, fdimLoc  C     fileFlags :: List Ouput file options (file precision, integral/interp.
55        PARAMETER ( ldimLoc = 2*numlists )  C                  vertically, hFac weighted option)
56    C--   for regional-statistics
57    C     set_regMask(n) :: region-mask set-index that define the region "n"
58    C     val_regMask(n) :: corresponding mask value of region "n" in the region-mask
59    C--   per level statistics output:
60    C     stat_freq   :: Frequency (in s) of statistics output
61    C     stat_phase  :: phase (in s) to write statistics output
62    C     stat_region :: List of statistics output Regions
63    C     stat_fields :: List of statistics output Fields
64    C     stat_fName  :: List of statistics output Filename
65          INTEGER     ldimLoc, kdimLoc, fdimLoc, rdimLoc
66          PARAMETER ( ldimLoc = 2*numLists )
67        PARAMETER ( kdimLoc = 2*numLevels )        PARAMETER ( kdimLoc = 2*numLevels )
68        PARAMETER ( fdimLoc = 2*numperlist )        PARAMETER ( fdimLoc = 2*numperList )
69        INTEGER     frequency(ldimLoc)        PARAMETER ( rdimLoc = nRegions+21 )
70          _RL         frequency(ldimLoc), timePhase(ldimLoc)
71          _RL         averagingFreq(ldimLoc), averagingPhase(ldimLoc)
72          INTEGER     repeatCycle(ldimLoc)
73          _RL         missing_value(ldimLoc)
74          INTEGER     missing_value_int(ldimLoc)
75        _RL         levels(kdimLoc,ldimLoc)        _RL         levels(kdimLoc,ldimLoc)
76          _RL         stat_freq(ldimLoc), stat_phase(ldimLoc)
77        CHARACTER*8 fields(fdimLoc,ldimLoc)        CHARACTER*8 fields(fdimLoc,ldimLoc)
78        CHARACTER*8 filename(ldimLoc)        CHARACTER*8 stat_fields(fdimLoc,ldimLoc)
79        CHARACTER*8 blk8c        CHARACTER*80 fileName(ldimLoc), blkFilName
80          CHARACTER*80 stat_fname(ldimLoc)
81          CHARACTER*8 fileFlags(ldimLoc)
82          CHARACTER*8 blk8c, diagName
83        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
84          CHARACTER*(MAX_LEN_FNAM) namBuf
85          CHARACTER*12 suffix
86          INTEGER stat_region(rdimLoc,ldimLoc)
87          INTEGER set_regMask(rdimLoc)
88          _RS     val_regMask(rdimLoc)
89        INTEGER ku, stdUnit        INTEGER ku, stdUnit
90        INTEGER k,l,n,m        INTEGER j,k,l,n,m,nf
91        _RL undef, getcon        INTEGER iLen, regionCount
92    
93        NAMELIST / diagnostics_list /  C--   full level output:
94       &     frequency, levels, fields, filename,        NAMELIST / DIAGNOSTICS_LIST /
95       &     diag_mnc,       &     frequency, timePhase,
96         &     averagingFreq, averagingPhase, repeatCycle,
97         &     missing_value, missing_value_int,
98         &     levels, fields, fileName, fileFlags,
99         &     dumpAtLast, diag_mnc, useMissingValue,
100         &     diagCG_maxIters, diagCG_resTarget,
101         &     diagCG_pcOffDFac, diagCG_prtResFrq, xPsi0, yPsi0,
102       &     diag_pickup_read,     diag_pickup_write,       &     diag_pickup_read,     diag_pickup_write,
103       &     diag_pickup_read_mnc, diag_pickup_write_mnc       &     diag_pickup_read_mnc, diag_pickup_write_mnc,
104         &     diagMdsDir, diagMdsDirCreate
105    
106    C--   per level statistics output:
107          NAMELIST / DIAG_STATIS_PARMS /
108         &     stat_freq, stat_phase, stat_region, stat_fields,
109         &     stat_fname, diagSt_mnc,
110         &     set_regMask, val_regMask,
111         &     diagSt_regMaskFile, nSetRegMskFile
112    
113          IF ( .NOT.useDiagnostics ) THEN
114    C-    pkg DIAGNOSTICS is not used
115            _BEGIN_MASTER(myThid)
116    C-    Track diagnostics pkg activation status:
117             diag_pkgStatus = -1
118    C     print a (weak) warning if data.diagnostics is found
119             CALL PACKAGES_UNUSED_MSG( 'useDiagnostics', ' ', ' ' )
120            _END_MASTER(myThid)
121            _BARRIER
122            RETURN
123          ENDIF
124    
125  C     Initialize and Read Diagnostics Namelist  C-    Initialize and Read Diagnostics Namelist
126        _BEGIN_MASTER(myThid)        _BEGIN_MASTER(myThid)
127    
       undef = getcon('UNDEF')  
128        blk8c  = '        '        blk8c  = '        '
129          DO k=1,LEN(blkFilName)
130            blkFilName(k:k) = ' '
131          ENDDO
132    
133        DO l = 1,ldimLoc        DO l = 1,ldimLoc
134          frequency(l) = 0          frequency(l)  = 0.
135            timePhase(l)  = UNSET_RL
136            averagingFreq(l) = 0.
137            averagingPhase(l)= 0.
138            repeatCycle(l)   = 0
139            fileName(l)   = blkFilName
140    C-    Cannot use model standard Unset value since this was used previously
141    C     as defaut missing value that one might want to recover;
142    C     Use instead the unlikely missing value of One for the Undef-missing-Val
143    c       missing_value(l)     = UNSET_RL
144            missing_value(l)     = oneRL
145            missing_value_int(l) = UNSET_I
146            fileFlags(l)  = blk8c
147          DO k = 1,kdimLoc          DO k = 1,kdimLoc
148            levels (k,l) = undef            levels(k,l) = UNSET_RL
149          ENDDO          ENDDO
150          DO m = 1,fdimLoc          DO m = 1,fdimLoc
151            fields (m,l) = blk8c            fields(m,l) = blkName
152          ENDDO          ENDDO
153        ENDDO        ENDDO
154        diag_mnc = useMNC        diagLoc_ioUnit = 0
155          dumpAtLast   = .FALSE.
156          diag_mnc     = useMNC
157          useMissingValue = .FALSE.
158        diag_pickup_read      = .FALSE.        diag_pickup_read      = .FALSE.
159        diag_pickup_write     = .FALSE.        diag_pickup_write     = .FALSE.
160        diag_pickup_read_mnc  = .FALSE.        diag_pickup_read_mnc  = .FALSE.
161        diag_pickup_write_mnc = .FALSE.        diag_pickup_write_mnc = .FALSE.
162          diagMdsDir = ' '
163          diagMdsDirCreate = .TRUE.
164    
165        WRITE(msgBuf,'(A)')        prtFirstCall     = .TRUE.
166          diagCG_maxIters  = cg2dMaxIters
167          diagCG_resTarget = cg2dTargetResidual
168          diagCG_prtResFrq = printResidualFreq
169          diagCG_pcOffDFac = 1.
170          IF ( cg2dpcOffDFac.GT.zeroRL )
171         &  diagCG_pcOffDFac = 0.25 _d 0 /( cg2dpcOffDFac*cg2dpcOffDFac )
172          xPsi0 = UNSET_RS
173          yPsi0 = UNSET_RS
174    
175          diagSt_regMaskFile = ' '
176          nSetRegMskFile = 0
177          DO k = 1,rdimLoc
178            set_regMask(k) = 0
179            val_regMask(k) = 0.
180          ENDDO
181          DO l = 1,ldimLoc
182            stat_freq(l)  = 0.
183            stat_phase(l) = UNSET_RL
184            stat_fname(l) = blkFilName
185            DO k = 1,rdimLoc
186              stat_region(k,l) = UNSET_I
187            ENDDO
188            DO m = 1,fdimLoc
189              stat_fields(m,l) = blkName
190            ENDDO
191          ENDDO
192    C-    Track diagnostics pkg activation status:
193          diag_pkgStatus = 1
194    
195          WRITE(msgBuf,'(2A)')
196       &     ' DIAGNOSTICS_READPARMS: opening data.diagnostics'       &     ' DIAGNOSTICS_READPARMS: opening data.diagnostics'
197        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,SQUEEZE_RIGHT,1)        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,SQUEEZE_RIGHT,1)
198    
199        CALL OPEN_COPY_DATA_FILE('data.diagnostics',        CALL OPEN_COPY_DATA_FILE('data.diagnostics',
200       &     'DIAGNOSTICS_READPARMS', ku, myThid )       &     'DIAGNOSTICS_READPARMS', ku, myThid )
201    
202          WRITE(msgBuf,'(2A)') 'S/R DIAGNOSTICS_READPARMS,',
203         &     ' read namelist "diagnostics_list": start'
204          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
205         &                    SQUEEZE_RIGHT , 1)
206        READ  (ku,NML=diagnostics_list)        READ  (ku,NML=diagnostics_list)
207          WRITE(msgBuf,'(2A)') 'S/R DIAGNOSTICS_READPARMS,',
208         &     ' read namelist "diagnostics_list": OK'
209          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
210         &                    SQUEEZE_RIGHT , 1)
211    
212    C-    set default for statistics output according to the main flag
213          diag_mnc = diag_mnc .AND. useMNC
214          diagSt_mnc = diag_mnc
215    
216          WRITE(msgBuf,'(2A)') 'S/R DIAGNOSTICS_READPARMS,',
217         &     ' read namelist "DIAG_STATIS_PARMS": start'
218          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
219         &                    SQUEEZE_RIGHT , 1)
220          READ  (ku,NML=DIAG_STATIS_PARMS)
221          WRITE(msgBuf,'(2A)') 'S/R DIAGNOSTICS_READPARMS,',
222         &     ' read namelist "DIAG_STATIS_PARMS": OK'
223          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
224         &                    SQUEEZE_RIGHT , 1)
225    
226        CLOSE (ku)        CLOSE (ku)
227    
228  C     Initialise diag_choices common block  C     Initialise DIAG_SELECT common block (except pointers)
229        nlists = 0        nlists = 0
230        DO n = 1,numlists        DO n = 1,numLists
231          freq(n) = 0          freq(n) = 0.
232            phase(n) = 0.
233            averageFreq(n)  = 0.
234            averagePhase(n) = 0.
235            averageCycle(n) = 1
236          nlevels(n) = 0          nlevels(n) = 0
237          nfields(n) = 0          nfields(n) = 0
238          fnames(n) = blk8c          fnames(n) = blkFilName
239    c       misValFlt(n) = UNSET_RL
240    c       misValInt(n) = UNSET_I
241            misValFlt(n) = -999. _d 0
242    #ifdef ALLOW_FIZHI
243            IF ( useFIZHI ) misValFlt(n) = getcon('UNDEF')
244    #endif
245          DO k = 1,numLevels          DO k = 1,numLevels
246            levs(k,n) = 0            levs(k,n) = 0
247          ENDDO          ENDDO
248          DO m = 1,numperlist          DO m = 1,numperList
249            flds(m,n) = '        '            flds(m,n) = blkName
           jdiag(m,n) = 0  
250          ENDDO          ENDDO
251            fflags(n)   = blk8c
252        ENDDO        ENDDO
253    
254    C     useMNC is confusing (can be T at this point & turned off later, whereas
255    C     for all other pkgs, model stops if use${PKG}= T with #undef ALLOW_${PKG})
256    #ifndef ALLOW_MNC
257    C     Fix to avoid running without getting any output:
258          diag_mnc   = .FALSE.
259          diagSt_mnc = .FALSE.
260    #endif
261    
262  C     Fill Diagnostics Common Block with Namelist Info  C     Fill Diagnostics Common Block with Namelist Info
263        diag_mnc = diag_mnc .AND. useMNC        diagSt_mnc = diagSt_mnc .AND. useMNC
264        diag_mdsio = (.NOT. diag_mnc) .OR. outputTypesInclusive        diag_mdsio = (.NOT. diag_mnc) .OR. outputTypesInclusive
265        diag_pickup_read_mnc  = diag_pickup_read_mnc .AND. diag_mnc        diag_pickup_read_mnc  = diag_pickup_read_mnc .AND. diag_mnc
266        diag_pickup_write_mnc = diag_pickup_write_mnc .AND. diag_mnc        diag_pickup_write_mnc = diag_pickup_write_mnc .AND. diag_mnc
267        diag_pickup_read_mdsio  =        diag_pickup_read_mdsio  =
268       &     diag_pickup_read .AND. (.NOT. diag_pickup_read_mnc)       &     diag_pickup_read .AND. (.NOT. diag_pickup_read_mnc)
269        diag_pickup_write_mdsio = diag_pickup_write .AND.        diag_pickup_write_mdsio = diag_pickup_write .AND.
270       &     ((.NOT. diag_pickup_write_mnc) .OR. outputTypesInclusive)       &     ((.NOT. diag_pickup_write_mnc) .OR. outputTypesInclusive)
271          diagSt_ascii = (.NOT. diagSt_mnc) .OR. outputTypesInclusive
272    
273    C     remove trailing "/":
274          iLen = ILNBLNK( diagMdsDir )
275          IF ( iLen.GE.2 ) THEN
276           IF ( diagMdsDir(iLen:iLen).EQ.'/' ) THEN
277             namBuf = diagMdsDir
278             WRITE(diagMdsDir,'(A)') namBuf(1:iLen-1)
279           ENDIF
280          ENDIF
281    
282        DO l = 1,ldimLoc        DO l = 1,ldimLoc
283         IF ( frequency(l).NE.0 .AND. nlists.LT.numlists ) THEN         iLen = ILNBLNK(fileName(l))
284    C-     Only lists with non-empty file name (iLen>0) are considered
285           IF ( iLen.GE.1 .AND. nlists.LT.numLists ) THEN
286           n = nlists + 1           n = nlists + 1
287           freq(n)    = frequency(l)           freq(n)    = frequency(l)
288           fnames(n)  = filename (l)           IF ( timePhase(l).NE. UNSET_RL ) THEN
289               phase(n) = timePhase(l)
290             ELSEIF ( frequency(l) .LT. 0. ) THEN
291               phase(n) = -0.5 _d 0 * frequency(l)
292             ENDIF
293             IF ( averagingFreq(l).GT.0. .AND. repeatCycle(l).GT.1 ) THEN
294               averageFreq(n)  = averagingFreq(l)
295               averagePhase(n) = averagingPhase(l)
296               averageCycle(n) = repeatCycle(l)
297             ELSEIF (averagingFreq(l).NE.0. .OR. repeatCycle(l).NE.0) THEN
298               WRITE(msgBuf,'(2A,F18.6,I4)') 'DIAGNOSTICS_READPARMS: ',
299         &       'unvalid Average-Freq & Cycle:',
300         &       averagingFreq(l), repeatCycle(l)
301               CALL PRINT_ERROR( msgBuf , myThid )
302               WRITE(msgBuf,'(2A,I4,2A)') 'DIAGNOSTICS_READPARMS: ',
303         &         ' for list l=', l, ', fileName: ', fileName(l)
304               CALL PRINT_ERROR( msgBuf , myThid )
305               STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
306             ELSEIF ( frequency(l) .EQ. 0. ) THEN
307               averageFreq(n)  = nTimeSteps*deltaTClock
308               averagePhase(n) = phase(n)
309             ELSEIF ( frequency(l) .GT. 0. ) THEN
310               averageFreq(n)  = frequency(l)
311               averagePhase(n) = phase(n)
312             ENDIF
313    c        IF ( missing_value(l) .NE. UNSET_RL )
314    c    &        misValFlt(n) = missing_value(l)
315    c        IF ( missing_value_int(l) .NE. UNSET_I )
316    c    &        misValInt(n) = missing_value_int(l)
317             IF ( missing_value(l) .NE. oneRL )
318         &        misValFlt(n) = missing_value(l)
319             fnames(n)  = fileName (l)
320             fflags(n)  = fileFlags(l)
321           nlevels(n) = 0           nlevels(n) = 0
322           IF ( levels(1,l).NE.undef ) THEN           IF ( levels(1,l).NE.UNSET_RL ) THEN
323             DO k=1,kdimLoc             DO k=1,kdimLoc
324               IF ( levels(k,l).NE.undef .AND.               IF ( levels(k,l).NE.UNSET_RL .AND.
325       &            nlevels(n).LT.numLevels ) THEN       &            nlevels(n).LT.numLevels ) THEN
326                 nlevels(n) = nlevels(n) + 1                 nlevels(n) = nlevels(n) + 1
327                 levs(nlevels(n),n) = levels(k,l)                 levs(nlevels(n),n) = levels(k,l)
328               ELSEIF ( levels(k,l).NE.undef ) THEN               ELSEIF ( levels(k,l).NE.UNSET_RL ) THEN
329                WRITE(msgBuf,'(2A,I3)') 'DIAGNOSTICS_READPARMS: ',                WRITE(msgBuf,'(2A,I4)') 'DIAGNOSTICS_READPARMS: ',
330       &         'Exceed Max.Num. of Levels numLevels=', numLevels       &         'Exceed Max.Num. of Levels numLevels=', numLevels
331                CALL PRINT_ERROR( msgBuf , myThid )                CALL PRINT_ERROR( msgBuf , myThid )
332                WRITE(msgBuf,'(2A,I3,A,F3.0)') 'DIAGNOSTICS_READPARMS: ',                WRITE(msgBuf,'(2A,I4,A,F8.0)') 'DIAGNOSTICS_READPARMS: ',
333       &         'when trying to add level(k=', k, ' )=', levels(k,l)       &         'when trying to add level(k=', k, ' )=', levels(k,l)
334                CALL PRINT_ERROR( msgBuf , myThid )                CALL PRINT_ERROR( msgBuf , myThid )
335                WRITE(msgBuf,'(2A,I3,2A)') 'DIAGNOSTICS_READPARMS: ',                WRITE(msgBuf,'(2A,I4,2A)') 'DIAGNOSTICS_READPARMS: ',
336       &         ' for list l=', l, ', filename: ', filename(l)       &         ' for list l=', l, ', fileName: ', fileName(l)
337                CALL PRINT_ERROR( msgBuf , myThid )                CALL PRINT_ERROR( msgBuf , myThid )
338                 STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'                STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
339               ENDIF               ENDIF
340             ENDDO             ENDDO
341           ELSE           ELSE
# Line 140  C-       will set levels later, once the Line 344  C-       will set levels later, once the
344           ENDIF           ENDIF
345           nfields(n) = 0           nfields(n) = 0
346           DO m=1,fdimLoc           DO m=1,fdimLoc
347             IF ( fields(m,l).NE.blk8c .AND.             diagName = DIAGS_RENAMED( fields(m,l), myThid )
348       &          nfields(n).LT.numperlist ) THEN             IF ( diagName.NE.blkName .AND.
349         &          nfields(n).LT.numperList ) THEN
350               nfields(n) = nfields(n) + 1               nfields(n) = nfields(n) + 1
351               flds(nfields(n),n) = fields(m,l)               flds(nfields(n),n) = diagName
352             ELSEIF ( fields(m,l).NE.blk8c ) THEN             ELSEIF ( diagName.NE.blkName ) THEN
353               WRITE(msgBuf,'(2A,I3)') 'DIAGNOSTICS_READPARMS: ',               WRITE(msgBuf,'(2A,I4)') 'DIAGNOSTICS_READPARMS: ',
354       &        'Exceed Max.Num. of Fields/list numperlist=', numperlist       &        'Exceed Max.Num. of Fields/list numperList=', numperList
355               CALL PRINT_ERROR( msgBuf , myThid )               CALL PRINT_ERROR( msgBuf , myThid )
356               WRITE(msgBuf,'(2A,I3,3A,I3,2A)') 'DIAGNOSTICS_READPARMS: ',               WRITE(msgBuf,'(2A,I4,3A,I4,2A)') 'DIAGNOSTICS_READPARMS: ',
357       &        'when trying to add field (m=', m, ' ): ',fields(m,l)       &        'when trying to add field (m=', m, ' ): ', diagName
358               CALL PRINT_ERROR( msgBuf , myThid )               CALL PRINT_ERROR( msgBuf , myThid )
359               WRITE(msgBuf,'(2A,I3,2A)') 'DIAGNOSTICS_READPARMS: ',               WRITE(msgBuf,'(2A,I4,2A)') 'DIAGNOSTICS_READPARMS: ',
360       &        ' in list l=', l, ', filename: ', filename(l)       &        ' in list l=', l, ', fileName: ', fileName(l)
361               CALL PRINT_ERROR( msgBuf , myThid )               CALL PRINT_ERROR( msgBuf , myThid )
362               STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'               STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
363             ENDIF             ENDIF
364           ENDDO           ENDDO
365           nlists = nlists + 1           nlists = nlists + 1
366  c        write(6,*) 'list summary:',n,nfields(n),nlevels(n)  c        write(6,*) 'list summary:',n,nfields(n),nlevels(n)
367         ELSEIF ( frequency(l).NE.0 ) THEN         ELSEIF ( iLen.GE.1 ) THEN
368           WRITE(msgBuf,'(2A,I3)') 'DIAGNOSTICS_READPARMS: ',           WRITE(msgBuf,'(2A,I4)') 'DIAGNOSTICS_READPARMS: ',
369       &            'Exceed Max.Num. of list numlists=', numlists       &            'Exceed Max.Num. of list numLists=', numLists
370           CALL PRINT_ERROR( msgBuf , myThid )           CALL PRINT_ERROR( msgBuf , myThid )
371           WRITE(msgBuf,'(2A,I3)') 'DIAGNOSTICS_READPARMS: ',           WRITE(msgBuf,'(2A,I4)') 'DIAGNOSTICS_READPARMS: ',
372       &    'when trying to add list l=', l       &    'when trying to add list l=', l
373           CALL PRINT_ERROR( msgBuf , myThid )           CALL PRINT_ERROR( msgBuf , myThid )
374           WRITE(msgBuf,'(2A,I6,2A)') 'DIAGNOSTICS_READPARMS: ',           WRITE(msgBuf,'(2A,F18.6,2A)') 'DIAGNOSTICS_READPARMS: ',
375       &    ' Frq=', frequency(l), ', filename: ', filename(l)       &    ' Frq=', frequency(l), ', fileName: ', fileName(l)
376             CALL PRINT_ERROR( msgBuf , myThid )
377             STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
378           ENDIF
379          ENDDO
380    
381    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
382    
383    C-    Initialise DIAG_STATS_REGMASK common block (except the mask)
384          nSetRegMask = 0
385          DO j = 0,nRegions
386            diagSt_kRegMsk(j) = 0
387            diagSt_vRegMsk(j) = 0.
388          ENDDO
389    C     Global statistics (region # 0)
390          diagSt_kRegMsk(0) = 1
391    
392    C-    Initialise DIAG_STATIS common block (except pointers)
393          diagSt_nbLists = 0
394          DO n = 1,numLists
395            diagSt_freq(n) = 0.
396            diagSt_phase(n) = 0.
397            diagSt_nbFlds(n) = 0
398            diagSt_ioUnit(n) = 0
399            diagSt_Fname(n) = blkFilName
400            DO j = 0,nRegions
401              diagSt_region(j,n) = 0
402            ENDDO
403            DO m = 1,numperList
404              diagSt_Flds(m,n) = blkName
405            ENDDO
406          ENDDO
407    
408    C     Fill Diagnostics Common Block with Namelist Info
409          diagSt_ascii = (.NOT. diagSt_mnc) .OR. outputTypesInclusive
410    
411    C-    Region mask correspondence table:
412    C     note: this table should be build when regions are defined ;
413    C     for now, simpler just to read it from namelist in data.diagnostics
414          j = 0
415          DO k = 1,rdimLoc
416           IF ( set_regMask(k).NE.0 .OR. val_regMask(k).NE.0. ) THEN
417             j = j+1
418             IF ( j.LE.nRegions ) THEN
419               diagSt_kRegMsk(j) = set_regMask(k)
420               diagSt_vRegMsk(j) = val_regMask(k)
421             ENDIF
422           ENDIF
423          ENDDO
424          IF ( j.GT.nRegions ) THEN
425             WRITE(msgBuf,'(2A,I4,A)') 'DIAGNOSTICS_READPARMS: ',
426         &   'set_regMask & val_regMask lists assume at least',j,' regions'
427             CALL PRINT_ERROR( msgBuf , myThid )
428             WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_READPARMS: ',
429         &   'Need to increase "nRegions" in DIAGNOSTICS_SIZE.h'
430             CALL PRINT_ERROR( msgBuf , myThid )
431             STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
432          ENDIF
433    
434          DO l = 1,ldimLoc
435           iLen = ILNBLNK(stat_fname(l))
436    C-     Only lists with non-empty file name (iLen>0) are considered
437           IF ( iLen.GE.1 .AND. diagSt_nbLists.LT.numLists)THEN
438             n = diagSt_nbLists + 1
439             diagSt_freq(n) = stat_freq(l)
440             IF ( stat_phase(l).NE. UNSET_RL ) THEN
441               diagSt_phase(n) = stat_phase(l)
442             ELSEIF ( stat_freq(l) .LT. 0. ) THEN
443               diagSt_phase(n) = -0.5 _d 0 * stat_freq(l)
444             ENDIF
445             diagSt_Fname(n)  = stat_fname(l)
446             regionCount = 0
447             DO k=1,rdimLoc
448               j = stat_region(k,l)
449               IF ( j.NE.UNSET_I .AND. j.GE.0 .AND. j.LE.nRegions ) THEN
450                IF ( diagSt_region(j,n).EQ.0 ) THEN
451                 diagSt_region(j,n) = 1
452                 regionCount = regionCount + 1
453                ELSE
454                 WRITE(msgBuf,'(2A,I4,2A)')
455         &        'DIAGNOSTICS_READPARMS:',
456         &        ' in list l=', l, ', stat_fname: ', stat_fname(l)
457                 CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
458         &                           SQUEEZE_RIGHT , myThid )
459                 WRITE(msgBuf,'(A,I4,A)')
460         &        'DIAGNOSTICS_READPARMS: region=',j,
461         &        ' can only be selected once => ignore 2nd selection'
462                 CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
463         &                           SQUEEZE_RIGHT , myThid )
464                ENDIF
465               ELSEIF ( j.NE.UNSET_I ) THEN
466                 WRITE(msgBuf,'(A,I4,A,I4,2A)')
467         &       'DIAGNOSTICS_READPARMS: region=',j,
468         &         ' in list l=', l, ', stat_fname: ', stat_fname(l)
469                 CALL PRINT_ERROR( msgBuf , myThid )
470                 WRITE(msgBuf,'(2A,I4,A,I4,2A)')
471         &       'DIAGNOSTICS_READPARMS: ==> exceed Max.Nb of regions',
472         &       '(=',nRegions,' )'
473                 CALL PRINT_ERROR( msgBuf , myThid )
474                 STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
475               ENDIF
476             ENDDO
477             IF ( regionCount.EQ.0 ) THEN
478    C-       no region selected => default is Global statistics (region Id: 0)
479               diagSt_region(0,n) = 1
480             ENDIF
481             diagSt_nbFlds(n) = 0
482             DO m=1,fdimLoc
483               diagName = DIAGS_RENAMED( stat_fields(m,l), myThid )
484               IF ( diagName.NE.blkName .AND.
485         &          diagSt_nbFlds(n).LT.numperList ) THEN
486                 diagSt_nbFlds(n) = diagSt_nbFlds(n) + 1
487                 diagSt_Flds(diagSt_nbFlds(n),n) = diagName
488               ELSEIF ( diagName.NE.blkName ) THEN
489                 WRITE(msgBuf,'(2A,I4)') 'DIAGNOSTICS_READPARMS: ',
490         &        'Exceed Max.Num. of Fields/list numperList=', numperList
491                 CALL PRINT_ERROR( msgBuf , myThid )
492                 WRITE(msgBuf,'(2A,I4,3A,I4,2A)') 'DIAGNOSTICS_READPARMS: ',
493         &        'when trying to add stat_field (m=', m, ' ): ', diagName
494                 CALL PRINT_ERROR( msgBuf , myThid )
495                 WRITE(msgBuf,'(2A,I4,2A)') 'DIAGNOSTICS_READPARMS: ',
496         &        ' in list l=', l, ', stat_fname: ', stat_fname(l)
497                 CALL PRINT_ERROR( msgBuf , myThid )
498                 STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
499               ENDIF
500             ENDDO
501             diagSt_nbLists = diagSt_nbLists + 1
502    c        write(6,*) 'stat-list summary:',n,diagSt_nbFlds(n),regionCount
503           ELSEIF ( iLen.GE.1 ) THEN
504             WRITE(msgBuf,'(2A,I4)') 'DIAGNOSTICS_READPARMS: ',
505         &            'Exceed Max.Num. of list numLists=', numLists
506             CALL PRINT_ERROR( msgBuf , myThid )
507             WRITE(msgBuf,'(2A,I4)') 'DIAGNOSTICS_READPARMS: ',
508         &    'when trying to add stat_list l=', l
509             CALL PRINT_ERROR( msgBuf , myThid )
510             WRITE(msgBuf,'(2A,F18.6,2A)') 'DIAGNOSTICS_READPARMS: ',
511         &    ' Frq=', stat_freq(l), ', stat_fname: ', stat_fname(l)
512           CALL PRINT_ERROR( msgBuf , myThid )           CALL PRINT_ERROR( msgBuf , myThid )
513           STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'           STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
514         ENDIF         ENDIF
# Line 177  C---+----1----+----2----+----3----+----4 Line 518  C---+----1----+----2----+----3----+----4
518  C     Echo History List Data Structure  C     Echo History List Data Structure
519        stdUnit = standardMessageUnit        stdUnit = standardMessageUnit
520        WRITE(msgBuf,'(A)')        WRITE(msgBuf,'(A)')
521         &     ' DIAGNOSTICS_READPARMS: global parameter summary:'
522          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
523          CALL WRITE_0D_L( dumpAtLast, INDEX_NONE,
524         & ' dumpAtLast =',' /* always write time-ave diags at the end */')
525          CALL WRITE_0D_L( diag_mnc,   INDEX_NONE,
526         & ' diag_mnc =', '   /* write NetCDF output files */')
527          IF ( diag_mdsio.AND.(diagMdsDir.NE.' ') ) THEN
528           CALL WRITE_0D_C( diagMdsDir, -1, INDEX_NONE,
529         & ' diagMdsDir =', ' /* directory for mds diagnostics output */')
530           CALL WRITE_0D_L( diagMdsDirCreate, INDEX_NONE,
531         & ' diagMdsDirCreate =', ' /* call mkdir to create diagMdsDir */')
532          ENDIF
533          CALL WRITE_0D_L( useMissingValue, INDEX_NONE,
534         & ' useMissingValue =', ' /* put MissingValue where mask = 0 */')
535          CALL WRITE_0D_I( diagCG_maxIters, INDEX_NONE,
536         & ' diagCG_maxIters =', ' /* max number of iters in diag_cg2d */')
537          CALL WRITE_0D_RL( diagCG_resTarget, INDEX_NONE,
538         & ' diagCG_resTarget =', ' /* residual target for diag_cg2d */')
539          CALL WRITE_0D_RL( diagCG_pcOffDFac, INDEX_NONE,
540         & ' diagCG_pcOffDFac =',
541         & ' /* preconditioner off-diagonal factor */')
542          WRITE(msgBuf,'(A)')
543       & '-----------------------------------------------------'       & '-----------------------------------------------------'
544        CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)        CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
545        WRITE(msgBuf,'(A)')        WRITE(msgBuf,'(A)')
# Line 186  C     Echo History List Data Structure Line 549  C     Echo History List Data Structure
549       & '-----------------------------------------------------'       & '-----------------------------------------------------'
550        CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)        CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
551        DO n = 1,nlists        DO n = 1,nlists
552          WRITE(msgBuf,'(2a)') 'Creating Output Stream: ',fnames(n)          WRITE(msgBuf,'(2A)') 'Creating Output Stream: ', fnames(n)
553            CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
554            WRITE(msgBuf,'(2(A,F18.6))') 'Output Frequency:', freq(n),
555         &                               ' ; Phase: ', phase(n)
556          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
557          WRITE(msgBuf,*) 'Frequency: ',freq(n)          WRITE(msgBuf,'(2(A,F18.6),A,I4)')
558         &    ' Averaging Freq.:', averageFreq(n),
559         &    ' , Phase: ', averagePhase(n), ' , Cycle:', averageCycle(n)
560          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
561          IF ( nlevels(n).EQ.-1 ) THEN          IF ( fflags(n).EQ.blk8c ) THEN
562    c         WRITE(msgBuf,'(A,1PE20.12,A,I12,3A)')
563    c    &       ' missing value:',  misValFlt(n),
564    c    &       ' ; for integers:', misValInt(n)
565              WRITE(msgBuf,'(A,1PE20.12,3A)')
566         &       ' missing value:', misValFlt(n)
567            ELSE
568    c         WRITE(msgBuf,'(A,1PE20.12,A,I12,3A)')
569    c    &       ' missing value:',  misValFlt(n),
570    c    &       ' ; for integers:', misValInt(n),
571    c    &       ' ; F-Flags="', fflags(n),'"'
572              WRITE(msgBuf,'(A,1PE20.12,3A)')
573         &       ' missing value:', misValFlt(n),
574         &       ' ; F-Flags="', fflags(n),'"'
575            ENDIF
576            CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
577            IF ( nlevels(n).EQ.-1 .AND. fflags(n)(2:2).EQ.'I' ) THEN
578              WRITE(msgBuf,'(A)') ' Cumulate all Levels (to be set later)'
579              CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
580            ELSEIF ( nlevels(n).EQ.-1 ) THEN
581            WRITE(msgBuf,'(A,A)') ' Levels:    ','will be set later'            WRITE(msgBuf,'(A,A)') ' Levels:    ','will be set later'
582            CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)            CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
583            ELSEIF ( fflags(n)(2:2).EQ.'P' ) THEN
584             DO l=1,nlevels(n),10
585              m = MIN(nlevels(n),l+9)
586              WRITE(msgBuf,'(A,1P10E10.3)')' interp:  ', (levs(k,n),k=l,m)
587              CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
588             ENDDO
589          ELSE          ELSE
590             suffix = ' Levels:    '
591             IF ( fflags(n)(2:2).EQ.'I' ) suffix = ' Sum Levels:'
592           DO l=1,nlevels(n),20           DO l=1,nlevels(n),20
593            m = MIN(nlevels(n),l+19)            m = MIN(nlevels(n),l+19)
594            WRITE(msgBuf,'(A,20F5.0)') ' Levels:    ', (levs(k,n),k=l,m)            WRITE(msgBuf,'(A,20F5.0)') suffix, (levs(k,n),k=l,m)
595            CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)            CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
596           ENDDO           ENDDO
597          ENDIF          ENDIF
598          WRITE(msgBuf,*) 'Fields:   ',(' ',flds(l,n),l=1,nfields(n))          DO nf = 1,nfields(n),10
599              m = MIN(nfields(n),nf+9)
600              WRITE(msgBuf,'(21A)') ' Fields:   ',(' ',flds(l,n),l=nf,m)
601              CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
602            ENDDO
603          ENDDO
604          WRITE(msgBuf,'(A)')
605         & '-----------------------------------------------------'
606          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
607          WRITE(msgBuf,'(A)')
608         &     ' DIAGNOSTICS_READPARMS: statistics diags. summary:'
609          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
610          DO n = 1,diagSt_nbLists
611            WRITE(msgBuf,'(2A)') 'Creating Stats. Output Stream: ',
612         &                       diagSt_Fname(n)
613            CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
614            WRITE(msgBuf,'(2(A,F18.6))') 'Output Frequency:',
615         &               diagSt_freq(n), ' ; Phase: ', diagSt_phase(n)
616            CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
617            WRITE(msgBuf,'(A)') ' Regions: '
618            l = 10
619            DO j=0,nRegions
620             IF ( diagSt_region(j,n).GE.1 ) THEN
621              l = l+3
622              IF (l.LE.MAX_LEN_MBUF) WRITE(msgBuf(l-2:l),'(I3)') j
623             ENDIF
624            ENDDO
625          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
626            DO nf = 1,diagSt_nbFlds(n),10
627              m = MIN(diagSt_nbFlds(n),nf+9)
628              WRITE(msgBuf,'(21A)') ' Fields:   ',
629         &                 (' ',diagSt_Flds(l,n),l=nf,m)
630              CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
631            ENDDO
632        ENDDO        ENDDO
633        WRITE(msgBuf,'(A)')        WRITE(msgBuf,'(A)')
634       & '-----------------------------------------------------'       & '-----------------------------------------------------'
# Line 211  C     Echo History List Data Structure Line 638  C     Echo History List Data Structure
638    
639        _END_MASTER(myThid)        _END_MASTER(myThid)
640    
641    C--   Everyone else must wait for the parameters to be loaded
642          _BARRIER
643    
644        RETURN        RETURN
645        END        END
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.44
  ViewVC Help
Powered by ViewVC 1.1.22