pkg/exf/exf_adjoint_snapshots__g.F

8ee0cbb22d Patr*0001 #include "EXF_OPTIONS.h"
57c22ecc45 Jean*0002 #include "AD_CONFIG.h"
5459551853 Jean*0003 #ifdef ALLOW_AUTODIFF
                0004 # include "AUTODIFF_OPTIONS.h"
                0005 #endif
98238efc8b Patr*0006
                0007 CBOP
5459551853 Jean*0008 C     !ROUTINE: G_EXF_ADJOINT_SNAPSHOTS
98238efc8b Patr*0009 C     !INTERFACE:
5459551853 Jean*0010       SUBROUTINE G_EXF_ADJOINT_SNAPSHOTS(
                0011      I                 iwhen, myTime, myIter, myThid )
98238efc8b Patr*0012
                0013 C     !DESCRIPTION: \bv
                0014 C     *==========================================================*
5459551853 Jean*0015 C     | SUBROUTINE G_EXF_ADJOINT_SNAPSHOTS                       |
98238efc8b Patr*0016 C     *==========================================================*
5459551853 Jean*0017 C     Tangent-Linear version of EXF Adjoint-variable output S/R:
                0018 C     extract tangent linear variable from TAMC/TAF-generated
98238efc8b Patr*0019 C     tangent linear common blocks, contained in g_common.h
                0020 C     and write fields to file;
                0021 C     Make sure common blocks in g_common.h are up-to-date
                0022 C     w.r.t. current adjoint code.
                0023 C     *==========================================================*
5459551853 Jean*0024 C     | SUBROUTINE G_EXF_ADJOINT_SNAPSHOTS                       |
98238efc8b Patr*0025 C     *==========================================================*
                0026 C     \ev
                0027
                0028 C     !USES:
                0029       IMPLICIT NONE
                0030 C     == Global variables ===
                0031 #include "SIZE.h"
                0032 #include "EEPARAMS.h"
                0033 #include "PARAMS.h"
40c4aecbbc Jean*0034 #include "EXF_PARAM.h"
98238efc8b Patr*0035 #ifdef ALLOW_AUTODIFF_MONITOR
                0036 # include "g_common.h"
                0037 #endif
                0038
                0039 C     !INPUT/OUTPUT PARAMETERS:
5459551853 Jean*0040 C     iwhen  :: indicates where this S/R is called from
                0041 C     myIter :: Iteration counter for this thread
                0042 C     myTime :: Time counter for this thread
40c4aecbbc Jean*0043 C     myThid :: Thread number for this instance of the routine.
                0044       INTEGER iwhen
                0045       _RL     myTime
                0046       INTEGER myIter
                0047       INTEGER myThid
98238efc8b Patr*0048
                0049 #ifdef ALLOW_TANGENTLINEAR_RUN
                0050 #ifdef ALLOW_AUTODIFF_MONITOR
                0051
40c4aecbbc Jean*0052 C     !FUNCTIONS:
                0053       LOGICAL  DIFFERENT_MULTIPLE
                0054       EXTERNAL DIFFERENT_MULTIPLE
                0055
98238efc8b Patr*0056 C     !LOCAL VARIABLES:
40c4aecbbc Jean*0057 C     suff   :: Hold suffix part of a filename
                0058 C     msgBuf :: Error message buffer
df5a9764ba Jean*0059       CHARACTER*(10) suff
40c4aecbbc Jean*0060 c     CHARACTER*(MAX_LEN_MBUF) msgBuf
98238efc8b Patr*0061 CEOP
                0062
                0063       IF (useEXF) THEN
40c4aecbbc Jean*0064        IF (
                0065      &      DIFFERENT_MULTIPLE(adjDumpFreq,myTime,deltaTClock)
                0066      &    ) THEN
98238efc8b Patr*0067
40c4aecbbc Jean*0068         CALL TIMER_START('I/O (WRITE)        [TLM LOOP]', myThid )
98238efc8b Patr*0069
                0070 C--     Set suffix for this set of data files.
