File indexing completed on 2024-05-11 05:10:55 UTC
view on githubraw file Latest commit 41c4545f on 2024-05-10 15:00:41 UTC
497a20ca68 Patr*0001 #include "SEAICE_OPTIONS.h"
93bee5c6a2 Jean*0002 #include "AD_CONFIG.h"
772b2ed80e Gael*0003 #ifdef ALLOW_AUTODIFF
0004 # include "AUTODIFF_OPTIONS.h"
0005 #endif
497a20ca68 Patr*0006
0007
a10c595eb6 Timo*0008
497a20ca68 Patr*0009
a10c595eb6 Timo*0010 SUBROUTINE SEAICE_AD_DUMP( myTime, myIter, myThid )
497a20ca68 Patr*0011
0012
0013
4545c79864 Jean*0014
497a20ca68 Patr*0015
0016
0017
0018
0019
0020
0021
4545c79864 Jean*0022
497a20ca68 Patr*0023
0024
0025
0026
0027 IMPLICIT NONE
0028
0029
0030 #include "SIZE.h"
0031 #include "EEPARAMS.h"
0032 #include "PARAMS.h"
c8d9ddcff2 Patr*0033 #include "SEAICE_SIZE.h"
b7a8f5427d Patr*0034 #include "SEAICE_PARAMS.h"
497a20ca68 Patr*0035 #ifdef ALLOW_MNC
0036 #include "MNC_PARAMS.h"
0037 #endif
0038 #include "GRID.h"
0039 #ifdef ALLOW_AUTODIFF_MONITOR
6bf91ae0ea Gael*0040 # include "AUTODIFF_PARAMS.h"
0041 # include "AUTODIFF.h"
497a20ca68 Patr*0042 # include "adcommon.h"
a10c595eb6 Timo*0043 # ifdef ALLOW_DIAGNOSTICS
41c4545f8f Jean*0044 # include "DIAGNOSTICS_P2SHARE.h"
a10c595eb6 Timo*0045 # endif
497a20ca68 Patr*0046 #endif
0047
0048
0049
4545c79864 Jean*0050
0051
0052
0053 _RL myTime
0054 INTEGER myIter
0055 INTEGER myThid
497a20ca68 Patr*0056
0057 #if (defined (ALLOW_ADJOINT_RUN) || defined (ALLOW_ADMTLM))
0058 #ifdef ALLOW_AUTODIFF_MONITOR
0059
4545c79864 Jean*0060
0061 LOGICAL DIFFERENT_MULTIPLE
0062 EXTERNAL DIFFERENT_MULTIPLE
0063
497a20ca68 Patr*0064
a10c595eb6 Timo*0065
4545c79864 Jean*0066
0067
a10c595eb6 Timo*0068
4545c79864 Jean*0069
a10c595eb6 Timo*0070 #ifdef ALLOW_MNC
18b4e739f1 Mart*0071 _RL var2Du(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
0072 _RL var2Dv(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
a10c595eb6 Timo*0073 #endif
18b4e739f1 Mart*0074 _RS dumRS(1)
a10c595eb6 Timo*0075 LOGICAL doExch
0076 LOGICAL doDump
497a20ca68 Patr*0077
0078
a10c595eb6 Timo*0079
0080 doDump = DIFFERENT_MULTIPLE( adjDumpFreq, myTime, deltaTClock )
4545c79864 Jean*0081
a10c595eb6 Timo*0082
0083 doExch = doDump
0084 #ifdef ALLOW_DIAGNOSTICS
0085 doExch = doDump .OR. useDiag4AdjOutp
0086 #endif
0087 doExch = doExch .AND. ( dumpAdVarExch.EQ.1 )
18b4e739f1 Mart*0088
a10c595eb6 Timo*0089
0090 IF ( doExch ) THEN
0091 CALL TIMER_START('I/O (WRITE) [ADJOINT LOOP]', myThid )
0092 #ifdef ALLOW_OPENAD
0093
0094 #else /* ALLOW_OPENAD */
0095
0096 # ifdef AUTODIFF_TAMC_COMPATIBILITY
0097 CALL ADEXCH_XY_RL( myThid, adarea )
0098 CALL ADEXCH_XY_RL( myThid, adheff )
0099 CALL ADEXCH_XY_RL( myThid, adhsnow )
0100 CALL ADEXCH_UV_XYZ_RL( .TRUE., myThid, aduice,advice )
0101 # else
0102 CALL ADEXCH_XY_RL( adarea, myThid )
0103 CALL ADEXCH_XY_RL( adheff, myThid )
0104 CALL ADEXCH_XY_RL( adhsnow, myThid )
0105 CALL ADEXCH_UV_3D_RL( aduice,advice, .TRUE., 1, myThid )
0106 # endif /* AUTODIFF_TAMC_COMPATIBILITY */
0107 #endif /* ALLOW_OPENAD */
18b4e739f1 Mart*0108 ENDIF
0109
a10c595eb6 Timo*0110
0111
41c4545f8f Jean*0112
18b4e739f1 Mart*0113
a10c595eb6 Timo*0114
0115
0116
0117 IF ( doDump ) THEN
0118
0119 dumpAdRecSi=dumpAdRecSi+1
0120 CALL TIMER_START('I/O (WRITE) [ADJOINT LOOP]', myThid )
0121 ENDIF
0122
0123
0124
0125
0126 CALL DUMP_ADJ_XY( dumRS, adarea, 'ADJarea ', 'ADJarea.',
0127 & 12, doDump, dumpAdRecSi, myTime, myIter, myThid )
0128 CALL DUMP_ADJ_XY( dumRS, adheff, 'ADJheff ', 'ADJheff.',
0129 & 12, doDump, dumpAdRecSi, myTime, myIter, myThid )
0130 CALL DUMP_ADJ_XY( dumRS, adhsnow, 'ADJhsnow', 'ADJhsnow.',
0131 & 12, doDump, dumpAdRecSi, myTime, myIter, myThid )
45315406aa Mart*0132 # if ( defined SEAICE_CGRID || defined SEAICE_BGRID_DYNAMICS )
a10c595eb6 Timo*0133
0134 CALL DUMP_ADJ_XY_UV(
0135 & dumRS, aduice, 'ADJuice ', 'ADJuice.',
0136 & dumRS, advice, 'ADJvice ', 'ADJvice.',
0137 & 34, doDump, dumpAdRecSi, myTime, myIter, myThid)
0138
45315406aa Mart*0139 # endif
a10c595eb6 Timo*0140
0141 IF ( doDump ) THEN
497a20ca68 Patr*0142 #ifdef ALLOW_MNC
0143 IF (useMNC .AND. autodiff_mnc) THEN
af20bc5e19 Jean*0144
aa753c2639 Mart*0145 CALL MNC_CW_SET_UDIM('adseaice', -1, myThid)
0146 CALL MNC_CW_RL_W_S('D','adseaice',0,0,'T',myTime,myThid)
0147 CALL MNC_CW_SET_UDIM('adseaice', 0, myThid)
0148 CALL MNC_CW_I_W_S('I','adseaice',0,0,'iter',myIter,myThid)
0149 CALL MNC_CW_RL_W_S('D','adseaice',0,0,'model_time',myTime,
0150 & myThid)
497a20ca68 Patr*0151
aa753c2639 Mart*0152 IF (dumpAdVarExch.EQ.2) THEN
0153 CALL COPY_ADVAR_OUTP( dumRS, adarea, var2Du, 1 , 12, myThid )
0154 CALL MNC_CW_RL_W('D','adseaice',0,0,'adarea',
0155 & var2Du, myThid)
0156 CALL COPY_ADVAR_OUTP( dumRS, adheff, var2Du, 1 , 12, myThid )
0157 CALL MNC_CW_RL_W('D','adseaice',0,0,'adheff',
0158 & var2Du, myThid)
0159 CALL COPY_ADVAR_OUTP( dumRS, adhsnow, var2Du, 1 , 12, myThid )
0160 CALL MNC_CW_RL_W('D','adseaice',0,0,'adhsnow',
0161 & var2Du, myThid)
45315406aa Mart*0162 # if ( defined SEAICE_CGRID || defined SEAICE_BGRID_DYNAMICS )
aa753c2639 Mart*0163
0164 CALL COPY_AD_UV_OUTP( dumRS, dumRS, aduice, advice,
0165 & var2Du, var2Dv, 1, 34, myThid )
0166 CALL MNC_CW_RL_W('D','adseaice',0,0,'aduice',
0167 & var2Du, myThid)
0168 CALL MNC_CW_RL_W('D','adseaice',0,0,'advice',
0169 & var2Dv, myThid)
0170
0171 # endif
0172 ELSE
497a20ca68 Patr*0173 CALL MNC_CW_RL_W('D','adseaice',0,0,'adarea',
0174 & adarea, myThid)
0175 CALL MNC_CW_RL_W('D','adseaice',0,0,'adheff',
0176 & adheff, myThid)
0177 CALL MNC_CW_RL_W('D','adseaice',0,0,'adhsnow',
0178 & adhsnow, myThid)
45315406aa Mart*0179 # if ( defined SEAICE_CGRID || defined SEAICE_BGRID_DYNAMICS )
aa753c2639 Mart*0180
0181 CALL MNC_CW_RL_W('D','adseaice',0,0,'aduice',
497a20ca68 Patr*0182 & aduice, myThid)
aa753c2639 Mart*0183 CALL MNC_CW_RL_W('D','adseaice',0,0,'advice',
497a20ca68 Patr*0184 & advice, myThid)
aa753c2639 Mart*0185
497a20ca68 Patr*0186 # endif
aa753c2639 Mart*0187 ENDIF
497a20ca68 Patr*0188
0189 ENDIF
0190 #endif /* ALLOW_MNC */
0191
4545c79864 Jean*0192 CALL TIMER_STOP( 'I/O (WRITE) [ADJOINT LOOP]', myThid )
497a20ca68 Patr*0193
4545c79864 Jean*0194 ENDIF
497a20ca68 Patr*0195
0196 #endif /* ALLOW_AUTODIFF_MONITOR */
0197 #endif /* ALLOW_ADJOINT_RUN */
0198
d4bd695091 Jean*0199 RETURN
0200 END