Back to home page

MITgcm
 
 

    

File indexing completed on 2024-05-11 05:10:23 UTC

view on githubraw file Latest commit 41c4545f on 2024-05-10 15:00:41 UTC
09ceb40cd6 Jean*0001 #include "DIAG_OPTIONS.h"
                0002 
                0003 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0004 CBOP 0
                0005 C     !ROUTINE: DIAGNOSTICS_READPARMS
                0006 
                0007 C     !INTERFACE:
d1df35cad1 Jean*0008       SUBROUTINE DIAGNOSTICS_READPARMS( myThid )
09ceb40cd6 Jean*0009 
                0010 C     !DESCRIPTION:
                0011 C     Read Diagnostics Namelists to specify output sequence.
7e2f6e329a Jean*0012 
09ceb40cd6 Jean*0013 C     !USES:
                0014       IMPLICIT NONE
                0015 #include "SIZE.h"
                0016 #include "EEPARAMS.h"
                0017 #include "PARAMS.h"
                0018 #include "DIAGNOSTICS_SIZE.h"
41c4545f8f Jean*0019 #include "DIAGNOSTICS_P2SHARE.h"
09ceb40cd6 Jean*0020 #include "DIAGNOSTICS.h"
c19aee9e8e Jean*0021 #include "DIAGNOSTICS_CALC.h"
67d6b2434f Jean*0022 #include "DIAGSTATS_REGIONS.h"
09ceb40cd6 Jean*0023 
                0024 C     !INPUT PARAMETERS:
                0025       INTEGER myThid
                0026 CEOP
                0027 
ace73a8de7 Jean*0028 C     !FUNCTIONS:
                0029       INTEGER  ILNBLNK
                0030       EXTERNAL ILNBLNK
3dcfb9510a Jean*0031       CHARACTER*(8) DIAGS_RENAMED
                0032       EXTERNAL DIAGS_RENAMED
ace73a8de7 Jean*0033 #ifdef ALLOW_FIZHI
                0034       _RL      getcon
                0035       EXTERNAL getcon
                0036 #endif
                0037 
09ceb40cd6 Jean*0038 C     !LOCAL VARIABLES:
67d6b2434f Jean*0039 C     ldimLoc :: Max Number of Lists  (in data.diagnostics)
                0040 C     kdimLoc :: Max Number of Levels (in data.diagnostics)
                0041 C     fdimLoc :: Max Number of Fields (in data.diagnostics)
3e5de6a370 Jean*0042 C     frequency :: Frequency (in s) of Output (ouput every "frequency" second)
                0043 C     timePhase :: phase (in s) within the "frequency" period to write output
666b944083 Jean*0044 C     averagingFreq  :: frequency (in s) for periodic averaging interval
                0045 C     averagingPhase :: phase     (in s) for periodic averaging interval
                0046 C     repeatCycle    :: number of averaging intervals in 1 cycle
ca10285501 Jean*0047 C     missing_value  :: missing value for real-type fields in output file
ace73a8de7 Jean*0048 C     missing_value_int :: missing value for integers in output (not used)
09ceb40cd6 Jean*0049 C     levels    :: List Output Levels
                0050 C     fields    :: List Output Fields
ca10285501 Jean*0051 C     fileName  :: List Output Filename
67d6b2434f Jean*0052 C--   for regional-statistics
02e1437ea2 Jean*0053 C     set_regMask(n) :: region-mask set-index that define the region "n"
67d6b2434f Jean*0054 C     val_regMask(n) :: corresponding mask value of region "n" in the region-mask
3e5de6a370 Jean*0055 C--   per level statistics output:
3ae5f90260 Jean*0056 C     stat_freq   :: Frequency (in s) of statistics output
3e5de6a370 Jean*0057 C     stat_phase  :: phase (in s) to write statistics output
                0058 C     stat_region :: List of statistics output Regions
                0059 C     stat_fields :: List of statistics output Fields
ca10285501 Jean*0060 C     stat_fName  :: List of statistics output Filename
3e5de6a370 Jean*0061       INTEGER     ldimLoc, kdimLoc, fdimLoc, rdimLoc
866f99417e Jean*0062       PARAMETER ( ldimLoc = 2*numLists )
09ceb40cd6 Jean*0063       PARAMETER ( kdimLoc = 2*numLevels )
866f99417e Jean*0064       PARAMETER ( fdimLoc = 2*numperList )
67d6b2434f Jean*0065       PARAMETER ( rdimLoc = nRegions+21 )
509dcf5e56 Jean*0066       _RL         frequency(ldimLoc), timePhase(ldimLoc)
666b944083 Jean*0067       _RL         averagingFreq(ldimLoc), averagingPhase(ldimLoc)
                0068       INTEGER     repeatCycle(ldimLoc)
d9c7a3ba4b Mart*0069       _RL         missing_value(ldimLoc)
                0070       INTEGER     missing_value_int(ldimLoc)