df5a9764ba Jean*0071         IF ( rwSuffixType.EQ.0 ) THEN
                0072           WRITE(suff,'(I10.10)') myIter
                0073         ELSE
                0074           CALL RW_GET_SUFFIX( suff, myTime, myIter, myThid )
                0075         ENDIF
98238efc8b Patr*0076
                0077         IF ( iwhen .EQ.1 ) THEN
                0078
                0079         CALL WRITE_FLD_XY_RL ( 'G_Justress.',
40c4aecbbc Jean*0080      &       suff, g_ustress, myIter, myThid )
98238efc8b Patr*0081         CALL WRITE_FLD_XY_RL ( 'G_Jvstress.',
40c4aecbbc Jean*0082      &       suff, g_vstress, myIter, myThid )
98238efc8b Patr*0083         CALL WRITE_FLD_XY_RL ( 'G_Jhflux.',
40c4aecbbc Jean*0084      &       suff, g_hflux, myIter, myThid )
98238efc8b Patr*0085         CALL WRITE_FLD_XY_RL ( 'G_Jsflux.',
40c4aecbbc Jean*0086      &       suff, g_sflux, myIter, myThid )
98238efc8b Patr*0087
                0088         ELSEIF ( iwhen .EQ.2 ) THEN
                0089
                0090 # ifdef ALLOW_ATM_TEMP
                0091         CALL WRITE_FLD_XY_RL ( 'G_Jatemp.',
40c4aecbbc Jean*0092      &       suff, g_atemp, myIter, myThid )
98238efc8b Patr*0093         CALL WRITE_FLD_XY_RL ( 'G_Jaqh.',
40c4aecbbc Jean*0094      &       suff, g_aqh, myIter, myThid )
98238efc8b Patr*0095         CALL WRITE_FLD_XY_RL ( 'G_Jprecip.',
40c4aecbbc Jean*0096      &       suff, g_precip, myIter, myThid )
98238efc8b Patr*0097 # endif
40c4aecbbc Jean*0098         IF ( useAtmWind ) THEN
                0099           CALL WRITE_FLD_XY_RL ( 'G_Juwind.',
                0100      &         suff, g_uwind, myIter, myThid )
                0101           CALL WRITE_FLD_XY_RL ( 'G_Jvwind.',
                0102      &         suff, g_vwind, myIter, myThid )
                0103         ENDIF
98238efc8b Patr*0104 # ifdef ALLOW_DOWNWARD_RADIATION
                0105         CALL WRITE_FLD_XY_RL ( 'G_Jswdown.',
40c4aecbbc Jean*0106      &       suff, g_swdown, myIter, myThid )
98238efc8b Patr*0107 # endif
                0108 # ifdef ALLOW_CLIMSST_RELAXATION
                0109         CALL WRITE_FLD_XY_RL ( 'G_Jclimsst.',
40c4aecbbc Jean*0110      &       suff, g_climsst, myIter, myThid )
98238efc8b Patr*0111 # endif
                0112 # ifdef ALLOW_CLIMSSS_RELAXATION
                0113         CALL WRITE_FLD_XY_RL ( 'G_Jclimsss.',
40c4aecbbc Jean*0114      &       suff, g_climsss, myIter, myThid )
98238efc8b Patr*0115 # endif
                0116
                0117         ENDIF
                0118
40c4aecbbc Jean*0119         CALL TIMER_STOP( 'I/O (WRITE)        [TLM LOOP]', myThid )
98238efc8b Patr*0120
40c4aecbbc Jean*0121        ENDIF
98238efc8b Patr*0122       ENDIF
                0123
                0124 #endif /* ALLOW_AUTODIFF_MONITOR */
                0125 #endif /* ALLOW_TANGENTLINEAR_RUN */
                0126
57c22ecc45 Jean*0127       RETURN
                0128       END