pkg/diagnostics/diagnostics_write.F

c90c060abd Ed H*0001 #include "DIAG_OPTIONS.h"
                0002
41c4545f8f Jean*0003       SUBROUTINE DIAGNOSTICS_WRITE(
                0004      I                              modelEnd,
                0005      I                              myTime, myIter, myThid )
b6086015d9 Andr*0006 C***********************************************************************
                0007 C  Purpose
                0008 C  -------
12f51d4195 Andr*0009 C    Output sequence for the (multiple) diagnostics output files
b6086015d9 Andr*0010 C
                0011 C  Arguments  Description
                0012 C  ----------------------
0e67b80d33 Jean*0013 C     modelEnd :: true if call at end of model run.
                0014 C     myTime   :: Current time of simulation ( s )
                0015 C     myIter   :: Current Iteration Number
                0016 C     myThid   :: my Thread Id number
b6086015d9 Andr*0017 C***********************************************************************
337bea277a Jean*0018        IMPLICIT NONE
485794f4d1 Jean*0019 #include "EEPARAMS.h"
b6086015d9 Andr*0020 #include "SIZE.h"
5a14083c1c Andr*0021 #include "PARAMS.h"
41c4545f8f Jean*0022 #include "DIAGNOSTICS_SIZE.h"
                0023 #include "DIAGNOSTICS_P2SHARE.h"
485794f4d1 Jean*0024 #include "DIAGNOSTICS.h"
b6086015d9 Andr*0025
509dcf5e56 Jean*0026 C     !INPUT PARAMETERS:
0e67b80d33 Jean*0027       LOGICAL modelEnd
06fccc09ae Jean*0028       _RL     myTime
337bea277a Jean*0029       INTEGER myIter, myThid
b6086015d9 Andr*0030
7cd2cae0c5 Jean*0031 C     !FUNCTIONS:
                0032       LOGICAL  DIFF_PHASE_MULTIPLE
                0033       EXTERNAL DIFF_PHASE_MULTIPLE
                0034 #ifdef ALLOW_FIZHI
                0035       LOGICAL  ALARM2
                0036       EXTERNAL ALARM2
                0037 #endif
                0038
b6086015d9 Andr*0039 c Local variables
                0040 c ===============
a5ec81ed49 Timo*0041       INTEGER   n, nd
06fccc09ae Jean*0042       INTEGER   myItM1, wrIter
3ae5f90260 Jean*0043       LOGICAL   dump2fileNow, write2file
a5ec81ed49 Timo*0044       LOGICAL   writeDiags(numLists), writeStats(numLists)
509dcf5e56 Jean*0045       _RL       phiSec, freqSec, wrTime
                0046 #ifdef ALLOW_FIZHI
666b944083 Jean*0047       CHARACTER *9 tagname
509dcf5e56 Jean*0048 #endif
                0049
06fccc09ae Jean*0050       IF ( myIter.NE.nIter0 ) THEN
                0051         myItM1 = myIter - 1
b6086015d9 Andr*0052
                0053 C***********************************************************************
81ae78132d Jean*0054 C***   Check to see if its time for Diagnostic Output                ***
b6086015d9 Andr*0055 C***********************************************************************
337bea277a Jean*0056
3ae5f90260 Jean*0057         write2file = .FALSE.
337bea277a Jean*0058         DO n = 1,nlists
509dcf5e56 Jean*0059           freqSec = freq(n)
                0060           phiSec = phase(n)
463845a645 Andr*0061
509dcf5e56 Jean*0062           IF ( freqSec.LT.0. ) THEN
3ae5f90260 Jean*0063 C--     write snap-shot with suffix = myIter to be consistent with
06fccc09ae Jean*0064 C       time-average diagnostics (e.g., freq=-1 & freq=1):
                0065 c           wrIter = myIter
509dcf5e56 Jean*0066 c           wrTime = myTime
06fccc09ae Jean*0067 C--     write snap-shot with suffix = myIter-1 to be consistent with
                0068 C       state-variable time-step:
                0069             wrIter = myItM1
7cd2cae0c5 Jean*0070             wrTime = myTime - deltaTClock
06fccc09ae Jean*0071           ELSE
                0072             wrIter = myIter
509dcf5e56 Jean*0073             wrTime = myTime
06fccc09ae Jean*0074           ENDIF
3ae5f90260 Jean*0075           dump2fileNow = DIFF_PHASE_MULTIPLE( phiSec, freqSec,
7cd2cae0c5 Jean*0076      &                                        wrTime, deltaTClock )
333e96bf9c Andr*0077 #ifdef ALLOW_FIZHI
666b944083 Jean*0078           IF ( useFIZHI ) THEN
a5ec81ed49 Timo*0079             WRITE(tagname,'(A,I2.2)')'diagtag',n
                0080             dump2fileNow = ALARM2(tagname)
742cf4499c Jean*0081           ENDIF
333e96bf9c Andr*0082 #endif
fc64655a31 Dimi*0083 #ifdef ALLOW_CAL
742cf4499c Jean*0084           IF ( useCAL ) THEN
1c963f3387 Jean*0085             CALL CAL_TIME2DUMP( phiSec, freqSec, deltaTClock,
742cf4499c Jean*0086      U                          dump2fileNow,
e99201df55 Jean*0087      I                          wrTime, myIter, myThid )
fc64655a31 Dimi*0088           ENDIF
742cf4499c Jean*0089 #endif /* ALLOW_CAL */
0e67b80d33 Jean*0090           IF ( dumpAtLast .AND. modelEnd
81ae78132d Jean*0091      &                    .AND. freqSec.GE.0. ) dump2fileNow = .TRUE.
a5ec81ed49 Timo*0092           IF ( useDiag4AdjOutp ) THEN
                0093             nd = ABS(jdiag(1,n))
                0094             IF ( gdiag(nd)(4:4).EQ.'A' ) dump2fileNow = .FALSE.
                0095           ENDIF
