Back to home page

MITgcm

 
 

    


File indexing completed on 2024-07-17 05:10:41 UTC

view on githubraw file Latest commit acacc28f on 2024-07-17 03:59:01 UTC
dd6d146759 Jean*0001 #include "DIAG_OPTIONS.h"
acacc28f7f Jean*0002 #ifdef ALLOW_AUTODIFF
                0003 # include "AUTODIFF_OPTIONS.h"
                0004 #endif
dd6d146759 Jean*0005 
                0006 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
acacc28f7f Jean*0007 CBOP
dd6d146759 Jean*0008 C     !ROUTINE: DIAGNOSTICS_SWITCH_ONOFF
                0009 
                0010 C     !INTERFACE:
acacc28f7f Jean*0011       SUBROUTINE DIAGNOSTICS_SWITCH_ONOFF(
41c4545f8f Jean*0012      I                       seqFlag, myTime, myIter, myThid )
dd6d146759 Jean*0013 
                0014 C     !DESCRIPTION:
                0015 C-----
                0016 C     Called at the beginning of the time-step,
                0017 C     to switch on/off diagnostics for snap-shot output
                0018 C-----
                0019 C      during iterations that are multiple of |freq|,
                0020 C      switch ON diagnostics (ndiag>=0) that will become active
                0021 C      and then can be written at the end of the time-step ;
                0022 C      otherwise, put diagnostics in non-active mode (ndiag=-1)
                0023 C-----
                0024 
                0025 C     !USES:
                0026       IMPLICIT NONE
                0027 #include "SIZE.h"
                0028 #include "EEPARAMS.h"
                0029 #include "PARAMS.h"
                0030 #include "DIAGNOSTICS_SIZE.h"
                0031 #include "DIAGNOSTICS.h"
                0032 
                0033 C     !INPUT PARAMETERS:
41c4545f8f Jean*0034 C     seqFlag  :: flag that indicates where this S/R is called from:
                0035 C              :: = 1 : called from the top of FORWARD_STEP, forward sweep
                0036 C              :: =-1 : called from AUTODIFF_INADMODE_SET_AD, backward sweep
                0037 C     myTime   :: current Time of simulation ( s )
                0038 C     myIter   :: current Iteration number
                0039 C     myThid   :: my Thread Id number
                0040       INTEGER seqFlag
02545dbccf Jean*0041       _RL     myTime
dd6d146759 Jean*0042       INTEGER myIter
                0043       INTEGER myThid
acacc28f7f Jean*0044 
                0045 C     !FUNCTIONS
                0046       LOGICAL  DIFF_PHASE_MULTIPLE
                0047       EXTERNAL DIFF_PHASE_MULTIPLE
dd6d146759 Jean*0048 
                0049 C     !LOCAL VARIABLES:
                0050 C      newIter :: future iteration number
                0051 C      j,m,n   :: loop index
666b944083 Jean*0052       CHARACTER*(MAX_LEN_MBUF) msgBuf
509dcf5e56 Jean*0053 c     INTEGER newIter
3ae5f90260 Jean*0054       INTEGER m, n, nd
                0055       INTEGER bi, bj, ip, iSp
509dcf5e56 Jean*0056       LOGICAL time4SnapShot
                0057       _RL     phiSec, freqSec
666b944083 Jean*0058       INTEGER nInterval
                0059       _RL     xInterval
acacc28f7f Jean*0060       LOGICAL firstCall
3e5de6a370 Jean*0061       LOGICAL dBugFlag
80df109dfc Jean*0062       INTEGER dBugUnit
509dcf5e56 Jean*0063 #ifdef ALLOW_FIZHI
9a18ea0ab4 Jean*0064       LOGICAL  ALARM2NEXT
                0065       EXTERNAL ALARM2NEXT
acacc28f7f Jean*0066       CHARACTER*9 tagname
509dcf5e56 Jean*0067 #endif
acacc28f7f Jean*0068 CEOP
dd6d146759 Jean*0069 
                0070 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0071 
41c4545f8f Jean*0072       dBugFlag = diag_dBugLevel.GE.debLevE .AND. myThid.EQ.1
80df109dfc Jean*0073       dBugUnit = errorMessageUnit
666b944083 Jean*0074 
ab43bc12c4 Jean*0075 C--   Track diagnostics pkg activation status:
acacc28f7f Jean*0076       firstCall = myIter.EQ.nIter0
                0077       IF ( seqFlag.EQ.-1 ) THEN
                0078 #ifdef ALLOW_DIVIDED_ADJOINT
                0079         CALL DIAGS_TRACK_DIVA( firstCall, myIter, myThid )
                0080 #else
                0081         firstCall = (myIter+1).EQ.nEndIter
                0082 #endif
                0083       ENDIF
                0084       IF ( firstCall .AND. ( seqFlag.EQ.1 .OR. seqFlag.EQ.-1 ) ) THEN
                0085 c       IF ( seqFlag.EQ.1 .AND. diag_pkgStatus.NE.10 ) STOP
