/[MITgcm]/MITgcm/pkg/diagnostics/diagnostics_switch_onoff.F
ViewVC logotype

Diff of /MITgcm/pkg/diagnostics/diagnostics_switch_onoff.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.10 by jmc, Sat May 21 22:33:40 2005 UTC revision 1.20 by jmc, Tue Jun 2 20:58:22 2015 UTC
# Line 41  CEOP Line 41  CEOP
41  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
42  C      newIter :: future iteration number  C      newIter :: future iteration number
43  C      j,m,n   :: loop index  C      j,m,n   :: loop index
44  c     CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
45  c     INTEGER newIter  c     INTEGER newIter
46        INTEGER j, m, n        INTEGER m, n, nd
47        INTEGER bi, bj, iSp        INTEGER bi, bj, ip, iSp
48        LOGICAL time4SnapShot        LOGICAL time4SnapShot
49        _RL     phiSec, freqSec        _RL     phiSec, freqSec
50          INTEGER nInterval
51          _RL     xInterval
52        LOGICAL dBugFlag        LOGICAL dBugFlag
53          INTEGER dBugUnit
54  #ifdef ALLOW_FIZHI  #ifdef ALLOW_FIZHI
55        logical alarm2        LOGICAL  ALARM2NEXT
56        character *9 tagname        EXTERNAL ALARM2NEXT
57          CHARACTER *9 tagname
58  #endif  #endif
59    
60        LOGICAL  DIFF_PHASE_MULTIPLE        LOGICAL  DIFF_PHASE_MULTIPLE
61        EXTERNAL DIFF_PHASE_MULTIPLE        EXTERNAL DIFF_PHASE_MULTIPLE
62    
       _BEGIN_MASTER(myThid)  
   
63  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
64    
65          dBugFlag = debugLevel.GE.debLevE .AND. myThid.EQ.1
66          dBugUnit = errorMessageUnit
67    
68    C--   Track diagnostics pkg activation status:
69          IF ( myIter.EQ.nIter0 ) THEN
70    c       IF ( diag_pkgStatus.NE.10 ) STOP
71            _BARRIER
72            _BEGIN_MASTER(myThid)
73            diag_pkgStatus = ready2fillDiags
74            _END_MASTER(myThid)
75            _BARRIER
76    c     ELSEIF
77    c       IF ( diag_pkgStatus.NE.ready2fillDiags ) STOP
78          ENDIF
79    
80  c     newIter = 1 + myIter  c     newIter = 1 + myIter
81        DO n = 1,nlists        DO n = 1,nlists
82    
# Line 69  C--    Select diagnostics list that uses Line 86  C--    Select diagnostics list that uses
86          freqSec = freq(n)          freqSec = freq(n)
87          phiSec = phase(n)          phiSec = phase(n)
88          time4SnapShot = DIFF_PHASE_MULTIPLE( phiSec, freqSec,          time4SnapShot = DIFF_PHASE_MULTIPLE( phiSec, freqSec,
89       &                                       myTime, deltaTclock )       &                                       myTime, deltaTClock )
90  #ifdef ALLOW_FIZHI  #ifdef ALLOW_FIZHI
91          if( useFIZHI) then          IF ( useFIZHI ) THEN
92           write(tagname,'(A,I2.2)')'diagtag',n           WRITE(tagname,'(A,I2.2)')'diagtag',n
93           time4SnapShot = alarm2(tagname)           time4SnapShot = ALARM2NEXT(tagname,deltaT)
94          endif          ENDIF
95  #endif  #endif
96    #ifdef ALLOW_CAL
97            IF ( useCAL ) THEN
98              CALL CAL_TIME2DUMP( phiSec, freqSec, deltaTClock,
99         U                        time4SnapShot,
100         I                        myTime, myIter, myThid )
101            ENDIF
102    #endif /* ALLOW_CAL */
103    
104          IF ( time4SnapShot ) THEN          DO bj=myByLo(myThid), myByHi(myThid)
105  C--     switch ON diagnostics of output-stream # n           DO bi=myBxLo(myThid), myBxHi(myThid)
106            DO m=1,nActive(n)            IF ( time4SnapShot ) THEN
107              j = jdiag(m,n)  C--       switch ON diagnostics of output-stream # n
108  c           IF (ndiag(j).NE.0) WRITE(0,*) myIter,j,ndiag(j),' ->',0              DO m=1,nActive(n)
109              ndiag(j) = 0  c             nd = jdiag(m,n)
110            ENDDO  c             IF (ndiag(nd).NE.0) WRITE(0,*) myIter,nd,ndiag(nd),' ->',0
111                  ip = idiag(m,n)
112                  IF (ip.GT.0) ndiag(ip,bi,bj) = 0
113                ENDDO
114              ELSE
115    C--       switch OFF diagnostics of output-stream # n
116                DO m=1,nActive(n)
117    c             nd = jdiag(m,n)
118    c             IF (ndiag(nd).NE.-1) WRITE(0,*) myIter,nd,ndiag(nd),' ->',-1
119                  ip = idiag(m,n)
120                  IF (ip.GT.0) ndiag(ip,bi,bj) = -1
121                ENDDO
122              ENDIF
123             ENDDO
124            ENDDO
125    
126    C--    list with instantaneous output: end
127           ENDIF
128    
129           IF ( averageCycle(n).GT.1 ) THEN
130    C--    Select diagnostics list that uses periodic averaging
131            xInterval = myTime + deltaTClock*0.5 _d 0 - averagePhase(n)
132            xInterval = xInterval / averageFreq(n)
133            IF ( xInterval.GE.0. ) THEN
134              nInterval = INT(xInterval)
135          ELSE          ELSE
136  C--     switch OFF diagnostics of output-stream # n            nInterval = 1 + INT( -xInterval/FLOAT(averageCycle(n)) )
137            DO m=1,nActive(n)            nInterval = nInterval*averageCycle(n) + INT(xInterval) - 1
             j = jdiag(m,n)  
 c           IF (ndiag(j).NE.-1) WRITE(0,*) myIter,j,ndiag(j),' ->',-1  
             ndiag(j) = -1  
           ENDDO  