81ae78132d Jean*0096           IF ( dump2fileNow ) THEN
3ae5f90260 Jean*0097             write2file = .TRUE.
380c427652 Jean*0098             CALL DIAGNOSTICS_OUT(n,wrTime,wrIter,myThid)
337bea277a Jean*0099           ENDIF
a5ec81ed49 Timo*0100           writeDiags(n) = dump2fileNow
                0101 C-      end loop on list id number n
337bea277a Jean*0102         ENDDO
                0103
81ae78132d Jean*0104 C---   Check to see if its time for Statistics Diag. Output
3e5de6a370 Jean*0105
                0106         DO n = 1,diagSt_nbLists
                0107           freqSec = diagSt_freq(n)
                0108           phiSec = diagSt_phase(n)
                0109
                0110           IF ( freqSec.LT.0. ) THEN
3ae5f90260 Jean*0111 C--     write snap-shot with suffix = myIter to be consistent with
3e5de6a370 Jean*0112 C       time-average diagnostics (e.g., freq=-1 & freq=1):
                0113 c           wrIter = myIter
                0114 c           wrTime = myTime
                0115 C--     write snap-shot with suffix = myIter-1 to be consistent with
                0116 C       state-variable time-step:
                0117             wrIter = myItM1
7cd2cae0c5 Jean*0118             wrTime = myTime - deltaTClock
3e5de6a370 Jean*0119           ELSE
                0120             wrIter = myIter
                0121             wrTime = myTime
                0122           ENDIF
3ae5f90260 Jean*0123           dump2fileNow = DIFF_PHASE_MULTIPLE( phiSec, freqSec,
7cd2cae0c5 Jean*0124      &                                        wrTime, deltaTClock )
0ca8304c4f Jean*0125 #ifdef ALLOW_FIZHI
666b944083 Jean*0126           IF ( useFIZHI ) THEN
                0127            WRITE(tagname,'(A,I2.2)')'diagStg',n
7cd2cae0c5 Jean*0128            dump2fileNow = ALARM2(tagname)
742cf4499c Jean*0129           ENDIF
0ca8304c4f Jean*0130 #endif
7cd2cae0c5 Jean*0131 #ifdef ALLOW_CAL
                0132           IF ( useCAL ) THEN
1c963f3387 Jean*0133             CALL CAL_TIME2DUMP( phiSec, freqSec, deltaTClock,
7cd2cae0c5 Jean*0134      U                          dump2fileNow,
e99201df55 Jean*0135      I                          wrTime, myIter, myThid )
7cd2cae0c5 Jean*0136           ENDIF
                0137 #endif /* ALLOW_CAL */
0e67b80d33 Jean*0138           IF ( dumpAtLast .AND. modelEnd
81ae78132d Jean*0139      &                    .AND. freqSec.GE.0. ) dump2fileNow = .TRUE.
                0140           IF ( dump2fileNow ) THEN
3ae5f90260 Jean*0141             write2file = .TRUE.
1c667d5cf3 Ed H*0142             CALL DIAGSTATS_OUTPUT(n,wrTime,wrIter,myThid)
3e5de6a370 Jean*0143           ENDIF
a5ec81ed49 Timo*0144           writeStats(n) = dump2fileNow
                0145 C-      end loop on list id number n
3e5de6a370 Jean*0146         ENDDO
                0147
                0148 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
3ae5f90260 Jean*0149
                0150         IF ( write2file ) THEN
41c4545f8f Jean*0151           IF ( diag_dBugLevel.GE.debLevC ) THEN
                0152             CALL DIAGNOSTICS_SUMMARY( 1, myTime, myIter, myThid )
3ae5f90260 Jean*0153           ENDIF
                0154 C-      wait for everyone before setting arrays to zero:
                0155           _BARRIER
                0156         ENDIF
48ff5fde64 Jean*0157         IF ( modelEnd ) THEN
ab43bc12c4 Jean*0158 C-      Track diagnostics pkg activation status:
                0159 c         IF ( diag_pkgStatus.NE.ready2fillDiags ) STOP
e01144d3ad Jean*0160           _BARRIER
                0161           _BEGIN_MASTER(myThid)
a5ec81ed49 Timo*0162 C ---   Do not disable diagnostics package for adj variables
                0163           IF ( .NOT.useDiag4AdjOutp ) diag_pkgStatus = 99
ab43bc12c4 Jean*0164           _END_MASTER(myThid)
e01144d3ad Jean*0165           _BARRIER
48ff5fde64 Jean*0166 C       Close all Stat-diags output files
                0167           CALL DIAGSTATS_CLOSE_IO( myThid )
                0168         ENDIF
3e5de6a370 Jean*0169
                0170 C--     Clear storage space:
337bea277a Jean*0171         DO n = 1,nlists
a5ec81ed49 Timo*0172           IF ( writeDiags(n) ) CALL DIAGNOSTICS_CLEAR(n,myThid)
337bea277a Jean*0173         ENDDO
3e5de6a370 Jean*0174         DO n = 1,diagSt_nbLists
a5ec81ed49 Timo*0175           IF ( writeStats(n) ) CALL DIAGSTATS_CLEAR( n, myThid )
3e5de6a370 Jean*0176         ENDDO
                0177
337bea277a Jean*0178 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0179       ENDIF
                0180
3ae5f90260 Jean*0181       RETURN
337bea277a Jean*0182       END