e01144d3ad Jean*0086         _BARRIER
                0087         _BEGIN_MASTER(myThid)
ab43bc12c4 Jean*0088         diag_pkgStatus = ready2fillDiags
                0089         _END_MASTER(myThid)
e01144d3ad Jean*0090         _BARRIER
ab43bc12c4 Jean*0091 c     ELSEIF
                0092 c       IF ( diag_pkgStatus.NE.ready2fillDiags ) STOP
                0093       ENDIF
                0094 
509dcf5e56 Jean*0095 c     newIter = 1 + myIter
dd6d146759 Jean*0096       DO n = 1,nlists
509dcf5e56 Jean*0097 
                0098        IF ( freq(n).LT.0. ) THEN
                0099 C--    Select diagnostics list that uses instantaneous output
                0100 
                0101         freqSec = freq(n)
                0102         phiSec = phase(n)
333e96bf9c Andr*0103         time4SnapShot = DIFF_PHASE_MULTIPLE( phiSec, freqSec,
9a18ea0ab4 Jean*0104      &                                       myTime, deltaTClock )
463845a645 Andr*0105 #ifdef ALLOW_FIZHI
666b944083 Jean*0106         IF ( useFIZHI ) THEN
                0107          WRITE(tagname,'(A,I2.2)')'diagtag',n
9a18ea0ab4 Jean*0108          time4SnapShot = ALARM2NEXT(tagname,deltaT)
666b944083 Jean*0109         ENDIF
463845a645 Andr*0110 #endif
9a18ea0ab4 Jean*0111 #ifdef ALLOW_CAL
                0112         IF ( useCAL ) THEN
                0113           CALL CAL_TIME2DUMP( phiSec, freqSec, deltaTClock,
                0114      U                        time4SnapShot,
                0115      I                        myTime, myIter, myThid )
                0116         ENDIF
                0117 #endif /* ALLOW_CAL */
463845a645 Andr*0118 
3ae5f90260 Jean*0119         DO bj=myByLo(myThid), myByHi(myThid)
                0120          DO bi=myBxLo(myThid), myBxHi(myThid)
                0121           IF ( time4SnapShot ) THEN
                0122 C--       switch ON diagnostics of output-stream # n
                0123             DO m=1,nActive(n)
b38beaf3c1 Jean*0124 c             nd = ABS(jdiag(m,n))
3ae5f90260 Jean*0125 c             IF (ndiag(nd).NE.0) WRITE(0,*) myIter,nd,ndiag(nd),' ->',0
                0126               ip = idiag(m,n)
                0127               IF (ip.GT.0) ndiag(ip,bi,bj) = 0
                0128             ENDDO
                0129           ELSE
                0130 C--       switch OFF diagnostics of output-stream # n
                0131             DO m=1,nActive(n)
b38beaf3c1 Jean*0132 c             nd = ABS(jdiag(m,n))
3ae5f90260 Jean*0133 c             IF (ndiag(nd).NE.-1) WRITE(0,*) myIter,nd,ndiag(nd),' ->',-1
                0134               ip = idiag(m,n)
                0135               IF (ip.GT.0) ndiag(ip,bi,bj) = -1
                0136             ENDDO
                0137           ENDIF
                0138          ENDDO
                0139         ENDDO
dd6d146759 Jean*0140 
666b944083 Jean*0141 C--    list with instantaneous output: end
dd6d146759 Jean*0142        ENDIF
666b944083 Jean*0143 
                0144        IF ( averageCycle(n).GT.1 ) THEN
                0145 C--    Select diagnostics list that uses periodic averaging
9a18ea0ab4 Jean*0146         xInterval = myTime + deltaTClock*0.5 _d 0 - averagePhase(n)
666b944083 Jean*0147         xInterval = xInterval / averageFreq(n)
                0148         IF ( xInterval.GE.0. ) THEN
                0149           nInterval = INT(xInterval)
                0150         ELSE
                0151           nInterval = 1 + INT( -xInterval/FLOAT(averageCycle(n)) )
                0152           nInterval = nInterval*averageCycle(n) + INT(xInterval) - 1
                0153         ENDIF
                0154         nInterval = MOD(nInterval,averageCycle(n))
                0155 
                0156 C-     check future value of pdiag:
                0157         IF (dBugFlag.AND.pdiag(n,1,1).NE.nInterval)
e129400813 Jean*0158      &    WRITE(dBugUnit,'(A,I8,3(A,I4),F17.6)')
80df109dfc Jean*0159      &     'DIAG_SWITCH_ONOFF: at it=', myIter, ', list:', n,
                0160      &     ' switch', pdiag(n,1,1),' ->', nInterval, xInterval
666b944083 Jean*0161         IF ( nInterval.LT.0 .OR. nInterval.GE.averageCycle(n) ) THEN
e129400813 Jean*0162           WRITE(msgBuf,'(2A,I3,A,I4)') 'DIAGNOSTICS_SWITCH_ONOFF:',
666b944083 Jean*0163      &       ' error setting pdiag(n=',n,') to:', nInterval
                0164           CALL PRINT_ERROR( msgBuf , myThid )