09ceb40cd6 Jean*0071       _RL         levels(kdimLoc,ldimLoc)
3e5de6a370 Jean*0072       _RL         stat_freq(ldimLoc), stat_phase(ldimLoc)
09ceb40cd6 Jean*0073       CHARACTER*8 fields(fdimLoc,ldimLoc)
3e5de6a370 Jean*0074       CHARACTER*8 stat_fields(fdimLoc,ldimLoc)
ca10285501 Jean*0075       CHARACTER*80 fileName(ldimLoc), blkFilName
a5ec81ed49 Timo*0076       CHARACTER*80 stat_fName(ldimLoc)
ca10285501 Jean*0077       CHARACTER*8 fileFlags(ldimLoc)
3dcfb9510a Jean*0078       CHARACTER*8 blk8c, diagName
09ceb40cd6 Jean*0079       CHARACTER*(MAX_LEN_MBUF) msgBuf
0a7965a6c6 Jean*0080       CHARACTER*(MAX_LEN_FNAM) namBuf
5f837b700f Jean*0081       CHARACTER*12 suffix
3e5de6a370 Jean*0082       INTEGER stat_region(rdimLoc,ldimLoc)
02e1437ea2 Jean*0083       INTEGER set_regMask(rdimLoc)
67d6b2434f Jean*0084       _RS     val_regMask(rdimLoc)
09ceb40cd6 Jean*0085       INTEGER ku, stdUnit
9dd4311c0c Andr*0086       INTEGER j,k,l,n,m,nf
3ae5f90260 Jean*0087       INTEGER iLen, regionCount
09ceb40cd6 Jean*0088 
3e5de6a370 Jean*0089 C--   full level output:
666b944083 Jean*0090       NAMELIST / DIAGNOSTICS_LIST /
                0091      &     frequency, timePhase,
                0092      &     averagingFreq, averagingPhase, repeatCycle,
d9c7a3ba4b Mart*0093      &     missing_value, missing_value_int,
ca10285501 Jean*0094      &     levels, fields, fileName, fileFlags,
41c4545f8f Jean*0095      &     dumpAtLast, diag_dBugLevel, diag_mnc, useMissingValue,
36965c0b7f Jean*0096      &     diagCG_maxIters, diagCG_resTarget,
a63b8f5615 Jean*0097      &     diagCG_pcOffDFac, diagCG_prtResFrq, xPsi0, yPsi0,
ee2e7fad64 Ed H*0098      &     diag_pickup_read,     diag_pickup_write,
1f837e63b3 Gael*0099      &     diag_pickup_read_mnc, diag_pickup_write_mnc,
                0100      &     diagMdsDir, diagMdsDirCreate
09ceb40cd6 Jean*0101 
3e5de6a370 Jean*0102 C--   per level statistics output:
                0103       NAMELIST / DIAG_STATIS_PARMS /
3ae5f90260 Jean*0104      &     stat_freq, stat_phase, stat_region, stat_fields,
a5ec81ed49 Timo*0105      &     stat_fName, diagSt_mnc,
02e1437ea2 Jean*0106      &     set_regMask, val_regMask,
                0107      &     diagSt_regMaskFile, nSetRegMskFile
3e5de6a370 Jean*0108 
ab43bc12c4 Jean*0109       IF ( .NOT.useDiagnostics ) THEN
0cd28bdf45 Jean*0110 C-    pkg DIAGNOSTICS is not used
ab43bc12c4 Jean*0111         _BEGIN_MASTER(myThid)
a5ec81ed49 Timo*0112          useDiag4AdjOutp = .FALSE.
ab43bc12c4 Jean*0113 C-    Track diagnostics pkg activation status:
                0114          diag_pkgStatus = -1
                0115 C     print a (weak) warning if data.diagnostics is found
0cd28bdf45 Jean*0116          CALL PACKAGES_UNUSED_MSG( 'useDiagnostics', ' ', ' ' )
ab43bc12c4 Jean*0117         _END_MASTER(myThid)
e01144d3ad Jean*0118         _BARRIER
ab43bc12c4 Jean*0119         RETURN
                0120       ENDIF
                0121 
                0122 C-    Initialize and Read Diagnostics Namelist
09ceb40cd6 Jean*0123       _BEGIN_MASTER(myThid)
                0124 
                0125       blk8c  = '        '
c326bcb45b Jean*0126       DO k=1,LEN(blkFilName)
                0127         blkFilName(k:k) = ' '
                0128       ENDDO
09ceb40cd6 Jean*0129 
                0130       DO l = 1,ldimLoc
666b944083 Jean*0131         frequency(l)  = 0.
                0132         timePhase(l)  = UNSET_RL
                0133         averagingFreq(l) = 0.
                0134         averagingPhase(l)= 0.
                0135         repeatCycle(l)   = 0
ca10285501 Jean*0136         fileName(l)   = blkFilName
ace73a8de7 Jean*0137 C-    Cannot use model standard Unset value since this was used previously
                0138 C     as defaut missing value that one might want to recover;
                0139 C     Use instead the unlikely missing value of One for the Undef-missing-Val
                0140 c       missing_value(l)     = UNSET_RL
                0141         missing_value(l)     = oneRL
d9c7a3ba4b Mart*0142         missing_value_int(l) = UNSET_I
ca10285501 Jean*0143         fileFlags(l)  = blk8c
09ceb40cd6 Jean*0144         DO k = 1,kdimLoc
666b944083 Jean*0145           levels(k,l) = UNSET_RL
09ceb40cd6 Jean*0146         ENDDO
                0147         DO m = 1,fdimLoc
ab43bc12c4 Jean*0148           fields(m,l) = blkName
09ceb40cd6 Jean*0149         ENDDO
                0150       ENDDO
26d80a25ac Jean*0151       diagLoc_ioUnit = 0
41c4545f8f Jean*0152       diag_dBugLevel = debugLevel
dd249f8e4f Jean*0153       dumpAtLast   = .FALSE.
                0154       diag_mnc     = useMNC
866f99417e Jean*0155       useMissingValue = .FALSE.
ee2e7fad64 Ed H*0156       diag_pickup_read      = .FALSE.
                0157       diag_pickup_write     = .FALSE.
                0158       diag_pickup_read_mnc  = .FALSE.
                0159       diag_pickup_write_mnc = .FALSE.
1f837e63b3 Gael*0160       diagMdsDir = ' '
                0161       diagMdsDirCreate = .TRUE.
