/[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.6 by jmc, Sun May 15 03:36:19 2005 UTC revision 1.19 by jmc, Wed Aug 14 00:57:33 2013 UTC
# Line 28  C     !USES: Line 28  C     !USES:
28  #include "PARAMS.h"  #include "PARAMS.h"
29  #include "DIAGNOSTICS_SIZE.h"  #include "DIAGNOSTICS_SIZE.h"
30  #include "DIAGNOSTICS.h"  #include "DIAGNOSTICS.h"
 #ifdef ALLOW_FIZHI  
 #include "chronos.h"  
 #endif  
31    
32  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
33  C     myTime     :: current Time of simulation ( s )  C     myTime     :: current Time of simulation ( s )
# Line 44  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, ip, iSp
48        LOGICAL time4SnapShot        LOGICAL time4SnapShot
49        _RL     phiSec, freqSec        _RL     phiSec, freqSec
50          INTEGER nInterval
51          _RL     xInterval
52          LOGICAL dBugFlag
53          INTEGER dBugUnit
54  #ifdef ALLOW_FIZHI  #ifdef ALLOW_FIZHI
55        integer yymmdd,hhmmss,nsecf2        LOGICAL  ALARM2NEXT
56          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            _BEGIN_MASTER(myThid)
71    c       IF ( diag_pkgStatus.NE.10 ) STOP
72            diag_pkgStatus = ready2fillDiags
73            _END_MASTER(myThid)
74    c     ELSEIF
75    c       IF ( diag_pkgStatus.NE.ready2fillDiags ) STOP
76          ENDIF
77    
78  c     newIter = 1 + myIter  c     newIter = 1 + myIter
79        DO n = 1,nlists        DO n = 1,nlists
80    
# Line 68  C--    Select diagnostics list that uses Line 83  C--    Select diagnostics list that uses
83    
84          freqSec = freq(n)          freqSec = freq(n)
85          phiSec = phase(n)          phiSec = phase(n)
86            time4SnapShot = DIFF_PHASE_MULTIPLE( phiSec, freqSec,
87         &                                       myTime, deltaTClock )
88  #ifdef ALLOW_FIZHI  #ifdef ALLOW_FIZHI
89          if( useFIZHI) then          IF ( useFIZHI ) THEN
90           yymmdd = int(freq(n))           WRITE(tagname,'(A,I2.2)')'diagtag',n
91           hhmmss = int((freq(n) - int(freq(n)))*1.e6)           time4SnapShot = ALARM2NEXT(tagname,deltaT)
92           freqSec = nsecf2(hhmmss,yymmdd,nymd)          ENDIF
          yymmdd = int(phase(n))  
          hhmmss = int((phase(n) - int(phase(n)))*1.e6)  
          phiSec = nsecf2(hhmmss,yymmdd,nymd)  
         endif  
93  #endif  #endif
94    #ifdef ALLOW_CAL
95            IF ( useCAL ) THEN
96              CALL CAL_TIME2DUMP( phiSec, freqSec, deltaTClock,
97         U                        time4SnapShot,
98         I                        myTime, myIter, myThid )
99            ENDIF
100    #endif /* ALLOW_CAL */
101    
102          time4SnapShot = DIFF_PHASE_MULTIPLE( phiSec, freqSec,          DO bj=myByLo(myThid), myByHi(myThid)
103       &                                       myTime, deltaTclock )           DO bi=myBxLo(myThid), myBxHi(myThid)
104              IF ( time4SnapShot ) THEN
105    C--       switch ON diagnostics of output-stream # n
106                DO m=1,nActive(n)
107    c             nd = jdiag(m,n)
108    c             IF (ndiag(nd).NE.0) WRITE(0,*) myIter,nd,ndiag(nd),' ->',0
109                  ip = idiag(m,n)
110                  IF (ip.GT.0) ndiag(ip,bi,bj) = 0
111                ENDDO
112              ELSE
113    C--       switch OFF diagnostics of output-stream # n
114                DO m=1,nActive(n)
115    c             nd = jdiag(m,n)
116    c             IF (ndiag(nd).NE.-1) WRITE(0,*) myIter,nd,ndiag(nd),' ->',-1
117                  ip = idiag(m,n)
118                  IF (ip.GT.0) ndiag(ip,bi,bj) = -1
119                ENDDO
120              ENDIF
121             ENDDO
122            ENDDO
123    
124          IF ( time4SnapShot ) THEN  C--    list with instantaneous output: end
125  C--     switch ON diagnostics of output-stream # n         ENDIF
126            DO m=1,nActive(n)  
127              j = jdiag(m,n)         IF ( averageCycle(n).GT.1 ) THEN
128  c           IF (ndiag(j).NE.0) WRITE(0,*) myIter,j,ndiag(j),' ->',0  C--    Select diagnostics list that uses periodic averaging
129              ndiag(j) = 0          xInterval = myTime + deltaTClock*0.5 _d 0 - averagePhase(n)
130            ENDDO          xInterval = xInterval / averageFreq(n)
131            IF ( xInterval.GE.0. ) THEN
132              nInterval = INT(xInterval)
133          ELSE          ELSE
134  C--     switch OFF diagnostics of output-stream # n            nInterval = 1 + INT( -xInterval/FLOAT(averageCycle(n)) )
135            DO m=1,nActive(n)            nInterval = nInterval*averageCycle(n) + INT(xInterval) - 1
136              j = jdiag(m,n)          ENDIF
137  c           IF (ndiag(j).NE.-1) WRITE(0,*) myIter,j,ndiag(j),' ->',-1          nInterval = MOD(nInterval,averageCycle(n))
138              ndiag(j) = -1  
139            ENDDO  C-     check future value of pdiag:
140            IF (dBugFlag.AND.pdiag(n,1,1).NE.nInterval)
141         &    WRITE(dBugUnit,'(A,I8,3(A,I4),F17.6)')
142         &     'DIAG_SWITCH_ONOFF: at it=', myIter, ', list:', n,
143         &     ' switch', pdiag(n,1,1),' ->', nInterval, xInterval
144            IF ( nInterval.LT.0 .OR. nInterval.GE.averageCycle(n) ) THEN
145              WRITE(msgBuf,'(2A,I3,A,I4)') 'DIAGNOSTICS_SWITCH_ONOFF:',
146         &       ' error setting pdiag(n=',n,') to:', nInterval
147              CALL PRINT_ERROR( msgBuf , myThid )
148              WRITE(msgBuf,'(2A,I4,A,F17.6)') 'DIAGNOSTICS_SWITCH_ONOFF:',
149         &       ' cycle=', averageCycle(n), ', xInt=', xInterval
150              CALL PRINT_ERROR( msgBuf , myThid )
151              STOP 'ABNORMAL END: S/R DIAGNOSTICS_SWITCH_ONOFF'
152          ENDIF          ENDIF
153    
154            DO bj=myByLo(myThid), myByHi(myThid)
155             DO bi=myBxLo(myThid), myBxHi(myThid)
156               pdiag(n,bi,bj) = nInterval
157             ENDDO
158            ENDDO
159    C--    list with periodic averaging: end
160         ENDIF         ENDIF
161    
162        ENDDO        ENDDO
163    
164  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
165    
166        _END_MASTER(myThid)        DO n = 1,diagSt_nbLists
167    
168  C-jmc: do we need a "BARRIER" at this point ?         IF ( diagSt_freq(n).LT.0. ) THEN
169  c     _BARRIER  C--    Select diagnostics list that uses instantaneous output
170    
171            dBugFlag = debugLevel.GE.debLevE
172    
173            freqSec = diagSt_freq(n)
174            phiSec = diagSt_phase(n)
175            time4SnapShot = DIFF_PHASE_MULTIPLE( phiSec, freqSec,
176         &                                       myTime, deltaTClock )
177    
178    #ifdef ALLOW_FIZHI
179            IF ( useFIZHI ) THEN
180             WRITE(tagname,'(A,I2.2)')'diagStg',n
181             time4SnapShot = ALARM2NEXT(tagname,deltaT)
182            ENDIF
183    #endif
184    #ifdef ALLOW_CAL
185            IF ( useCAL ) THEN
186              CALL CAL_TIME2DUMP( phiSec, freqSec, deltaTClock,
187         U                        time4SnapShot,
188         I                        myTime, myIter, myThid )
189            ENDIF
190    #endif /* ALLOW_CAL */
191    
192            DO bj=myByLo(myThid), myByHi(myThid)
193             DO bi=myBxLo(myThid), myBxHi(myThid)
194              dBugFlag = dBugFlag.AND.(bi.EQ.1.AND.bj.EQ.1.AND.myThid.EQ.1)
195              IF ( time4SnapShot ) THEN
196    C--     switch ON diagnostics of output-stream # n
197                DO m=1,diagSt_nbActv(n)
198                 iSp = iSdiag(m,n)
199                 IF (iSp.GT.0) THEN
200                   nd = jSdiag(m,n)
201                   IF (dBugFlag.AND.qSdiag(0,0,iSp,bi,bj).NE. 0.)
202         &          WRITE(dBugUnit,'(A,I8,A,I6,3A,1PE10.3,A,I3)')
203         &           'DIAG_SWITCH_ONOFF: at it=', myIter, ' diag:', nd,
204         &           ' ',cdiag(nd),' :',qSdiag(0,0,iSp,bi,bj),' ->', 0
205                   qSdiag(0,0,iSp,bi,bj) = 0.
206                 ENDIF
207                ENDDO
208              ELSE
209    C--     switch OFF diagnostics of output-stream # n
210                DO m=1,diagSt_nbActv(n)
211                 iSp = iSdiag(m,n)
212                 IF (iSp.GT.0) THEN
213                   nd = jSdiag(m,n)
214                   IF (dBugFlag.AND.qSdiag(0,0,iSp,bi,bj).NE.-1.)
215         &          WRITE(dBugUnit,'(A,I8,A,I6,3A,1PE10.3,A,I3)')
216         &           'DIAG_SWITCH_ONOFF: at it=', myIter, ' diag:', nd,
217         &           ' ',cdiag(nd),' :',qSdiag(0,0,iSp,bi,bj),' ->', -1
218                   qSdiag(0,0,iSp,bi,bj) = -1.
219                 ENDIF
220                ENDDO
221              ENDIF
222             ENDDO
223            ENDDO
224    
225           ENDIF
226          ENDDO
227    
228        RETURN        RETURN
229        END        END
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.19
  ViewVC Help
Powered by ViewVC 1.1.22