138          ENDIF          ENDIF
139            nInterval = MOD(nInterval,averageCycle(n))
140    
141         ENDIF  C-     check future value of pdiag:
142        ENDDO          IF (dBugFlag.AND.pdiag(n,1,1).NE.nInterval)
143         &    WRITE(dBugUnit,'(A,I8,3(A,I4),F17.6)')
144         &     'DIAG_SWITCH_ONOFF: at it=', myIter, ', list:', n,
145         &     ' switch', pdiag(n,1,1),' ->', nInterval, xInterval
146            IF ( nInterval.LT.0 .OR. nInterval.GE.averageCycle(n) ) THEN
147              WRITE(msgBuf,'(2A,I3,A,I4)') 'DIAGNOSTICS_SWITCH_ONOFF:',
148         &       ' error setting pdiag(n=',n,') to:', nInterval
149              CALL PRINT_ERROR( msgBuf , myThid )
150              WRITE(msgBuf,'(2A,I4,A,F17.6)') 'DIAGNOSTICS_SWITCH_ONOFF:',
151         &       ' cycle=', averageCycle(n), ', xInt=', xInterval
152              CALL PRINT_ERROR( msgBuf , myThid )
153              STOP 'ABNORMAL END: S/R DIAGNOSTICS_SWITCH_ONOFF'
154            ENDIF
155    
156        _END_MASTER(myThid)          DO bj=myByLo(myThid), myByHi(myThid)
157             DO bi=myBxLo(myThid), myBxHi(myThid)
158               pdiag(n,bi,bj) = nInterval
159             ENDDO
160            ENDDO
161    C--    list with periodic averaging: end
162           ENDIF
163    
164  C-jmc: do we need a "BARRIER" at this point ?        ENDDO
 c     _BARRIER  