09ceb40cd6 Jean*0162 
4be6b2ab9b Jean*0163       prtFirstCall     = .TRUE.
36965c0b7f Jean*0164       diagCG_maxIters  = cg2dMaxIters
                0165       diagCG_resTarget = cg2dTargetResidual
                0166       diagCG_prtResFrq = printResidualFreq
a63b8f5615 Jean*0167       diagCG_pcOffDFac = 1.
                0168       IF ( cg2dpcOffDFac.GT.zeroRL )
                0169      &  diagCG_pcOffDFac = 0.25 _d 0 /( cg2dpcOffDFac*cg2dpcOffDFac )
c19aee9e8e Jean*0170       xPsi0 = UNSET_RS
                0171       yPsi0 = UNSET_RS
                0172 
67d6b2434f Jean*0173       diagSt_regMaskFile = ' '
02e1437ea2 Jean*0174       nSetRegMskFile = 0
67d6b2434f Jean*0175       DO k = 1,rdimLoc
02e1437ea2 Jean*0176         set_regMask(k) = 0
67d6b2434f Jean*0177         val_regMask(k) = 0.
                0178       ENDDO
3e5de6a370 Jean*0179       DO l = 1,ldimLoc
                0180         stat_freq(l)  = 0.
                0181         stat_phase(l) = UNSET_RL
a5ec81ed49 Timo*0182         stat_fName(l) = blkFilName
3e5de6a370 Jean*0183         DO k = 1,rdimLoc
                0184           stat_region(k,l) = UNSET_I
                0185         ENDDO
                0186         DO m = 1,fdimLoc
ab43bc12c4 Jean*0187           stat_fields(m,l) = blkName
3e5de6a370 Jean*0188         ENDDO
                0189       ENDDO
a5ec81ed49 Timo*0190 C     useDiag4AdjOutp will be to set to T if ADJ diags are found in namelist
                0191       useDiag4AdjOutp = .FALSE.
ab43bc12c4 Jean*0192 C-    Track diagnostics pkg activation status:
                0193       diag_pkgStatus = 1
3e5de6a370 Jean*0194 
                0195       WRITE(msgBuf,'(2A)')
09ceb40cd6 Jean*0196      &     ' DIAGNOSTICS_READPARMS: opening data.diagnostics'
                0197       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,SQUEEZE_RIGHT,1)
7e2f6e329a Jean*0198 
                0199       CALL OPEN_COPY_DATA_FILE('data.diagnostics',
09ceb40cd6 Jean*0200      &     'DIAGNOSTICS_READPARMS', ku, myThid )
3e5de6a370 Jean*0201 
                0202       WRITE(msgBuf,'(2A)') 'S/R DIAGNOSTICS_READPARMS,',
                0203      &     ' read namelist "diagnostics_list": start'
                0204       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0205      &                    SQUEEZE_RIGHT , 1)
09ceb40cd6 Jean*0206       READ  (ku,NML=diagnostics_list)
3e5de6a370 Jean*0207       WRITE(msgBuf,'(2A)') 'S/R DIAGNOSTICS_READPARMS,',
                0208      &     ' read namelist "diagnostics_list": OK'
                0209       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0210      &                    SQUEEZE_RIGHT , 1)
                0211 
                0212 C-    set default for statistics output according to the main flag
                0213       diag_mnc = diag_mnc .AND. useMNC
                0214       diagSt_mnc = diag_mnc
                0215 
                0216       WRITE(msgBuf,'(2A)') 'S/R DIAGNOSTICS_READPARMS,',
                0217      &     ' read namelist "DIAG_STATIS_PARMS": start'
                0218       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0219      &                    SQUEEZE_RIGHT , 1)
                0220       READ  (ku,NML=DIAG_STATIS_PARMS)
                0221       WRITE(msgBuf,'(2A)') 'S/R DIAGNOSTICS_READPARMS,',
                0222      &     ' read namelist "DIAG_STATIS_PARMS": OK'
                0223       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0224      &                    SQUEEZE_RIGHT , 1)
                0225 
7a77863887 Mart*0226 #ifdef SINGLE_DISK_IO
                0227       CLOSE(ku)
                0228 #else
                0229       CLOSE(ku,STATUS='DELETE')
                0230 #endif /* SINGLE_DISK_IO */
09ceb40cd6 Jean*0231 
666b944083 Jean*0232 C     Initialise DIAG_SELECT common block (except pointers)
09ceb40cd6 Jean*0233       nlists = 0
866f99417e Jean*0234       DO n = 1,numLists
463845a645 Andr*0235         freq(n) = 0.
509dcf5e56 Jean*0236         phase(n) = 0.
666b944083 Jean*0237         averageFreq(n)  = 0.
                0238         averagePhase(n) = 0.
                0239         averageCycle(n) = 1
09ceb40cd6 Jean*0240         nlevels(n) = 0
                0241         nfields(n) = 0
c326bcb45b Jean*0242         fnames(n) = blkFilName
ace73a8de7 Jean*0243 c       misValFlt(n) = UNSET_RL
                0244 c       misValInt(n) = UNSET_I
                0245         misValFlt(n) = -999. _d 0
                0246 #ifdef ALLOW_FIZHI
                0247         IF ( useFIZHI ) misValFlt(n) = getcon('UNDEF')
                0248 #endif
09ceb40cd6 Jean*0249         DO k = 1,numLevels
                0250           levs(k,n) = 0
                0251         ENDDO
866f99417e Jean*0252         DO m = 1,numperList
ab43bc12c4 Jean*0253           flds(m,n) = blkName
09ceb40cd6 Jean*0254         ENDDO
666b944083 Jean*0255         fflags(n)   = blk8c
09ceb40cd6 Jean*0256       ENDDO
                0257 
