pkg/exf/exf_adjoint_snapshots_ad.F

98238efc8b Patr*0001 #include "EXF_OPTIONS.h"
57c22ecc45 Jean*0002 #include "AD_CONFIG.h"
35fa3f16b2 An T*0003 #ifdef ALLOW_AUTODIFF
                0004 # include "AUTODIFF_OPTIONS.h"
                0005 #endif
98238efc8b Patr*0006
                0007 CBOP
5459551853 Jean*0008 C     !ROUTINE: ADEXF_ADJOINT_SNAPSHOTS
98238efc8b Patr*0009 C     !INTERFACE:
5459551853 Jean*0010       SUBROUTINE ADEXF_ADJOINT_SNAPSHOTS(
                0011      I                 iwhen, myTime, myIter, myThid )
98238efc8b Patr*0012
                0013 C     !DESCRIPTION: \bv
                0014 C     *==========================================================*
5459551853 Jean*0015 C     | SUBROUTINE ADEXF_ADJOINT_SNAPSHOTS                       |
98238efc8b Patr*0016 C     *==========================================================*
5459551853 Jean*0017 C     Adjoint version of EXF Adjoint-variable output subroutine:
b7b61e618a Mart*0018 C     extract adjoint variable from TAF-generated
98238efc8b Patr*0019 C     adjoint common blocks, contained in adcommon.h
                0020 C     and write fields to file;
                0021 C     Make sure common blocks in adcommon.h are up-to-date
                0022 C     w.r.t. current adjoint code.
                0023 C     *==========================================================*
5459551853 Jean*0024 C     | SUBROUTINE ADEXF_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"
358649780a Gael*0034 #include "EXF_PARAM.h"
98238efc8b Patr*0035 #ifdef ALLOW_MNC
                0036 # include "MNC_PARAMS.h"
                0037 #endif
ef53b829d7 Jean*0038 #include "GRID.h"
35fa3f16b2 An T*0039 #ifdef ALLOW_AUTODIFF
98238efc8b Patr*0040 #ifdef ALLOW_AUTODIFF_MONITOR
6bf91ae0ea Gael*0041 # include "AUTODIFF_PARAMS.h"
                0042 # include "AUTODIFF.h"
98238efc8b Patr*0043 # include "adcommon.h"
                0044 #endif
5459551853 Jean*0045 #endif /* ALLOW_AUTODIFF */
98238efc8b Patr*0046
                0047 C     !INPUT/OUTPUT PARAMETERS:
5459551853 Jean*0048 C     iwhen  :: indicates where this S/R is called from
dbbbf73d12 Jean*0049 C     myTime :: time counter for this thread
                0050 C     myIter :: iteration counter for this thread
                0051 C     myThid :: Thread number for this instance of the routine.
5459551853 Jean*0052       INTEGER iwhen
dbbbf73d12 Jean*0053       _RL     myTime
5459551853 Jean*0054       INTEGER myIter
                0055       INTEGER myThid
98238efc8b Patr*0056
                0057 #if (defined (ALLOW_ADJOINT_RUN) || defined (ALLOW_ADMTLM))
                0058 #ifdef ALLOW_AUTODIFF_MONITOR
                0059
dbbbf73d12 Jean*0060 C     !FUNCTIONS:
                0061       LOGICAL  DIFFERENT_MULTIPLE
                0062       EXTERNAL DIFFERENT_MULTIPLE
                0063
98238efc8b Patr*0064 C     !LOCAL VARIABLES:
dbbbf73d12 Jean*0065 C     suff   :: Hold suffix part of a filename
                0066 C     msgBuf :: Error message buffer
a10c595eb6 Timo*0067 c     CHARACTER*(10) suff
                0068 c     CHARACTER*(MAX_LEN_MBUF) msgBuf
                0069       _RS dumRS(1)
                0070       _RL dumRL(1)
6bf91ae0ea Gael*0071       INTEGER dumpAdRecEx
a10c595eb6 Timo*0072       LOGICAL doDump
98238efc8b Patr*0073 CEOP
                0074
a10c595eb6 Timo*0075 C-----------------------------------------------------------------------
                0076 C--- do dump?
                0077 C-----------------------------------------------------------------------
                0078       doDump = DIFFERENT_MULTIPLE(adjDumpFreq,myTime,deltaTClock)
                0079       IF ( doDump ) THEN
                0080 c     determine ad dump record number (used only if dumpAdByRec is true)
                0081        IF (useSeaice.AND.(iWhen.EQ.3)) THEN
                0082         dumpAdRecEx=dumpAdRecMn+1
                0083        ELSE
                0084         dumpAdRecEx=dumpAdRecMn
                0085        ENDIF
6bf91ae0ea Gael*0086 c#ifdef ALLOW_DEBUG
                0087 c      IF ( debugMode ) print*,'dumpAdRecEx',dumpAdRecEx
                0088 c#endif
