pkg/diagnostics/diagnostics_write_adj.F

a5ec81ed49 Timo*0001 #include "DIAG_OPTIONS.h"
                0002
41c4545f8f Jean*0003       SUBROUTINE DIAGNOSTICS_WRITE_ADJ(
b4c3946106 Timo*0004      I                               modelStart,
a5ec81ed49 Timo*0005      I                               myTime, myIter, myThid )
                0006 C***********************************************************************
                0007 C  Purpose
                0008 C  -------
                0009 C    Output sequence for adjoint diagnostic variables
                0010 C    Note: This closely mirrors diagnostics_write but is separated for
                0011 C          clarity
                0012 C    Note: For snapshots, mirror adjDump time step convention rather
                0013 C          than forward model diagnostic convention.
                0014 C
                0015 C  Arguments  Description
                0016 C  ----------------------
b4c3946106 Timo*0017 C     modelStart :: true if call at start of model run.
a10c595eb6 Timo*0018 C              :: (this is the adjoint s modelEnd)
a5ec81ed49 Timo*0019 C     myTime   :: Current time of simulation ( s )
                0020 C     myIter   :: Current Iteration Number
                0021 C     myThid   :: my Thread Id number
                0022 C***********************************************************************
                0023        IMPLICIT NONE
                0024 #include "EEPARAMS.h"
                0025 #include "SIZE.h"
                0026 #include "DIAGNOSTICS_SIZE.h"
                0027 #include "PARAMS.h"
                0028 #include "DIAGNOSTICS.h"
                0029
                0030 C     !INPUT PARAMETERS:
b4c3946106 Timo*0031       LOGICAL modelStart
a5ec81ed49 Timo*0032       _RL     myTime
                0033       INTEGER myIter, myThid
                0034
                0035 C     !FUNCTIONS:
                0036       LOGICAL  DIFF_PHASE_MULTIPLE
                0037       EXTERNAL DIFF_PHASE_MULTIPLE
                0038 #ifdef ALLOW_FIZHI
                0039       LOGICAL  ALARM2
                0040       EXTERNAL ALARM2
                0041 #endif
                0042
                0043 c Local variables
                0044 c ===============
                0045       INTEGER   n, nd
                0046       INTEGER   myItM1, wrIter
                0047       LOGICAL   dump2fileNow, write2file
                0048       LOGICAL   writeDiags(numLists)
                0049       _RL       phiSec, freqSec, wrTime
                0050 #ifdef ALLOW_FIZHI
                0051       CHARACTER *9 tagname
                0052 #endif
                0053
                0054       myItM1 = myIter - 1
                0055
                0056 C***********************************************************************
                0057 C***   Check to see if its time for Diagnostic Output                ***
                0058 C***********************************************************************
                0059
                0060       write2file = .FALSE.
                0061       DO n = 1,nlists
                0062         nd = ABS(jdiag(1,n))
                0063         IF ( gdiag(nd)(4:4).EQ.'A' ) THEN
                0064           freqSec = freq(n)
                0065           phiSec = phase(n)
                0066
                0067 C   Want time step of adjoint state variables to match actual time step
                0068 C   to mirror ADJdump
                0069           wrIter = myIter
                0070           wrTime = myTime
                0071
                0072           dump2fileNow = DIFF_PHASE_MULTIPLE( phiSec, freqSec,
                0073      &                                        wrTime, deltaTClock )
                0074 #ifdef ALLOW_FIZHI
                0075           IF ( useFIZHI ) THEN
                0076             WRITE(tagname,'(A,I2.2)')'diagtag',n
                0077             dump2fileNow = ALARM2(tagname)
                0078           ENDIF
                0079 #endif
                0080 #ifdef ALLOW_CAL
                0081           IF ( useCAL ) THEN
                0082             CALL CAL_TIME2DUMP( phiSec, freqSec, deltaTClock,
                0083      U                          dump2fileNow,
                0084      I                          wrTime, myIter, myThid )
                0085           ENDIF
                0086 #endif /* ALLOW_CAL */
b4c3946106 Timo*0087           IF ( dumpAtLast .AND. modelStart
a5ec81ed49 Timo*0088      &                    .AND. freqSec.GE.0. ) dump2fileNow = .TRUE.
                0089           IF ( dump2fileNow ) THEN
                0090             write2file = .TRUE.
                0091             CALL DIAGNOSTICS_OUT(n,wrTime,wrIter,myThid)
                0092           ENDIF
                0093           writeDiags(n) = dump2fileNow
                0094         ELSE
                0095           writeDiags(n) = .FALSE.
                0096 C       end if ( adj var )
                0097         ENDIF
                0098 C-    end loop on list id number n
                0099       ENDDO
                0100
                0101 C--- No Statistics Diag. Output for adjoint variables
                0102
                0103 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0104
                0105       IF ( write2file ) THEN
41c4545f8f Jean*0106         IF ( diag_dBugLevel.GE.debLevC ) THEN
                0107           CALL DIAGNOSTICS_SUMMARY( -1, myTime, myIter, myThid )
a5ec81ed49 Timo*0108         ENDIF
                0109 C-    wait for everyone before setting arrays to zero:
                0110         _BARRIER
                0111       ENDIF
                0112
acacc28f7f Jean*0113 c     IF ( modelStart ) THEN
                0114 C-    Track diagnostics pkg activation status:
                0115 C  Note: switching off diag_pkgStatus does not work since few ADJ-diags
                0116 C      are filled outside S/R FORWARD_STEP_AD (e.g., "ADJetan " from
                0117 C      initialise_varia_ad -> integr_continuity_ad. -> addummy_for_etan )
                0118 cc      IF ( diag_pkgStatus.NE.ready2fillDiags ) STOP
                0119 c       _BARRIER
                0120 c       _BEGIN_MASTER(myThid)
                0121 c       diag_pkgStatus = 99
                0122 c       _END_MASTER(myThid)
                0123 c       _BARRIER
                0124 c     ENDIF
                0125
                0126 C--   Clear storage space:
a5ec81ed49 Timo*0127       DO n = 1,nlists
                0128         IF ( writeDiags(n) ) CALL DIAGNOSTICS_CLEAR(n,myThid)
                0129       ENDDO
                0130
                0131 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0132
                0133       RETURN
                0134       END