3e5de6a370 Jean*0258 C     useMNC is confusing (can be T at this point & turned off later, whereas
                0259 C     for all other pkgs, model stops if use${PKG}= T with #undef ALLOW_${PKG})
                0260 #ifndef ALLOW_MNC
                0261 C     Fix to avoid running without getting any output:
                0262       diag_mnc   = .FALSE.
                0263       diagSt_mnc = .FALSE.
                0264 #endif
                0265 
09ceb40cd6 Jean*0266 C     Fill Diagnostics Common Block with Namelist Info
3e5de6a370 Jean*0267       diagSt_mnc = diagSt_mnc .AND. useMNC
86794c5365 Jean*0268       diag_mdsio = (.NOT. diag_mnc) .OR. outputTypesInclusive
ee2e7fad64 Ed H*0269       diag_pickup_read_mnc  = diag_pickup_read_mnc .AND. diag_mnc
                0270       diag_pickup_write_mnc = diag_pickup_write_mnc .AND. diag_mnc
3e5de6a370 Jean*0271       diag_pickup_read_mdsio  =
ee2e7fad64 Ed H*0272      &     diag_pickup_read .AND. (.NOT. diag_pickup_read_mnc)
                0273       diag_pickup_write_mdsio = diag_pickup_write .AND.
                0274      &     ((.NOT. diag_pickup_write_mnc) .OR. outputTypesInclusive)
3e5de6a370 Jean*0275       diagSt_ascii = (.NOT. diagSt_mnc) .OR. outputTypesInclusive
7e2f6e329a Jean*0276 
0a7965a6c6 Jean*0277 C     remove trailing "/":
                0278       iLen = ILNBLNK( diagMdsDir )
747b4f51bc Jean*0279       IF ( iLen.GE.2 ) THEN
                0280        IF ( diagMdsDir(iLen:iLen).EQ.'/' ) THEN
0a7965a6c6 Jean*0281          namBuf = diagMdsDir
                0282          WRITE(diagMdsDir,'(A)') namBuf(1:iLen-1)
747b4f51bc Jean*0283        ENDIF
0a7965a6c6 Jean*0284       ENDIF
                0285 
09ceb40cd6 Jean*0286       DO l = 1,ldimLoc
ca10285501 Jean*0287        iLen = ILNBLNK(fileName(l))
3ae5f90260 Jean*0288 C-     Only lists with non-empty file name (iLen>0) are considered
866f99417e Jean*0289        IF ( iLen.GE.1 .AND. nlists.LT.numLists ) THEN
09ceb40cd6 Jean*0290          n = nlists + 1
                0291          freq(n)    = frequency(l)
509dcf5e56 Jean*0292          IF ( timePhase(l).NE. UNSET_RL ) THEN
                0293            phase(n) = timePhase(l)
                0294          ELSEIF ( frequency(l) .LT. 0. ) THEN
                0295            phase(n) = -0.5 _d 0 * frequency(l)
                0296          ENDIF
666b944083 Jean*0297          IF ( averagingFreq(l).GT.0. .AND. repeatCycle(l).GT.1 ) THEN
                0298            averageFreq(n)  = averagingFreq(l)
                0299            averagePhase(n) = averagingPhase(l)
                0300            averageCycle(n) = repeatCycle(l)
                0301          ELSEIF (averagingFreq(l).NE.0. .OR. repeatCycle(l).NE.0) THEN
e129400813 Jean*0302            WRITE(msgBuf,'(2A,F18.6,I4)') 'DIAGNOSTICS_READPARMS: ',
666b944083 Jean*0303      &       'unvalid Average-Freq & Cycle:',
                0304      &       averagingFreq(l), repeatCycle(l)
                0305            CALL PRINT_ERROR( msgBuf , myThid )
e129400813 Jean*0306            WRITE(msgBuf,'(2A,I4,2A)') 'DIAGNOSTICS_READPARMS: ',
ca10285501 Jean*0307      &         ' for list l=', l, ', fileName: ', fileName(l)
666b944083 Jean*0308            CALL PRINT_ERROR( msgBuf , myThid )
                0309            STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
                0310          ELSEIF ( frequency(l) .EQ. 0. ) THEN
                0311            averageFreq(n)  = nTimeSteps*deltaTClock
                0312            averagePhase(n) = phase(n)
                0313          ELSEIF ( frequency(l) .GT. 0. ) THEN
                0314            averageFreq(n)  = frequency(l)
                0315            averagePhase(n) = phase(n)
                0316          ENDIF
ace73a8de7 Jean*0317 c        IF ( missing_value(l) .NE. UNSET_RL )
                0318 c    &        misValFlt(n) = missing_value(l)
                0319 c        IF ( missing_value_int(l) .NE. UNSET_I )
                0320 c    &        misValInt(n) = missing_value_int(l)
                0321          IF ( missing_value(l) .NE. oneRL )
                0322      &        misValFlt(n) = missing_value(l)
ca10285501 Jean*0323          fnames(n)  = fileName (l)
                0324          fflags(n)  = fileFlags(l)
09ceb40cd6 Jean*0325          nlevels(n) = 0
666b944083 Jean*0326          IF ( levels(1,l).NE.UNSET_RL ) THEN
09ceb40cd6 Jean*0327            DO k=1,kdimLoc
666b944083 Jean*0328              IF ( levels(k,l).NE.UNSET_RL .AND.
09ceb40cd6 Jean*0329      &            nlevels(n).LT.numLevels ) THEN
                0330                nlevels(n) = nlevels(n) + 1
                0331                levs(nlevels(n),n) = levels(k,l)
666b944083 Jean*0332              ELSEIF ( levels(k,l).NE.UNSET_RL ) THEN
e129400813 Jean*0333               WRITE(msgBuf,'(2A,I4)') 'DIAGNOSTICS_READPARMS: ',
09ceb40cd6 Jean*0334      &         'Exceed Max.Num. of Levels numLevels=', numLevels
                0335               CALL PRINT_ERROR( msgBuf , myThid )
e129400813 Jean*0336               WRITE(msgBuf,'(2A,I4,A,F8.0)') 'DIAGNOSTICS_READPARMS: ',
7e2f6e329a Jean*0337      &         'when trying to add level(k=', k, ' )=', levels(k,l)
09ceb40cd6 Jean*0338               CALL PRINT_ERROR( msgBuf , myThid )
e129400813 Jean*0339               WRITE(msgBuf,'(2A,I4,2A)') 'DIAGNOSTICS_READPARMS: ',
ca10285501 Jean*0340      &         ' for list l=', l, ', fileName: ', fileName(l)
09ceb40cd6 Jean*0341               CALL PRINT_ERROR( msgBuf , myThid )
666b944083 Jean*0342               STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
09ceb40cd6 Jean*0343              ENDIF
                0344            ENDDO
                0345          ELSE
7e2f6e329a Jean*0346 C-       will set levels later, once the Nb of levels of each diag is known
                0347            nlevels(n) = -1
09ceb40cd6 Jean*0348          ENDIF
                0349          nfields(n) = 0
                0350          DO m=1,fdimLoc
3dcfb9510a Jean*0351            diagName = DIAGS_RENAMED( fields(m,l), myThid )
                0352            IF ( diagName.NE.blkName .AND.
866f99417e Jean*0353      &          nfields(n).LT.numperList ) THEN
09ceb40cd6 Jean*0354              nfields(n) = nfields(n) + 1
3dcfb9510a Jean*0355              flds(nfields(n),n) = diagName
                0356            ELSEIF ( diagName.NE.blkName ) THEN
e129400813 Jean*0357              WRITE(msgBuf,'(2A,I4)') 'DIAGNOSTICS_READPARMS: ',
866f99417e Jean*0358      &        'Exceed Max.Num. of Fields/list numperList=', numperList
09ceb40cd6 Jean*0359              CALL PRINT_ERROR( msgBuf , myThid )
e129400813 Jean*0360              WRITE(msgBuf,'(2A,I4,3A,I4,2A)') 'DIAGNOSTICS_READPARMS: ',
3dcfb9510a Jean*0361      &        'when trying to add field (m=', m, ' ): ', diagName
09ceb40cd6 Jean*0362              CALL PRINT_ERROR( msgBuf , myThid )
e129400813 Jean*0363              WRITE(msgBuf,'(2A,I4,2A)') 'DIAGNOSTICS_READPARMS: ',
ca10285501 Jean*0364      &        ' in list l=', l, ', fileName: ', fileName(l)
09ceb40cd6 Jean*0365              CALL PRINT_ERROR( msgBuf , myThid )
                0366              STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
                0367            ENDIF
                0368          ENDDO
                0369          nlists = nlists + 1
322b5ef60a Jean*0370 c        write(6,*) 'list summary:',n,nfields(n),nlevels(n)
3ae5f90260 Jean*0371        ELSEIF ( iLen.GE.1 ) THEN
e129400813 Jean*0372          WRITE(msgBuf,'(2A,I4)') 'DIAGNOSTICS_READPARMS: ',
866f99417e Jean*0373      &            'Exceed Max.Num. of list numLists=', numLists
09ceb40cd6 Jean*0374          CALL PRINT_ERROR( msgBuf , myThid )
e129400813 Jean*0375          WRITE(msgBuf,'(2A,I4)') 'DIAGNOSTICS_READPARMS: ',
09ceb40cd6 Jean*0376      &    'when trying to add list l=', l
                0377          CALL PRINT_ERROR( msgBuf , myThid )
ca2cb81439 Jean*0378          WRITE(msgBuf,'(2A,F18.6,2A)') 'DIAGNOSTICS_READPARMS: ',
ca10285501 Jean*0379      &    ' Frq=', frequency(l), ', fileName: ', fileName(l)
09ceb40cd6 Jean*0380          CALL PRINT_ERROR( msgBuf , myThid )
                0381          STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
                0382        ENDIF
                0383       ENDDO
                0384 
                0385 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
3e5de6a370 Jean*0386 
67d6b2434f Jean*0387 C-    Initialise DIAG_STATS_REGMASK common block (except the mask)
02e1437ea2 Jean*0388       nSetRegMask = 0
67d6b2434f Jean*0389       DO j = 0,nRegions
                0390         diagSt_kRegMsk(j) = 0
                0391         diagSt_vRegMsk(j) = 0.
                0392       ENDDO
                0393 C     Global statistics (region # 0)
                0394       diagSt_kRegMsk(0) = 1
                0395 
                0396 C-    Initialise DIAG_STATIS common block (except pointers)
3e5de6a370 Jean*0397       diagSt_nbLists = 0
866f99417e Jean*0398       DO n = 1,numLists
3e5de6a370 Jean*0399         diagSt_freq(n) = 0.
                0400         diagSt_phase(n) = 0.
                0401         diagSt_nbFlds(n) = 0
                0402         diagSt_ioUnit(n) = 0
                0403         diagSt_Fname(n) = blkFilName
                0404         DO j = 0,nRegions
                0405           diagSt_region(j,n) = 0
                0406         ENDDO
866f99417e Jean*0407         DO m = 1,numperList
ab43bc12c4 Jean*0408           diagSt_Flds(m,n) = blkName
3e5de6a370 Jean*0409         ENDDO
                0410       ENDDO
                0411 
                0412 C     Fill Diagnostics Common Block with Namelist Info
                0413       diagSt_ascii = (.NOT. diagSt_mnc) .OR. outputTypesInclusive
                0414 
67d6b2434f Jean*0415 C-    Region mask correspondence table:
                0416 C     note: this table should be build when regions are defined ;
                0417 C     for now, simpler just to read it from namelist in data.diagnostics
                0418       j = 0
                0419       DO k = 1,rdimLoc
02e1437ea2 Jean*0420        IF ( set_regMask(k).NE.0 .OR. val_regMask(k).NE.0. ) THEN
67d6b2434f Jean*0421          j = j+1
                0422          IF ( j.LE.nRegions ) THEN
02e1437ea2 Jean*0423            diagSt_kRegMsk(j) = set_regMask(k)
67d6b2434f Jean*0424            diagSt_vRegMsk(j) = val_regMask(k)
                0425          ENDIF
                0426        ENDIF
                0427       ENDDO
                0428       IF ( j.GT.nRegions ) THEN
e129400813 Jean*0429          WRITE(msgBuf,'(2A,I4,A)') 'DIAGNOSTICS_READPARMS: ',
02e1437ea2 Jean*0430      &   'set_regMask & val_regMask lists assume at least',j,' regions'
67d6b2434f Jean*0431          CALL PRINT_ERROR( msgBuf , myThid )
                0432          WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_READPARMS: ',
                0433      &   'Need to increase "nRegions" in DIAGNOSTICS_SIZE.h'
                0434          CALL PRINT_ERROR( msgBuf , myThid )
                0435          STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
                0436       ENDIF
                0437 
3e5de6a370 Jean*0438       DO l = 1,ldimLoc
a5ec81ed49 Timo*0439        iLen = ILNBLNK(stat_fName(l))
3ae5f90260 Jean*0440 C-     Only lists with non-empty file name (iLen>0) are considered
866f99417e Jean*0441        IF ( iLen.GE.1 .AND. diagSt_nbLists.LT.numLists)THEN
3e5de6a370 Jean*0442          n = diagSt_nbLists + 1
                0443          diagSt_freq(n) = stat_freq(l)
                0444          IF ( stat_phase(l).NE. UNSET_RL ) THEN
                0445            diagSt_phase(n) = stat_phase(l)
                0446          ELSEIF ( stat_freq(l) .LT. 0. ) THEN
                0447            diagSt_phase(n) = -0.5 _d 0 * stat_freq(l)
                0448          ENDIF
a5ec81ed49 Timo*0449          diagSt_Fname(n)  = stat_fName(l)
3e5de6a370 Jean*0450          regionCount = 0
                0451          DO k=1,rdimLoc
                0452            j = stat_region(k,l)
                0453            IF ( j.NE.UNSET_I .AND. j.GE.0 .AND. j.LE.nRegions ) THEN
67d6b2434f Jean*0454             IF ( diagSt_region(j,n).EQ.0 ) THEN
3e5de6a370 Jean*0455              diagSt_region(j,n) = 1
                0456              regionCount = regionCount + 1
67d6b2434f Jean*0457             ELSE
e129400813 Jean*0458              WRITE(msgBuf,'(2A,I4,2A)')
67d6b2434f Jean*0459      &        'DIAGNOSTICS_READPARMS:',
a5ec81ed49 Timo*0460      &        ' in list l=', l, ', stat_fName: ', stat_fName(l)
67d6b2434f Jean*0461              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0462      &                           SQUEEZE_RIGHT , myThid )
e129400813 Jean*0463              WRITE(msgBuf,'(A,I4,A)')
67d6b2434f Jean*0464      &        'DIAGNOSTICS_READPARMS: region=',j,
                0465      &        ' can only be selected once => ignore 2nd selection'
                0466              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0467      &                           SQUEEZE_RIGHT , myThid )
                0468             ENDIF
