C $Header: /u/gcmpack/MITgcm/pkg/ptracers/ptracers_ad_dump.F,v 1.6 2017/03/24 23:48:33 jmc Exp $ C $Name: $ #include "PTRACERS_OPTIONS.h" #include "AD_CONFIG.h" #ifdef ALLOW_AUTODIFF # include "AUTODIFF_OPTIONS.h" #endif CBOP C !ROUTINE: ptracers_ad_dump C !INTERFACE: SUBROUTINE PTRACERS_AD_DUMP( myTime, myIter, myThid ) C !DESCRIPTION: \bv C *==========================================================* C | SUBROUTINE ptracers_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 ptracers_ad_dump C *==========================================================* C \ev C !USES: IMPLICIT NONE C == Global variables === #include "SIZE.h" #include "EEPARAMS.h" #include "PARAMS.h" #include "PTRACERS_SIZE.h" #include "PTRACERS_PARAMS.h" #ifdef ALLOW_AUTODIFF_MONITOR # include "ptracers_adcommon.h" #endif C !INPUT/OUTPUT PARAMETERS: 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 suff :: Hold suffix part of a filename C msgBuf :: Error message buffer INTEGER ip CHARACTER*(10) suff CHARACTER*(MAX_LEN_FNAM) prefix CHARACTER*(MAX_LEN_MBUF) msgBuf CEOP IF ( & DIFFERENT_MULTIPLE(adjDumpFreq,myTime,deltaTClock) & ) THEN CALL TIMER_START('I/O (WRITE) [ADJOINT LOOP]', myThid ) 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 DO ip = 1, PTRACERS_numInUse WRITE(prefix,'(A10,A2,A1)') & 'ADJptracer', PTRACERS_ioLabel(ip), '.' CALL WRITE_FLD_XYZ_RL( & prefix, suff, & adptracer(1-OLx,1-OLy,1,1,1,ip), 1, myThid ) ENDDO CALL TIMER_STOP( 'I/O (WRITE) [ADJOINT LOOP]', myThid ) ENDIF #endif /* ALLOW_AUTODIFF_MONITOR */ #endif /* ALLOW_ADJOINT_RUN */ RETURN END