a10c595eb6 Timo*0089        CALL TIMER_START('I/O (WRITE)        [ADJOINT LOOP]', myThid )
358649780a Gael*0090       ENDIF
6bf91ae0ea Gael*0091
a10c595eb6 Timo*0092       IF ( iwhen .EQ.1 ) THEN
6bf91ae0ea Gael*0093
a10c595eb6 Timo*0094        CALL DUMP_ADJ_XY_UV(
                0095      &      dumRS, adustress, 'ADJustrs', 'ADJustress.',
                0096      &      dumRS, advstress, 'ADJvstrs', 'ADJvstress.',
5459551853 Jean*0097      &      34, doDump, dumpAdRecEx, myTime, myIter, myThid )
a10c595eb6 Timo*0098        CALL DUMP_ADJ_XY( dumRS, adhflux, 'ADJhflux', 'ADJhflux.',
                0099      &      12, doDump, dumpAdRecEx, myTime, myIter, myThid )
                0100        CALL DUMP_ADJ_XY( dumRS, adsflux, 'ADJsflux', 'ADJsflux.',
                0101      &      12, doDump, dumpAdRecEx, myTime, myIter, myThid )
6bf91ae0ea Gael*0102
a10c595eb6 Timo*0103       ELSEIF ( iwhen .EQ.2 ) THEN
6bf91ae0ea Gael*0104
                0105 # ifdef ALLOW_ATM_TEMP
a10c595eb6 Timo*0106        CALL DUMP_ADJ_XY( dumRS, adatemp, 'ADJatemp', 'ADJatemp.',
                0107      &      12, doDump, dumpAdRecEx, myTime, myIter, myThid )
                0108        CALL DUMP_ADJ_XY( dumRS, adaqh,   'ADJaqh  ', 'ADJaqh.',
                0109      &      12, doDump, dumpAdRecEx, myTime, myIter, myThid )
                0110        CALL DUMP_ADJ_XY( dumRS, adprecip, 'ADJpreci', 'ADJprecip.',
                0111      &      12, doDump, dumpAdRecEx, myTime, myIter, myThid )
6bf91ae0ea Gael*0112 # endif
35fa3f16b2 An T*0113 # ifdef ALLOW_RUNOFF
a10c595eb6 Timo*0114        CALL DUMP_ADJ_XY( dumRS, adrunoff, 'ADJroff ', 'ADJrunoff.',
                0115      &      12, doDump, dumpAdRecEx, myTime, myIter, myThid )
35fa3f16b2 An T*0116 # endif
a10c595eb6 Timo*0117        IF ( useAtmWind ) THEN
                0118         CALL DUMP_ADJ_XY( dumRS, aduwind, 'ADJuwind', 'ADJuwind.',
                0119      &       12, doDump, dumpAdRecEx, myTime, myIter, myThid )
                0120         CALL DUMP_ADJ_XY( dumRS, advwind, 'ADJvwind', 'ADJvwind.',
                0121      &       12, doDump, dumpAdRecEx, myTime, myIter, myThid )
                0122        ENDIF
6bf91ae0ea Gael*0123 # ifdef ALLOW_DOWNWARD_RADIATION
a10c595eb6 Timo*0124        CALL DUMP_ADJ_XY( dumRS, adswdown, 'ADJswdn ', 'ADJswdown.',
                0125      &      12, doDump, dumpAdRecEx, myTime, myIter, myThid )
                0126        CALL DUMP_ADJ_XY( dumRS, adlwdown, 'ADJlwdn ', 'ADJlwdown.',
                0127      &      12, doDump, dumpAdRecEx, myTime, myIter, myThid )
6bf91ae0ea Gael*0128 # endif
                0129 # ifdef ALLOW_CLIMSST_RELAXATION
a10c595eb6 Timo*0130        CALL DUMP_ADJ_XY( dumRS, adclimsst, 'ADJclsst', 'ADJclimsst.',
                0131      &      12, doDump, dumpAdRecEx, myTime, myIter, myThid )
6bf91ae0ea Gael*0132 # endif
                0133 # ifdef ALLOW_CLIMSSS_RELAXATION
a10c595eb6 Timo*0134        CALL DUMP_ADJ_XY( dumRS, adclimsss, 'ADJclsst', 'ADJclimsss.',
                0135      &      12, doDump, dumpAdRecEx, myTime, myIter, myThid )
6bf91ae0ea Gael*0136 # endif
                0137
