pkg/diagnostics/diagnostics_switch_onoff.F

C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diagnostics_switch_onoff.F,v 1.14 2006/06/05 18:17:22 jmc Exp $
C $Name:  $

#include "DIAG_OPTIONS.h"

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP 0
C     !ROUTINE: DIAGNOSTICS_SWITCH_ONOFF

C     !INTERFACE:
      SUBROUTINE DIAGNOSTICS_SWITCH_ONOFF( myTime, myIter, myThid )

C     !DESCRIPTION:
C-----
C     Called at the beginning of the time-step,
C     to switch on/off diagnostics for snap-shot output
C-----
C      during iterations that are multiple of |freq|,
C      switch ON diagnostics (ndiag>=0) that will become active
C      and then can be written at the end of the time-step ;
C      otherwise, put diagnostics in non-active mode (ndiag=-1)
C-----

C     !USES:
      IMPLICIT NONE
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "DIAGNOSTICS_SIZE.h"
#include "DIAGNOSTICS.h"

C     !INPUT PARAMETERS:
C     myTime     :: current Time of simulation ( s )
C     myIter     :: current Iteration number
C     myThid     :: my Thread Id number
      _RL     myTime
      INTEGER myIter
      INTEGER myThid
CEOP

C     !LOCAL VARIABLES:
C      newIter :: future iteration number
C      j,m,n   :: loop index
      CHARACTER*(MAX_LEN_MBUF) msgBuf
c     INTEGER newIter
      INTEGER m, n, nd
      INTEGER bi, bj, ip, iSp
      LOGICAL time4SnapShot
      _RL     phiSec, freqSec
      INTEGER nInterval
      _RL     xInterval
      LOGICAL dBugFlag
      INTEGER dBugUnit
#ifdef ALLOW_FIZHI
      LOGICAL alarm2, alarm2next
      CHARACTER *9 tagname
#endif

      LOGICAL  DIFF_PHASE_MULTIPLE
      EXTERNAL DIFF_PHASE_MULTIPLE

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

      dBugFlag = debugLevel.GT.debLevB .AND. myThid.EQ.1
      dBugUnit = errorMessageUnit

c     newIter = 1 + myIter
      DO n = 1,nlists

       IF ( freq(n).LT.0. ) THEN
C--    Select diagnostics list that uses instantaneous output

        freqSec = freq(n)
        phiSec = phase(n)
        time4SnapShot = DIFF_PHASE_MULTIPLE( phiSec, freqSec,
     &                                       myTime, deltaTclock )
#ifdef ALLOW_FIZHI
        IF ( useFIZHI ) THEN
         WRITE(tagname,'(A,I2.2)')'diagtag',n
         time4SnapShot = alarm2next(tagname,deltaT)
        ENDIF
#endif

        DO bj=myByLo(myThid), myByHi(myThid)
         DO bi=myBxLo(myThid), myBxHi(myThid)
          IF ( time4SnapShot ) THEN
C--       switch ON diagnostics of output-stream # n
            DO m=1,nActive(n)
c             nd = jdiag(m,n)
c             IF (ndiag(nd).NE.0) WRITE(0,*) myIter,nd,ndiag(nd),' ->',0
              ip = idiag(m,n)
              IF (ip.GT.0) ndiag(ip,bi,bj) = 0
            ENDDO
          ELSE
C--       switch OFF diagnostics of output-stream # n
            DO m=1,nActive(n)
c             nd = jdiag(m,n)
c             IF (ndiag(nd).NE.-1) WRITE(0,*) myIter,nd,ndiag(nd),' ->',-1
              ip = idiag(m,n)
              IF (ip.GT.0) ndiag(ip,bi,bj) = -1
            ENDDO
          ENDIF
         ENDDO
        ENDDO

C--    list with instantaneous output: end
       ENDIF

       IF ( averageCycle(n).GT.1 ) THEN
C--    Select diagnostics list that uses periodic averaging
        xInterval = myTime + deltaTclock*0.5 _d 0 - averagePhase(n)
        xInterval = xInterval / averageFreq(n)
        IF ( xInterval.GE.0. ) THEN
          nInterval = INT(xInterval)
        ELSE
          nInterval = 1 + INT( -xInterval/FLOAT(averageCycle(n)) )
          nInterval = nInterval*averageCycle(n) + INT(xInterval) - 1
        ENDIF
        nInterval = MOD(nInterval,averageCycle(n))