3e5de6a370 Jean*0469            ELSEIF ( j.NE.UNSET_I ) THEN
e129400813 Jean*0470              WRITE(msgBuf,'(A,I4,A,I4,2A)')
3e5de6a370 Jean*0471      &       'DIAGNOSTICS_READPARMS: region=',j,
a5ec81ed49 Timo*0472      &         ' in list l=', l, ', stat_fName: ', stat_fName(l)
3e5de6a370 Jean*0473              CALL PRINT_ERROR( msgBuf , myThid )
e129400813 Jean*0474              WRITE(msgBuf,'(2A,I4,A,I4,2A)')
3e5de6a370 Jean*0475      &       'DIAGNOSTICS_READPARMS: ==> exceed Max.Nb of regions',
                0476      &       '(=',nRegions,' )'
                0477              CALL PRINT_ERROR( msgBuf , myThid )
                0478              STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
                0479            ENDIF
                0480          ENDDO
                0481          IF ( regionCount.EQ.0 ) THEN
                0482 C-       no region selected => default is Global statistics (region Id: 0)
                0483            diagSt_region(0,n) = 1
                0484          ENDIF
                0485          diagSt_nbFlds(n) = 0
                0486          DO m=1,fdimLoc
3dcfb9510a Jean*0487            diagName = DIAGS_RENAMED( stat_fields(m,l), myThid )
                0488            IF ( diagName.NE.blkName .AND.
866f99417e Jean*0489      &          diagSt_nbFlds(n).LT.numperList ) THEN
3e5de6a370 Jean*0490              diagSt_nbFlds(n) = diagSt_nbFlds(n) + 1
3dcfb9510a Jean*0491              diagSt_Flds(diagSt_nbFlds(n),n) = diagName
                0492            ELSEIF ( diagName.NE.blkName ) THEN
