C $Header: /u/gcmpack/MITgcm/pkg/autodiff/g_dummy_in_stepping.F,v 1.18 2017/03/24 23:34:13 jmc Exp $ C $Name: $ #include "AUTODIFF_OPTIONS.h" #ifdef ALLOW_CTRL # include "CTRL_OPTIONS.h" #endif #include "AD_CONFIG.h" CBOP C !ROUTINE: g_dummy_in_stepping C !INTERFACE: subroutine G_DUMMY_IN_STEPPING( myTime, myIter, myThid ) C !DESCRIPTION: \bv C *==========================================================* C | SUBROUTINE g_dummy_in_stepping | C *==========================================================* C Extract tangent linear variable from TAMC/TAF-generated C tangent linear common blocks, contained in g_common.h C and write fields to file; C Make sure common blocks in g_common.h are up-to-date C w.r.t. current adjoint code. C *==========================================================* C | SUBROUTINE g_dummy_in_stepping | C *==========================================================* C \ev C !USES: IMPLICIT NONE C == Global variables === #include "SIZE.h" #include "EEPARAMS.h" #include "PARAMS.h" #ifdef ALLOW_AUTODIFF_MONITOR # include "g_common.h" #endif C !INPUT/OUTPUT PARAMETERS: C == Routine arguments == C myIter :: iteration counter for this thread C myTime :: time counter for this thread C myThid :: Thread number for this instance of the routine. INTEGER myThid INTEGER myIter _RL myTime #ifdef ALLOW_TANGENTLINEAR_RUN #ifdef ALLOW_AUTODIFF_MONITOR C !FUNCTIONS: LOGICAL DIFFERENT_MULTIPLE EXTERNAL INTEGER IO_ERRCOUNT EXTERNAL C !LOCAL VARIABLES: c == local variables == C suff :: Hold suffix part of a filename C msgBuf :: Error message buffer CHARACTER*(10) suff INTEGER beginIOErrCount INTEGER endIOErrCount CHARACTER*(MAX_LEN_MBUF) msgBuf CEOP IF ( & DIFFERENT_MULTIPLE(adjDumpFreq,myTime,deltaTClock) & ) THEN CALL TIMER_START('I/O (WRITE) [ADJOINT LOOP]', myThid ) c write(*,*) 'myIter= ',myIter 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 C-- Read IO error counter beginIOErrCount = IO_ERRCOUNT(myThid) CALL WRITE_FLD_XY_RL ( 'G_Jtaux.',suff, g_fu, myIter, myThid ) CALL WRITE_FLD_XY_RL ( 'G_Jtauy.',suff, g_fv, myIter, myThid ) CALL WRITE_FLD_XY_RL ( 'G_Jqnet.',suff, g_qnet, myIter,myThid ) CALL WRITE_FLD_XY_RL ( 'G_Jempr.',suff, g_empmr,myIter,myThid ) c CALL WRITE_FLD_XYZ_RL( & 'G_Jtheta.',suff, g_theta, myIter, myThid ) CALL WRITE_FLD_XYZ_RL( & 'G_Jsalt.',suff, g_salt, myIter, myThid ) CALL WRITE_FLD_XYZ_RL( & 'G_Juvel.',suff, g_uvel, myIter, myThid ) CALL WRITE_FLD_XYZ_RL( & 'G_Jvvel.',suff, g_vvel, myIter, myThid ) CALL WRITE_FLD_XYZ_RL( & 'G_Jwvel.',suff, g_wvel, myIter, myThid ) CALL WRITE_FLD_XY_RL( & 'G_Jetan.',suff, g_etan, myIter, myThid ) #ifdef ALLOW_DIFFKR_CONTROL CALL WRITE_FLD_XYZ_RL ( 'G_Jdiffkr.',suff, g_diffkr, & myIter, myThid ) #endif #ifdef ALLOW_KAPGM_CONTROL CALL WRITE_FLD_XYZ_RL ( 'G_Jkapgm.',suff, g_kapgm, & myIter, myThid ) #endif #ifdef ALLOW_KAPREDI_CONTROL CALL WRITE_FLD_XYZ_RL ( 'G_Jkapredi.',suff, g_kapredi, & myIter, myThid ) #endif cph CALL WRITE_FLD_XY_RL( 'G_J_sst.',suff, g_sst, myIter, myThid ) cph CALL WRITE_FLD_XY_RL( 'G_J_sss.',suff, g_sss, myIter, myThid ) #ifdef ALLOW_AUTODIFF_MONITOR_PHIHYD CALL WRITE_FLD_XYZ_RL( & 'G_Jphihyd.',suff, g_totphihyd, myIter, myThid ) #endif C-- Reread IO error counter endIOErrCount = IO_ERRCOUNT(myThid) C-- Check for IO errors IF ( endIOErrCount .NE. beginIOErrCount ) THEN WRITE(msgBuf,'(A)') 'S/R WRITE_STATE' CALL PRINT_ERROR( msgBuf, myThid ) WRITE(msgBuf,'(A)') 'Error writing out model state' CALL PRINT_ERROR( msgBuf, myThid ) WRITE(msgBuf,'(A,I10)') 'Timestep ',myIter CALL PRINT_ERROR( msgBuf, myThid ) ELSE WRITE(msgBuf,'(A,I10)') & '// Model state written, timestep', myIter CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, & SQUEEZE_RIGHT, myThid ) WRITE(msgBuf,'(A)') ' ' CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, & SQUEEZE_RIGHT, myThid ) ENDIF CALL TIMER_STOP( 'I/O (WRITE) [ADJOINT LOOP]', myThid ) ENDIF #endif /* ALLOW_AUTODIFF_MONITOR */ #endif /* ALLOW_TANGENTLINEAR_RUN */ RETURN END