C-     check future value of pdiag:
        IF (dBugFlag.AND.pdiag(n,1,1).NE.nInterval)
     &    WRITE(dBugUnit,'(A,I8,3(A,I3),F17.6)')
     &     'DIAG_SWITCH_ONOFF: at it=', myIter, ', list:', n,
     &     ' switch', pdiag(n,1,1),' ->', nInterval, xInterval
        IF ( nInterval.LT.0 .OR. nInterval.GE.averageCycle(n) ) THEN
          WRITE(msgBuf,'(2A,I2,A,I4)') 'DIAGNOSTICS_SWITCH_ONOFF:',
     &       ' error setting pdiag(n=',n,') to:', nInterval
          CALL PRINT_ERROR( msgBuf , myThid )
          WRITE(msgBuf,'(2A,I3,A,F17.6)') 'DIAGNOSTICS_SWITCH_ONOFF:',
     &       ' cycle=', averageCycle(n), ', xInt=', xInterval
          CALL PRINT_ERROR( msgBuf , myThid )
          STOP 'ABNORMAL END: S/R DIAGNOSTICS_SWITCH_ONOFF'
        ENDIF

        DO bj=myByLo(myThid), myByHi(myThid)
         DO bi=myBxLo(myThid), myBxHi(myThid)
           pdiag(n,bi,bj) = nInterval
         ENDDO
        ENDDO
C--    list with periodic averaging: end
       ENDIF

      ENDDO

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

      DO n = 1,diagSt_nbLists

       IF ( diagSt_freq(n).LT.0. ) THEN
C--    Select diagnostics list that uses instantaneous output

        dBugFlag = debugLevel.GT.debLevB

        freqSec = diagSt_freq(n)
        phiSec = diagSt_phase(n)
        time4SnapShot = DIFF_PHASE_MULTIPLE( phiSec, freqSec,
     &                                       myTime, deltaTclock )

#ifdef ALLOW_FIZHI
        IF ( useFIZHI ) THEN
         WRITE(tagname,'(A,I2.2)')'diagStg',n
         time4SnapShot = alarm2next(tagname,deltaT)
        ENDIF
#endif

        DO bj=myByLo(myThid), myByHi(myThid)
         DO bi=myBxLo(myThid), myBxHi(myThid)
          dBugFlag = dBugFlag.AND.(bi.EQ.1.AND.bj.EQ.1.AND.myThid.EQ.1)
          IF ( time4SnapShot ) THEN
C--     switch ON diagnostics of output-stream # n
            DO m=1,diagSt_nbActv(n)
             iSp = iSdiag(m,n)
             IF (iSp.GT.0) THEN
               nd = jSdiag(m,n)
               IF (dBugFlag.AND.qSdiag(0,0,iSp,bi,bj).NE. 0.)
     &          WRITE(dBugUnit,'(A,I8,A,I4,3A,1PE10.3,A,I3)')
     &           'DIAG_SWITCH_ONOFF: at it=', myIter, ' diag:', nd,
     &           ' ',cdiag(nd),' :',qSdiag(0,0,iSp,bi,bj),' ->', 0
               qSdiag(0,0,iSp,bi,bj) = 0.
             ENDIF
            ENDDO
          ELSE
C--     switch OFF diagnostics of output-stream # n
            DO m=1,diagSt_nbActv(n)
             iSp = iSdiag(m,n)
             IF (iSp.GT.0) THEN
               nd = jSdiag(m,n)
               IF (dBugFlag.AND.qSdiag(0,0,iSp,bi,bj).NE.-1.)
     &          WRITE(dBugUnit,'(A,I8,A,I4,3A,1PE10.3,A,I3)')
     &           'DIAG_SWITCH_ONOFF: at it=', myIter, ' diag:', nd,
     &           ' ',cdiag(nd),' :',qSdiag(0,0,iSp,bi,bj),' ->', -1
               qSdiag(0,0,iSp,bi,bj) = -1.
             ENDIF
            ENDDO
          ENDIF
         ENDDO
        ENDDO

       ENDIF
      ENDDO

      RETURN
      END