e129400813 Jean*0493              WRITE(msgBuf,'(2A,I4)') 'DIAGNOSTICS_READPARMS: ',
866f99417e Jean*0494      &        'Exceed Max.Num. of Fields/list numperList=', numperList
3e5de6a370 Jean*0495              CALL PRINT_ERROR( msgBuf , myThid )
e129400813 Jean*0496              WRITE(msgBuf,'(2A,I4,3A,I4,2A)') 'DIAGNOSTICS_READPARMS: ',
3dcfb9510a Jean*0497      &        'when trying to add stat_field (m=', m, ' ): ', diagName
3e5de6a370 Jean*0498              CALL PRINT_ERROR( msgBuf , myThid )
e129400813 Jean*0499              WRITE(msgBuf,'(2A,I4,2A)') 'DIAGNOSTICS_READPARMS: ',
a5ec81ed49 Timo*0500      &        ' in list l=', l, ', stat_fName: ', stat_fName(l)
3e5de6a370 Jean*0501              CALL PRINT_ERROR( msgBuf , myThid )
                0502              STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
                0503            ENDIF
                0504          ENDDO
                0505          diagSt_nbLists = diagSt_nbLists + 1
                0506 c        write(6,*) 'stat-list summary:',n,diagSt_nbFlds(n),regionCount