165    
166  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
167    
# Line 108  C---+----1----+----2----+----3----+----4 Line 170  C---+----1----+----2----+----3----+----4
170         IF ( diagSt_freq(n).LT.0. ) THEN         IF ( diagSt_freq(n).LT.0. ) THEN
171  C--    Select diagnostics list that uses instantaneous output  C--    Select diagnostics list that uses instantaneous output
172    
173          dBugFlag = debugLevel.GT.debLevB          dBugFlag = debugLevel.GE.debLevE
174    
175          freqSec = diagSt_freq(n)          freqSec = diagSt_freq(n)
176          phiSec = diagSt_phase(n)          phiSec = diagSt_phase(n)
177          time4SnapShot = DIFF_PHASE_MULTIPLE( phiSec, freqSec,          time4SnapShot = DIFF_PHASE_MULTIPLE( phiSec, freqSec,
178       &                                       myTime, deltaTclock )       &                                       myTime, deltaTClock )
179    
180  #ifdef ALLOW_FIZHI  #ifdef ALLOW_FIZHI
181          if( useFIZHI) then          IF ( useFIZHI ) THEN
182           write(tagname,'(A,I2.2)')'diagStg',n           WRITE(tagname,'(A,I2.2)')'diagStg',n
183           time4SnapShot = alarm2(tagname)           time4SnapShot = ALARM2NEXT(tagname,deltaT)
184          endif          ENDIF
185  #endif  #endif
186    #ifdef ALLOW_CAL
187            IF ( useCAL ) THEN
188              CALL CAL_TIME2DUMP( phiSec, freqSec, deltaTClock,
189         U                        time4SnapShot,
190         I                        myTime, myIter, myThid )
191            ENDIF
192    #endif /* ALLOW_CAL */
193    
194          DO bj=myByLo(myThid), myByHi(myThid)          DO bj=myByLo(myThid), myByHi(myThid)
195           DO bi=myBxLo(myThid), myBxHi(myThid)           DO bi=myBxLo(myThid), myBxHi(myThid)
# Line 128  C--    Select diagnostics list that uses Line 197  C--    Select diagnostics list that uses
197            IF ( time4SnapShot ) THEN            IF ( time4SnapShot ) THEN
198  C--     switch ON diagnostics of output-stream # n  C--     switch ON diagnostics of output-stream # n
199              DO m=1,diagSt_nbActv(n)              DO m=1,diagSt_nbActv(n)
200                j = jSdiag(m,n)               iSp = iSdiag(m,n)
201                iSp = iSdiag(j)               IF (iSp.GT.0) THEN
202                IF (dBugFlag.AND.qSdiag(0,0,iSp,bi,bj).NE. 0.)                 nd = jSdiag(m,n)
203       &          WRITE(0,'(I8,I4,3A,1PE10.3,A,I3)') myIter,                 IF (dBugFlag.AND.qSdiag(0,0,iSp,bi,bj).NE. 0.)
204       &            j,' ',cdiag(j),' :',qSdiag(0,0,iSp,bi,bj),' ->', 0       &          WRITE(dBugUnit,'(A,I8,A,I6,3A,1PE10.3,A,I3)')
205                qSdiag(0,0,iSp,bi,bj) = 0.       &           'DIAG_SWITCH_ONOFF: at it=', myIter, ' diag:', nd,
206         &           ' ',cdiag(nd),' :',qSdiag(0,0,iSp,bi,bj),' ->', 0
207                   qSdiag(0,0,iSp,bi,bj) = 0.
208                 ENDIF
209              ENDDO              ENDDO
210            ELSE            ELSE
211  C--     switch OFF diagnostics of output-stream # n  C--     switch OFF diagnostics of output-stream # n
212              DO m=1,diagSt_nbActv(n)              DO m=1,diagSt_nbActv(n)
213                j = jSdiag(m,n)               iSp = iSdiag(m,n)
214                iSp = iSdiag(j)               IF (iSp.GT.0) THEN
215                IF (dBugFlag.AND.qSdiag(0,0,iSp,bi,bj).NE.-1.)                 nd = jSdiag(m,n)
216       &          WRITE(0,'(I8,I4,3A,1PE10.3,A,I3)') myIter,                 IF (dBugFlag.AND.qSdiag(0,0,iSp,bi,bj).NE.-1.)
217       &            j,' ',cdiag(j),' :',qSdiag(0,0,iSp,bi,bj),' ->',-1       &          WRITE(dBugUnit,'(A,I8,A,I6,3A,1PE10.3,A,I3)')
218                qSdiag(0,0,iSp,bi,bj) = -1.       &           'DIAG_SWITCH_ONOFF: at it=', myIter, ' diag:', nd,
219         &           ' ',cdiag(nd),' :',qSdiag(0,0,iSp,bi,bj),' ->', -1
220                   qSdiag(0,0,iSp,bi,bj) = -1.
221                 ENDIF
222              ENDDO              ENDDO
223            ENDIF            ENDIF
224           ENDDO           ENDDO
Legend:
Removed from v.1.10  
changed lines
  Added in v.1.20
  ViewVC Help
Powered by ViewVC 1.1.22