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