3ae5f90260 Jean*0507        ELSEIF ( iLen.GE.1 ) THEN
e129400813 Jean*0508          WRITE(msgBuf,'(2A,I4)') 'DIAGNOSTICS_READPARMS: ',
866f99417e Jean*0509      &            'Exceed Max.Num. of list numLists=', numLists
3e5de6a370 Jean*0510          CALL PRINT_ERROR( msgBuf , myThid )
e129400813 Jean*0511          WRITE(msgBuf,'(2A,I4)') 'DIAGNOSTICS_READPARMS: ',
3e5de6a370 Jean*0512      &    'when trying to add stat_list l=', l
                0513          CALL PRINT_ERROR( msgBuf , myThid )
ca2cb81439 Jean*0514          WRITE(msgBuf,'(2A,F18.6,2A)') 'DIAGNOSTICS_READPARMS: ',
a5ec81ed49 Timo*0515      &    ' Frq=', stat_freq(l), ', stat_fName: ', stat_fName(l)
3e5de6a370 Jean*0516          CALL PRINT_ERROR( msgBuf , myThid )
                0517          STOP 'ABNORMAL END: S/R DIAGNOSTICS_READPARMS'
                0518        ENDIF
                0519       ENDDO
                0520 
                0521 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
09ceb40cd6 Jean*0522 C     Echo History List Data Structure
                0523       stdUnit = standardMessageUnit
                0524       WRITE(msgBuf,'(A)')
41c4545f8f Jean*0525      & '-----------------------------------------------------'
                0526       CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
                0527       WRITE(msgBuf,'(A)')
866f99417e Jean*0528      &     ' DIAGNOSTICS_READPARMS: global parameter summary:'
                0529       CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
41c4545f8f Jean*0530       CALL WRITE_0D_I( diag_dBugLevel, INDEX_NONE,
                0531      & ' diag_dBugLevel =', ' /* level of printed debug messages */')
866f99417e Jean*0532       CALL WRITE_0D_L( dumpAtLast, INDEX_NONE,
                0533      & ' dumpAtLast =',' /* always write time-ave diags at the end */')
                0534       CALL WRITE_0D_L( diag_mnc,   INDEX_NONE,
                0535      & ' diag_mnc =', '   /* write NetCDF output files */')
1f837e63b3 Gael*0536       IF ( diag_mdsio.AND.(diagMdsDir.NE.' ') ) THEN
54bb21a420 Jean*0537        CALL WRITE_0D_C( diagMdsDir, -1, INDEX_NONE,
0a7965a6c6 Jean*0538      & ' diagMdsDir =', ' /* directory for mds diagnostics output */')
54bb21a420 Jean*0539        CALL WRITE_0D_L( diagMdsDirCreate, INDEX_NONE,
1f837e63b3 Gael*0540      & ' diagMdsDirCreate =', ' /* call mkdir to create diagMdsDir */')
                0541       ENDIF
866f99417e Jean*0542       CALL WRITE_0D_L( useMissingValue, INDEX_NONE,
                0543      & ' useMissingValue =', ' /* put MissingValue where mask = 0 */')
36965c0b7f Jean*0544       CALL WRITE_0D_I( diagCG_maxIters, INDEX_NONE,
                0545      & ' diagCG_maxIters =', ' /* max number of iters in diag_cg2d */')
                0546       CALL WRITE_0D_RL( diagCG_resTarget, INDEX_NONE,
                0547      & ' diagCG_resTarget =', ' /* residual target for diag_cg2d */')
a63b8f5615 Jean*0548       CALL WRITE_0D_RL( diagCG_pcOffDFac, INDEX_NONE,
                0549      & ' diagCG_pcOffDFac =',
                0550      & ' /* preconditioner off-diagonal factor */')
866f99417e Jean*0551       WRITE(msgBuf,'(A)')
09ceb40cd6 Jean*0552      & '-----------------------------------------------------'
                0553       CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
                0554       WRITE(msgBuf,'(A)')
                0555      &     ' DIAGNOSTICS_READPARMS: active diagnostics summary:'
                0556       CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
                0557       WRITE(msgBuf,'(A)')
                0558      & '-----------------------------------------------------'
                0559       CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
                0560       DO n = 1,nlists
ca2cb81439 Jean*0561         WRITE(msgBuf,'(2A)') 'Creating Output Stream: ', fnames(n)
09ceb40cd6 Jean*0562         CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
ca2cb81439 Jean*0563         WRITE(msgBuf,'(2(A,F18.6))') 'Output Frequency:', freq(n),
509dcf5e56 Jean*0564      &                               ' ; Phase: ', phase(n)
09ceb40cd6 Jean*0565         CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
e129400813 Jean*0566         WRITE(msgBuf,'(2(A,F18.6),A,I4)')
666b944083 Jean*0567      &    ' Averaging Freq.:', averageFreq(n),
                0568      &    ' , Phase: ', averagePhase(n), ' , Cycle:', averageCycle(n)
                0569         CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