a10c595eb6 Timo*0138       ELSEIF ( iwhen .EQ.3 ) THEN
98238efc8b Patr*0139
a10c595eb6 Timo*0140        CALL DUMP_ADJ_XY_UV(
                0141      &      adFu, dumRL, 'ADJtaux ', 'ADJtaux.',
                0142      &      adFv, dumRL, 'ADJtauy ', 'ADJtauy.',
5459551853 Jean*0143      &      33, doDump, dumpAdRecEx, myTime, myIter, myThid )
a10c595eb6 Timo*0144        CALL DUMP_ADJ_XY(adQnet, dumRL, 'ADJqnet ', 'ADJqnet.',
5459551853 Jean*0145      &      11, doDump, dumpAdRecEx, myTime, myIter, myThid )
a10c595eb6 Timo*0146        CALL DUMP_ADJ_XY(adEmPmR, dumRL, 'ADJempmr', 'ADJempr.',
5459551853 Jean*0147      &      11, doDump, dumpAdRecEx, myTime, myIter, myThid )
a10c595eb6 Timo*0148 # ifdef SHORTWAVE_HEATING
                0149        CALL DUMP_ADJ_XY(adQsw, dumRL, 'ADJqsw  ', 'ADJqsw.',
5459551853 Jean*0150      &      11, doDump, dumpAdRecEx, myTime, myIter, myThid )
a10c595eb6 Timo*0151 # endif
2d88f797ef Jean*0152
a10c595eb6 Timo*0153       ENDIF
5459551853 Jean*0154
a10c595eb6 Timo*0155       IF ( doDump ) THEN
98238efc8b Patr*0156 #ifdef ALLOW_MNC
                0157         IF (useMNC .AND. autodiff_mnc) THEN
                0158
5459551853 Jean*0159          IF ( iwhen.EQ.1 ) THEN
                0160
98238efc8b Patr*0161           CALL MNC_CW_SET_UDIM('adexf', -1, myThid)
                0162           CALL MNC_CW_RL_W_S('D','adexf',0,0,'T',myTime,myThid)
                0163           CALL MNC_CW_SET_UDIM('adexf', 0, myThid)
                0164           CALL MNC_CW_I_W_S('I','adexf',0,0,'iter',myIter,myThid)
                0165           CALL MNC_CW_RL_W_S('D','adexf',0,0,'model_time',myTime,
                0166      &         myThid)
5459551853 Jean*0167
ef53b829d7 Jean*0168           CALL MNC_CW_RL_W('D','adexf',0,0,'adustress',
98238efc8b Patr*0169      &         adustress, myThid)
                0170           CALL MNC_CW_RL_W('D','adexf',0,0,'advstress',
                0171      &         advstress, myThid)
                0172           CALL MNC_CW_RL_W('D','adexf',0,0,'adhflux',
                0173      &         adhflux, myThid)
                0174           CALL MNC_CW_RL_W('D','adexf',0,0,'adsflux',
                0175      &         adsflux, myThid)
5459551853 Jean*0176          ELSEIF ( iwhen.EQ.2 ) THEN
98238efc8b Patr*0177 # ifdef ALLOW_ATM_TEMP
                0178           CALL MNC_CW_RL_W('D','adexf',0,0,'adatemp',
                0179      &         adatemp, myThid)
                0180           CALL MNC_CW_RL_W('D','adexf',0,0,'adaqh',
                0181      &         adaqh, myThid)
                0182           CALL MNC_CW_RL_W('D','adexf',0,0,'adprecip',
                0183      &         adprecip, myThid)
                0184 # endif
35fa3f16b2 An T*0185 # ifdef ALLOW_RUNOFF
                0186           CALL MNC_CW_RL_W('D','adexf',0,0,'adrunoff',
                0187      &         adrunoff, myThid)
                0188 # endif
5459551853 Jean*0189           IF ( useAtmWind ) THEN
                0190            CALL MNC_CW_RL_W('D','adexf',0,0,'aduwind',
                0191      &          aduwind, myThid)
                0192            CALL MNC_CW_RL_W('D','adexf',0,0,'advwind',
                0193      &          advwind, myThid)
                0194           ENDIF
98238efc8b Patr*0195 # ifdef ALLOW_DOWNWARD_RADIATION
                0196           CALL MNC_CW_RL_W('D','adexf',0,0,'adswdown',
                0197      &         adswdown, myThid)
49219fc174 An T*0198           CALL MNC_CW_RL_W('D','adexf',0,0,'adlwdown',
                0199      &         adlwdown, myThid)
98238efc8b Patr*0200 # endif
                0201 # ifdef ALLOW_CLIMSST_RELAXATION
                0202           CALL MNC_CW_RL_W('D','adexf',0,0,'adclimsst',
                0203      &         adclimsst, myThid)
                0204 # endif
                0205 # ifdef ALLOW_CLIMSSS_RELAXATION
                0206           CALL MNC_CW_RL_W('D','adexf',0,0,'adclimsss',
                0207      &         adclimsss, myThid)
                0208 # endif
5459551853 Jean*0209
                0210          ENDIF
98238efc8b Patr*0211
                0212         ENDIF
                0213 #endif /* ALLOW_MNC */
                0214
a10c595eb6 Timo*0215         CALL TIMER_STOP( 'I/O (WRITE)        [ADJOINT LOOP]', myThid )
98238efc8b Patr*0216       ENDIF
                0217
fb247706a7 Patr*0218 #ifdef ALLOW_MONITOR
                0219       CALL ADEXF_MONITOR ( iwhen, myTime, myIter, myThid )
                0220 #endif
98238efc8b Patr*0221
                0222 #endif /* ALLOW_AUTODIFF_MONITOR */
                0223 #endif /* ALLOW_ADJOINT_RUN */
                0224
57c22ecc45 Jean*0225       RETURN
                0226       END