C $Header: /u/gcmpack/MITgcm/pkg/seaice/seaice_ad_dump.F,v 1.14 2017/03/24 23:51:14 jmc Exp $
C $Name: $
#include "SEAICE_OPTIONS.h"
#include "AD_CONFIG.h"
#ifdef ALLOW_AUTODIFF
# include "AUTODIFF_OPTIONS.h"
#endif
CBOP
C !ROUTINE: seaice_ad_dump
C !INTERFACE:
SUBROUTINE SEAICE_AD_DUMP( myTime, myIter, myThid )
C !DESCRIPTION: \bv
C *==========================================================*
C | SUBROUTINE seaice_ad_dump
C *==========================================================*
C Extract adjoint variable from TAMC/TAF-generated
C adjoint common blocks, contained in adcommon.h
C and write fields to file;
C Make sure common blocks in adcommon.h are up-to-date
C w.r.t. current adjoint code.
C *==========================================================*
C | SUBROUTINE seaice_ad_dump
C *==========================================================*
C \ev
C !USES:
IMPLICIT NONE
C == Global variables ===
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "SEAICE_SIZE.h"
#include "SEAICE_PARAMS.h"
#ifdef ALLOW_MNC
#include "MNC_PARAMS.h"
#endif
#include "GRID.h"
#ifdef ALLOW_AUTODIFF_MONITOR
# include "AUTODIFF_PARAMS.h"
# include "AUTODIFF.h"
# include "adcommon.h"
#endif
C !INPUT/OUTPUT PARAMETERS:
C == Routine arguments ==
C myTime :: time counter for this thread
C myIter :: iteration counter for this thread
C myThid :: Thread number for this instance of the routine.
_RL myTime
INTEGER myIter
INTEGER myThid
#if (defined (ALLOW_ADJOINT_RUN) defined (ALLOW_ADMTLM))
#ifdef ALLOW_AUTODIFF_MONITOR
C !FUNCTIONS:
LOGICAL DIFFERENT_MULTIPLE
EXTERNAL
C !LOCAL VARIABLES:
c == local variables ==
C suff :: Hold suffix part of a filename
C msgBuf :: Error message buffer
CHARACTER*(10) suff
c CHARACTER*(MAX_LEN_MBUF) msgBuf
_RL var2Du(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
_RL var2Dv(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
_RS dumRS(1)
_RL dumRL(1)
CEOP
IF (
& DIFFERENT_MULTIPLE(adjDumpFreq,myTime,deltaTClock)
& ) THEN
CALL TIMER_START('I/O (WRITE) [ADJOINT LOOP]', myThid )
c increment ad dump record number (used only if dumpAdByRec is true)
dumpAdRecSi=dumpAdRecSi+1
c#ifdef ALLOW_DEBUG
c IF ( debugMode ) print*,'dumpAdRecSi',dumpAdRecSi
c#endif
C-- Set suffix for this set of data files.
IF ( rwSuffixType.EQ.0 ) THEN
WRITE(suff,'(I10.10)') myIter
ELSE
CALL RW_GET_SUFFIX( suff, myTime, myIter, myThid )
ENDIF
C ==>> Resetting run-time parameter writeBinaryPrec in the middle of a run
C ==>> is very very very nasty !!!
c writeBinaryPrec = writeStatePrec
C <<== If you really want to mess-up with this at your own risk,
C <<== uncomment the line above
IF ( dumpAdVarExch.EQ.1 ) THEN
CALL ADEXCH_XY_RL( adarea, myThid )
CALL ADEXCH_XY_RL( adheff, myThid )
CALL ADEXCH_XY_RL( adhsnow, myThid )
CALL ADEXCH_UV_3D_RL( aduice,advice, .TRUE., 1, myThid )
ENDIF
IF (dumpAdVarExch.NE.2 .AND. .NOT.dumpAdByRec) THEN
CALL WRITE_REC_3D_RL(
& 'ADJarea.'//suff, writeBinaryPrec,
& 1, adarea, 1, myIter, myThid )
CALL WRITE_REC_3D_RL(
& 'ADJheff.'//suff, writeBinaryPrec,
& 1, adheff, 1, myIter, myThid )
CALL WRITE_REC_3D_RL(
& 'ADJhsnow.'//suff, writeBinaryPrec,
& 1, adhsnow, 1, myIter, myThid )
# ifdef SEAICE_ALLOW_DYNAMICS
cph IF ( SEAICEuseDynamics ) THEN
CALL WRITE_REC_3D_RL(
& 'ADJuice.'//suff, writeBinaryPrec,
& 1, aduice, 1, myIter, myThid )
CALL WRITE_REC_3D_RL(
& 'ADJvice.'//suff, writeBinaryPrec,
& 1, advice, 1, myIter, myThid )
cph ENDIF
# endif
ELSEIF (dumpAdVarExch.NE.2 .AND. .NOT.dumpAdByRec) THEN
CALL WRITE_REC_3D_RL(
& 'ADJarea', writeBinaryPrec,
& 1, adarea, dumpAdRecSi, myIter, myThid )
CALL WRITE_REC_3D_RL(
& 'ADJheff', writeBinaryPrec,
& 1, adheff, dumpAdRecSi, myIter, myThid )
CALL WRITE_REC_3D_RL(
& 'ADJhsnow', writeBinaryPrec,
& 1, adhsnow, dumpAdRecSi, myIter, myThid )
# ifdef SEAICE_ALLOW_DYNAMICS
cph IF ( SEAICEuseDynamics ) THEN
CALL WRITE_REC_3D_RL(
& 'ADJuice', writeBinaryPrec,
& 1, aduice, dumpAdRecSi, myIter, myThid )
CALL WRITE_REC_3D_RL(
& 'ADJvice', writeBinaryPrec,
& 1, advice, dumpAdRecSi, myIter, myThid )
cph ENDIF
# endif
ELSE
C case dumpAdVarExch = 2
CALL COPY_ADVAR_OUTP( dumRS, adarea, var2Du, 1 , 12, myThid )
IF (.NOT.dumpAdByRec) CALL WRITE_FLD_XY_RL( 'ADJarea.',
& suff, var2Du, myIter, myThid )
IF ( dumpAdByRec ) CALL WRITE_REC_XY_RL( 'ADJarea',
& var2Du, dumpAdRecMn, myIter, myThid )
CALL COPY_ADVAR_OUTP( dumRS, adheff, var2Du, 1 , 12, myThid )
IF (.NOT.dumpAdByRec) CALL WRITE_FLD_XY_RL( 'ADJheff.',
& suff, var2Du, myIter, myThid )
IF ( dumpAdByRec ) CALL WRITE_REC_XY_RL( 'ADJheff',
& var2Du, dumpAdRecMn, myIter, myThid )
CALL COPY_ADVAR_OUTP( dumRS, adhsnow, var2Du, 1 , 12, myThid )
IF (.NOT.dumpAdByRec) CALL WRITE_FLD_XY_RL( 'ADJhsnow.',
& suff, var2Du, myIter, myThid )
IF ( dumpAdByRec ) CALL WRITE_REC_XY_RL( 'ADJhsnow',
& var2Du, dumpAdRecMn, myIter, myThid )
# ifdef SEAICE_ALLOW_DYNAMICS
CALL COPY_AD_UV_OUTP( dumRS, dumRS, aduice, advice,
& var2Du, var2Dv, 1, 34, myThid )
IF (.NOT.dumpAdByRec) CALL WRITE_FLD_XY_RL( 'ADJuice.',
& suff, var2Du, myIter, myThid )
IF ( dumpAdByRec ) CALL WRITE_REC_XY_RL( 'ADJuice',
& var2Du, dumpAdRecMn, myIter, myThid )
IF (.NOT.dumpAdByRec) CALL WRITE_FLD_XY_RL( 'ADJvice.',
& suff, var2Dv, myIter, myThid )
IF ( dumpAdByRec ) CALL WRITE_REC_XY_RL( 'ADJvice',
& var2Dv, dumpAdRecMn, myIter, myThid )
# endif
ENDIF
#ifdef ALLOW_MNC
IF (useMNC .AND. autodiff_mnc) THEN
CALL MNC_CW_SET_UDIM('adseaice', -1, myThid)
CALL MNC_CW_RL_W_S('D','adseaice',0,0,'T',myTime,myThid)
CALL MNC_CW_SET_UDIM('adseaice', 0, myThid)
CALL MNC_CW_I_W_S('I','adseaice',0,0,'iter',myIter,myThid)
CALL MNC_CW_RL_W_S('D','adseaice',0,0,'model_time',myTime,
& myThid)
c
IF (dumpAdVarExch.EQ.2) THEN
CALL COPY_ADVAR_OUTP( dumRS, adarea, var2Du, 1 , 12, myThid )
CALL MNC_CW_RL_W('D','adseaice',0,0,'adarea',
& var2Du, myThid)
CALL COPY_ADVAR_OUTP( dumRS, adheff, var2Du, 1 , 12, myThid )
CALL MNC_CW_RL_W('D','adseaice',0,0,'adheff',
& var2Du, myThid)
CALL COPY_ADVAR_OUTP( dumRS, adhsnow, var2Du, 1 , 12, myThid )
CALL MNC_CW_RL_W('D','adseaice',0,0,'adhsnow',
& var2Du, myThid)
# ifdef SEAICE_ALLOW_DYNAMICS
C IF (SEAICEuseDYNAMICS) THEN
CALL COPY_AD_UV_OUTP( dumRS, dumRS, aduice, advice,
& var2Du, var2Dv, 1, 34, myThid )
CALL MNC_CW_RL_W('D','adseaice',0,0,'aduice',
& var2Du, myThid)
CALL MNC_CW_RL_W('D','adseaice',0,0,'advice',
& var2Dv, myThid)
C ENDIF
# endif
ELSE
CALL MNC_CW_RL_W('D','adseaice',0,0,'adarea',
& adarea, myThid)
CALL MNC_CW_RL_W('D','adseaice',0,0,'adheff',
& adheff, myThid)
CALL MNC_CW_RL_W('D','adseaice',0,0,'adhsnow',
& adhsnow, myThid)
# ifdef SEAICE_ALLOW_DYNAMICS
C IF (SEAICEuseDYNAMICS) THEN
CALL MNC_CW_RL_W('D','adseaice',0,0,'aduice',
& aduice, myThid)
CALL MNC_CW_RL_W('D','adseaice',0,0,'advice',
& advice, myThid)
C ENDIF
# endif
ENDIF
ENDIF
#endif /* ALLOW_MNC */
CALL TIMER_STOP( 'I/O (WRITE) [ADJOINT LOOP]', myThid )
ENDIF
#endif /* ALLOW_AUTODIFF_MONITOR */
#endif /* ALLOW_ADJOINT_RUN */
RETURN
END