5f837b700f Jean*0570         IF ( fflags(n).EQ.blk8c ) THEN
ace73a8de7 Jean*0571 c         WRITE(msgBuf,'(A,1PE20.12,A,I12,3A)')
                0572 c    &       ' missing value:',  misValFlt(n),
                0573 c    &       ' ; for integers:', misValInt(n)
                0574           WRITE(msgBuf,'(A,1PE20.12,3A)')
                0575      &       ' missing value:', misValFlt(n)
5f837b700f Jean*0576         ELSE
ace73a8de7 Jean*0577 c         WRITE(msgBuf,'(A,1PE20.12,A,I12,3A)')
                0578 c    &       ' missing value:',  misValFlt(n),
                0579 c    &       ' ; for integers:', misValInt(n),
                0580 c    &       ' ; F-Flags="', fflags(n),'"'
                0581           WRITE(msgBuf,'(A,1PE20.12,3A)')
                0582      &       ' missing value:', misValFlt(n),
5f837b700f Jean*0583      &       ' ; F-Flags="', fflags(n),'"'
                0584         ENDIF
d9c7a3ba4b Mart*0585         CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
5f837b700f Jean*0586         IF ( nlevels(n).EQ.-1 .AND. fflags(n)(2:2).EQ.'I' ) THEN
                0587           WRITE(msgBuf,'(A)') ' Cumulate all Levels (to be set later)'
                0588           CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
                0589         ELSEIF ( nlevels(n).EQ.-1 ) THEN
7e2f6e329a Jean*0590           WRITE(msgBuf,'(A,A)') ' Levels:    ','will be set later'
                0591           CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
c65a5004af Jean*0592         ELSEIF ( fflags(n)(2:2).EQ.'P' ) THEN
                0593          DO l=1,nlevels(n),10
                0594           m = MIN(nlevels(n),l+9)
                0595           WRITE(msgBuf,'(A,1P10E10.3)')' interp:  ', (levs(k,n),k=l,m)
                0596           CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
                0597          ENDDO
7e2f6e329a Jean*0598         ELSE
5f837b700f Jean*0599          suffix = ' Levels:    '
                0600          IF ( fflags(n)(2:2).EQ.'I' ) suffix = ' Sum Levels:'
7e2f6e329a Jean*0601          DO l=1,nlevels(n),20
09ceb40cd6 Jean*0602           m = MIN(nlevels(n),l+19)
5f837b700f Jean*0603           WRITE(msgBuf,'(A,20F5.0)') suffix, (levs(k,n),k=l,m)
09ceb40cd6 Jean*0604           CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
7e2f6e329a Jean*0605          ENDDO
                0606         ENDIF
9dd4311c0c Andr*0607         DO nf = 1,nfields(n),10
c65a5004af Jean*0608           m = MIN(nfields(n),nf+9)
ca2cb81439 Jean*0609           WRITE(msgBuf,'(21A)') ' Fields:   ',(' ',flds(l,n),l=nf,m)
c65a5004af Jean*0610           CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
9dd4311c0c Andr*0611         ENDDO
09ceb40cd6 Jean*0612       ENDDO
                0613       WRITE(msgBuf,'(A)')
                0614      & '-----------------------------------------------------'
                0615       CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
                0616       WRITE(msgBuf,'(A)')
3e5de6a370 Jean*0617      &     ' DIAGNOSTICS_READPARMS: statistics diags. summary:'
                0618       CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
                0619       DO n = 1,diagSt_nbLists
ca2cb81439 Jean*0620         WRITE(msgBuf,'(2A)') 'Creating Stats. Output Stream: ',
3e5de6a370 Jean*0621      &                       diagSt_Fname(n)
                0622         CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
ca2cb81439 Jean*0623         WRITE(msgBuf,'(2(A,F18.6))') 'Output Frequency:',
666b944083 Jean*0624      &               diagSt_freq(n), ' ; Phase: ', diagSt_phase(n)
3e5de6a370 Jean*0625         CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
ca2cb81439 Jean*0626         WRITE(msgBuf,'(A)') ' Regions: '
                0627         l = 10
3e5de6a370 Jean*0628         DO j=0,nRegions
                0629          IF ( diagSt_region(j,n).GE.1 ) THEN
                0630           l = l+3
ca2cb81439 Jean*0631           IF (l.LE.MAX_LEN_MBUF) WRITE(msgBuf(l-2:l),'(I3)') j
3e5de6a370 Jean*0632          ENDIF
                0633         ENDDO
                0634         CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
ca2cb81439 Jean*0635         DO nf = 1,diagSt_nbFlds(n),10
                0636           m = MIN(diagSt_nbFlds(n),nf+9)
                0637           WRITE(msgBuf,'(21A)') ' Fields:   ',
                0638      &                 (' ',diagSt_Flds(l,n),l=nf,m)
                0639           CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
                0640         ENDDO
3e5de6a370 Jean*0641       ENDDO
                0642       WRITE(msgBuf,'(A)')
                0643      & '-----------------------------------------------------'
                0644       CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
                0645       WRITE(msgBuf,'(A)')
09ceb40cd6 Jean*0646       CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
                0647 
                0648       _END_MASTER(myThid)
                0649 
7d8ed39566 Jean*0650 C--   Everyone else must wait for the parameters to be loaded
                0651       _BARRIER
                0652 
09ceb40cd6 Jean*0653       RETURN
                0654       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!