e129400813 Jean*0165           WRITE(msgBuf,'(2A,I4,A,F17.6)') 'DIAGNOSTICS_SWITCH_ONOFF:',
666b944083 Jean*0166      &       ' cycle=', averageCycle(n), ', xInt=', xInterval
                0167           CALL PRINT_ERROR( msgBuf , myThid )
                0168           STOP 'ABNORMAL END: S/R DIAGNOSTICS_SWITCH_ONOFF'
                0169         ENDIF
                0170 
                0171         DO bj=myByLo(myThid), myByHi(myThid)
                0172          DO bi=myBxLo(myThid), myBxHi(myThid)
                0173            pdiag(n,bi,bj) = nInterval
                0174          ENDDO
                0175         ENDDO
                0176 C--    list with periodic averaging: end
                0177        ENDIF
                0178 
dd6d146759 Jean*0179       ENDDO
                0180 
3e5de6a370 Jean*0181 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0182 
                0183       DO n = 1,diagSt_nbLists
                0184 
                0185        IF ( diagSt_freq(n).LT.0. ) THEN
                0186 C--    Select diagnostics list that uses instantaneous output
                0187 
41c4545f8f Jean*0188         dBugFlag = diag_dBugLevel.GE.debLevE
3e5de6a370 Jean*0189 
                0190         freqSec = diagSt_freq(n)
                0191         phiSec = diagSt_phase(n)
                0192         time4SnapShot = DIFF_PHASE_MULTIPLE( phiSec, freqSec,
9a18ea0ab4 Jean*0193      &                                       myTime, deltaTClock )
3e5de6a370 Jean*0194 
0ca8304c4f Jean*0195 #ifdef ALLOW_FIZHI
666b944083 Jean*0196         IF ( useFIZHI ) THEN
                0197          WRITE(tagname,'(A,I2.2)')'diagStg',n
9a18ea0ab4 Jean*0198          time4SnapShot = ALARM2NEXT(tagname,deltaT)
666b944083 Jean*0199         ENDIF
0ca8304c4f Jean*0200 #endif
9a18ea0ab4 Jean*0201 #ifdef ALLOW_CAL
                0202         IF ( useCAL ) THEN
                0203           CALL CAL_TIME2DUMP( phiSec, freqSec, deltaTClock,
                0204      U                        time4SnapShot,
                0205      I                        myTime, myIter, myThid )
                0206         ENDIF
                0207 #endif /* ALLOW_CAL */
0ca8304c4f Jean*0208 
3e5de6a370 Jean*0209         DO bj=myByLo(myThid), myByHi(myThid)
                0210          DO bi=myBxLo(myThid), myBxHi(myThid)
                0211           dBugFlag = dBugFlag.AND.(bi.EQ.1.AND.bj.EQ.1.AND.myThid.EQ.1)
                0212           IF ( time4SnapShot ) THEN
                0213 C--     switch ON diagnostics of output-stream # n
                0214             DO m=1,diagSt_nbActv(n)
3ae5f90260 Jean*0215              iSp = iSdiag(m,n)
                0216              IF (iSp.GT.0) THEN
                0217                nd = jSdiag(m,n)
                0218                IF (dBugFlag.AND.qSdiag(0,0,iSp,bi,bj).NE. 0.)
e129400813 Jean*0219      &          WRITE(dBugUnit,'(A,I8,A,I6,3A,1PE10.3,A,I3)')
80df109dfc Jean*0220      &           'DIAG_SWITCH_ONOFF: at it=', myIter, ' diag:', nd,
                0221      &           ' ',cdiag(nd),' :',qSdiag(0,0,iSp,bi,bj),' ->', 0
3ae5f90260 Jean*0222                qSdiag(0,0,iSp,bi,bj) = 0.
                0223              ENDIF
3e5de6a370 Jean*0224             ENDDO
                0225           ELSE
                0226 C--     switch OFF diagnostics of output-stream # n
                0227             DO m=1,diagSt_nbActv(n)
3ae5f90260 Jean*0228              iSp = iSdiag(m,n)
                0229              IF (iSp.GT.0) THEN
                0230                nd = jSdiag(m,n)
                0231                IF (dBugFlag.AND.qSdiag(0,0,iSp,bi,bj).NE.-1.)
e129400813 Jean*0232      &          WRITE(dBugUnit,'(A,I8,A,I6,3A,1PE10.3,A,I3)')
80df109dfc Jean*0233      &           'DIAG_SWITCH_ONOFF: at it=', myIter, ' diag:', nd,
                0234      &           ' ',cdiag(nd),' :',qSdiag(0,0,iSp,bi,bj),' ->', -1
3ae5f90260 Jean*0235                qSdiag(0,0,iSp,bi,bj) = -1.
                0236              ENDIF
3e5de6a370 Jean*0237             ENDDO
                0238           ENDIF
                0239          ENDDO
                0240         ENDDO
                0241 
                0242        ENDIF
                0243       ENDDO
                0244 
dd6d146759 Jean*0245       RETURN
                0246       END