1	jmc	1.15	C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diagnostics_switch_onoff.F,v 1.14 2006/06/05 18:17:22 jmc Exp $
2	jmc	1.1	C $Name: $
3
4			#include "DIAG_OPTIONS.h"
5
6			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
7			CBOP 0
8			C !ROUTINE: DIAGNOSTICS_SWITCH_ONOFF
9
10			C !INTERFACE:
11	jmc	1.5	SUBROUTINE DIAGNOSTICS_SWITCH_ONOFF( myTime, myIter, myThid )
12	jmc	1.1
13			C !DESCRIPTION:
14			C-----
15			C Called at the beginning of the time-step,
16			C to switch on/off diagnostics for snap-shot output
17			C-----
18			C during iterations that are multiple of \|freq\|,
19			C switch ON diagnostics (ndiag>=0) that will become active
20			C and then can be written at the end of the time-step ;
21			C otherwise, put diagnostics in non-active mode (ndiag=-1)
22			C-----
23
24			C !USES:
25			IMPLICIT NONE
26			#include "SIZE.h"
27			#include "EEPARAMS.h"
28			#include "PARAMS.h"
29			#include "DIAGNOSTICS_SIZE.h"
30			#include "DIAGNOSTICS.h"
31
32			C !INPUT PARAMETERS:
33	jmc	1.5	C myTime :: current Time of simulation ( s )
34	jmc	1.1	C myIter :: current Iteration number
35			C myThid :: my Thread Id number
36	jmc	1.6	_RL myTime
37	jmc	1.1	INTEGER myIter
38			INTEGER myThid
39			CEOP
40
41			C !LOCAL VARIABLES:
42			C newIter :: future iteration number
43			C j,m,n :: loop index
44	jmc	1.14	CHARACTER*(MAX_LEN_MBUF) msgBuf
45	jmc	1.5	c INTEGER newIter
46	jmc	1.12	INTEGER m, n, nd
47			INTEGER bi, bj, ip, iSp
48	jmc	1.5	LOGICAL time4SnapShot
49			_RL phiSec, freqSec
50	jmc	1.14	INTEGER nInterval
51			_RL xInterval
52	jmc	1.9	LOGICAL dBugFlag
53	jmc	1.15	INTEGER dBugUnit
54	jmc	1.5	#ifdef ALLOW_FIZHI
55	jmc	1.14	LOGICAL alarm2, alarm2next
56			CHARACTER *9 tagname
57	jmc	1.5	#endif
58
59			LOGICAL DIFF_PHASE_MULTIPLE
60			EXTERNAL DIFF_PHASE_MULTIPLE
61	jmc	1.1
62			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
63
64	jmc	1.14	dBugFlag = debugLevel.GT.debLevB .AND. myThid.EQ.1
65	jmc	1.15	dBugUnit = errorMessageUnit
66	jmc	1.14
67	jmc	1.5	c newIter = 1 + myIter
68	jmc	1.1	DO n = 1,nlists
69	jmc	1.5
70			IF ( freq(n).LT.0. ) THEN
71			C-- Select diagnostics list that uses instantaneous output
72
73			freqSec = freq(n)
74			phiSec = phase(n)
75	molod	1.7	time4SnapShot = DIFF_PHASE_MULTIPLE( phiSec, freqSec,
76			& myTime, deltaTclock )
77	molod	1.3	#ifdef ALLOW_FIZHI
78	jmc	1.14	IF ( useFIZHI ) THEN
79			WRITE(tagname,'(A,I2.2)')'diagtag',n
80	molod	1.11	time4SnapShot = alarm2next(tagname,deltaT)
81	jmc	1.14	ENDIF
82	molod	1.3	#endif
83
84	jmc	1.12	DO bj=myByLo(myThid), myByHi(myThid)
85			DO bi=myBxLo(myThid), myBxHi(myThid)
86			IF ( time4SnapShot ) THEN
87			C-- switch ON diagnostics of output-stream # n
88			DO m=1,nActive(n)
89			c nd = jdiag(m,n)
90			c IF (ndiag(nd).NE.0) WRITE(0,*) myIter,nd,ndiag(nd),' ->',0
91			ip = idiag(m,n)
92			IF (ip.GT.0) ndiag(ip,bi,bj) = 0
93			ENDDO
94			ELSE
95			C-- switch OFF diagnostics of output-stream # n
96			DO m=1,nActive(n)
97			c nd = jdiag(m,n)
98			c IF (ndiag(nd).NE.-1) WRITE(0,*) myIter,nd,ndiag(nd),' ->',-1
99			ip = idiag(m,n)
100			IF (ip.GT.0) ndiag(ip,bi,bj) = -1
101			ENDDO
102			ENDIF
103			ENDDO
104			ENDDO
105	jmc	1.1
106	jmc	1.14	C-- list with instantaneous output: end
107	jmc	1.1	ENDIF
108	jmc	1.14
109			IF ( averageCycle(n).GT.1 ) THEN
110			C-- Select diagnostics list that uses periodic averaging
111			xInterval = myTime + deltaTclock*0.5 _d 0 - averagePhase(n)
112			xInterval = xInterval / averageFreq(n)
113			IF ( xInterval.GE.0. ) THEN
114			nInterval = INT(xInterval)
115			ELSE
116			nInterval = 1 + INT( -xInterval/FLOAT(averageCycle(n)) )
117			nInterval = nInterval*averageCycle(n) + INT(xInterval) - 1
118			ENDIF
119			nInterval = MOD(nInterval,averageCycle(n))
120
121			C- check future value of pdiag:
122			IF (dBugFlag.AND.pdiag(n,1,1).NE.nInterval)
123	jmc	1.15	& WRITE(dBugUnit,'(A,I8,3(A,I3),F17.6)')
124			& 'DIAG_SWITCH_ONOFF: at it=', myIter, ', list:', n,
125			& ' switch', pdiag(n,1,1),' ->', nInterval, xInterval
126	jmc	1.14	IF ( nInterval.LT.0 .OR. nInterval.GE.averageCycle(n) ) THEN
127			WRITE(msgBuf,'(2A,I2,A,I4)') 'DIAGNOSTICS_SWITCH_ONOFF:',
128			& ' error setting pdiag(n=',n,') to:', nInterval
129			CALL PRINT_ERROR( msgBuf , myThid )
130			WRITE(msgBuf,'(2A,I3,A,F17.6)') 'DIAGNOSTICS_SWITCH_ONOFF:',
131			& ' cycle=', averageCycle(n), ', xInt=', xInterval
132			CALL PRINT_ERROR( msgBuf , myThid )
133			STOP 'ABNORMAL END: S/R DIAGNOSTICS_SWITCH_ONOFF'
134			ENDIF
135
136			DO bj=myByLo(myThid), myByHi(myThid)
137			DO bi=myBxLo(myThid), myBxHi(myThid)
138			pdiag(n,bi,bj) = nInterval
139			ENDDO
140			ENDDO
141			C-- list with periodic averaging: end
142			ENDIF
143
144	jmc	1.1	ENDDO
145
146	jmc	1.9	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
147
148			DO n = 1,diagSt_nbLists
149
150			IF ( diagSt_freq(n).LT.0. ) THEN
151			C-- Select diagnostics list that uses instantaneous output
152
153			dBugFlag = debugLevel.GT.debLevB
154
155			freqSec = diagSt_freq(n)
156			phiSec = diagSt_phase(n)
157			time4SnapShot = DIFF_PHASE_MULTIPLE( phiSec, freqSec,
158			& myTime, deltaTclock )
159
160	jmc	1.10	#ifdef ALLOW_FIZHI
161	jmc	1.14	IF ( useFIZHI ) THEN
162			WRITE(tagname,'(A,I2.2)')'diagStg',n
163	molod	1.13	time4SnapShot = alarm2next(tagname,deltaT)
164	jmc	1.14	ENDIF
165	jmc	1.10	#endif
166
167	jmc	1.9	DO bj=myByLo(myThid), myByHi(myThid)
168			DO bi=myBxLo(myThid), myBxHi(myThid)
169			dBugFlag = dBugFlag.AND.(bi.EQ.1.AND.bj.EQ.1.AND.myThid.EQ.1)
170			IF ( time4SnapShot ) THEN
171			C-- switch ON diagnostics of output-stream # n
172			DO m=1,diagSt_nbActv(n)
173	jmc	1.12	iSp = iSdiag(m,n)
174			IF (iSp.GT.0) THEN
175			nd = jSdiag(m,n)
176			IF (dBugFlag.AND.qSdiag(0,0,iSp,bi,bj).NE. 0.)
177	jmc	1.15	& WRITE(dBugUnit,'(A,I8,A,I4,3A,1PE10.3,A,I3)')
178			& 'DIAG_SWITCH_ONOFF: at it=', myIter, ' diag:', nd,
179			& ' ',cdiag(nd),' :',qSdiag(0,0,iSp,bi,bj),' ->', 0
180	jmc	1.12	qSdiag(0,0,iSp,bi,bj) = 0.
181			ENDIF
182	jmc	1.9	ENDDO
183			ELSE
184			C-- switch OFF diagnostics of output-stream # n
185			DO m=1,diagSt_nbActv(n)
186	jmc	1.12	iSp = iSdiag(m,n)
187			IF (iSp.GT.0) THEN
188			nd = jSdiag(m,n)
189			IF (dBugFlag.AND.qSdiag(0,0,iSp,bi,bj).NE.-1.)
190	jmc	1.15	& WRITE(dBugUnit,'(A,I8,A,I4,3A,1PE10.3,A,I3)')
191			& 'DIAG_SWITCH_ONOFF: at it=', myIter, ' diag:', nd,
192			& ' ',cdiag(nd),' :',qSdiag(0,0,iSp,bi,bj),' ->', -1
193	jmc	1.12	qSdiag(0,0,iSp,bi,bj) = -1.
194			ENDIF
195	jmc	1.9	ENDDO
196			ENDIF
197			ENDDO
198			ENDDO
199
200			ENDIF
201			ENDDO
202
203	jmc	1.1	RETURN
204			END