C $Header: /u/gcmpack/MITgcm/pkg/autodiff/addummy_in_stepping.F,v 1.65 2017/03/24 23:34:13 jmc Exp $ C $Name: $ #include "AUTODIFF_OPTIONS.h" #ifdef ALLOW_OPENAD # include "OPENAD_OPTIONS.h" #endif #ifdef ALLOW_CTRL # include "CTRL_OPTIONS.h" #endif #include "AD_CONFIG.h" CBOP C !ROUTINE: ADDUMMY_IN_STEPPING C !INTERFACE: SUBROUTINE ADDUMMY_IN_STEPPING( myTime, myIter, myThid ) C !DESCRIPTION: \bv C *==========================================================* C | SUBROUTINE ADDUMMY_IN_STEPPING | 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 ADDUMMY_IN_STEPPING | C *==========================================================* C \ev C !USES: IMPLICIT NONE C == Global variables === #ifdef ALLOW_OPENAD use OAD_active use OAD_rev use OAD_tape use OAD_cp #endif #include "SIZE.h" #include "EEPARAMS.h" #include "PARAMS.h" #ifdef ALLOW_OPENAD # include "DYNVARS.h" # include "FFIELDS.h" #endif #include "AUTODIFF_PARAMS.h" #ifdef ALLOW_MNC #include "MNC_PARAMS.h" #endif c#include "GRID.h" #ifdef ALLOW_AUTODIFF_MONITOR # include "AUTODIFF.h" # ifndef ALLOW_OPENAD # include "adcommon.h" # endif /* ALLOW_OPENAD */ #endif /* ALLOW_AUTODIFF_MONITOR */ 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 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) _RL foo2D (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) _RL var3Du(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy) _RL var3Dv(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy) _RL foo3D (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,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) dumpAdRecMn=dumpAdRecMn+1 c#ifdef ALLOW_DEBUG c IF ( debugMode ) print*,'dumpAdRecMn',dumpAdRecMn c#endif IF ( dumpAdVarExch.EQ.1 ) THEN #ifdef ALLOW_OPENAD C-- need to all the correct OpenAD EXCH S/R ; left empty for now #else /* ALLOW_OPENAD */ #ifdef AUTODIFF_TAMC_COMPATIBILITY call ADEXCH_XY_RL( myThid,adetan) call ADEXCH_XYZ_RL( myThid,adtheta) call ADEXCH_XYZ_RL( myThid,adsalt) call ADEXCH_XYZ_RL( myThid,adwvel ) call ADEXCH_UV_XYZ_RL( .true. ,myThid,aduvel,advvel ) call ADEXCH_UV_XY_RS( .true., myThid, adfu, adfv ) call ADEXCH_XY_RS( myThid,adqnet ) call ADEXCH_XY_RS( myThid,adempmr ) # ifdef ALLOW_EDDYPSI_CONTROL call ADEXCH_UV_XYZ_RS( .true. ,myThid,adeddypsix,adeddypsiy ) # endif # ifdef ALLOW_DIFFKR_CONTROL call ADEXCH_XYZ_RL( myThid,addiffkr ) # endif # ifdef ALLOW_KAPGM_CONTROL call ADEXCH_XYZ_RL( myThid,adkapgm ) # endif # ifdef ALLOW_KAPREDI_CONTROL call ADEXCH_XYZ_RL( myThid,adkapredi ) # endif # ifdef ALLOW_SST0_CONTROL call ADEXCH_XY_RL( myThid,adsst ) # endif # ifdef ALLOW_SSS0_CONTROL call ADEXCH_XY_RL( myThid,adsss ) # endif # ifdef ALLOW_BOTTOMDRAG_CONTROL call ADEXCH_XY_RL( myThid,adbottomdragfld) # endif else /* ndfef AUTODIFF_TAMC_COMPATIBILITY */ CALL ADEXCH_3D_RL( adEtaN, 1 , myThid ) # ifndef ALLOW_BULK_OFFLINE CALL ADEXCH_3D_RL( adTheta,Nr, myThid ) CALL ADEXCH_3D_RL( adSalt, Nr, myThid ) CALL ADEXCH_3D_RL( adwVel, Nr, myThid ) CALL ADEXCH_UV_3D_RL( aduVel,advVel, .TRUE., Nr, myThid ) # endif CALL ADEXCH_UV_XY_RS( adFu, adFv, .TRUE., myThid ) CALL ADEXCH_XY_RS( adQnet, myThid ) CALL ADEXCH_XY_RS( adEmPmR, myThid ) # ifdef ALLOW_EDDYPSI_CONTROL CALL ADEXCH_UV_XYZ_RS( adEddyPsiX, adEddyPsiY, .TRUE., myThid ) # endif # ifdef ALLOW_DIFFKR_CONTROL CALL ADEXCH_3D_RL( adDiffKr, Nr, myThid ) # endif # ifdef ALLOW_KAPGM_CONTROL CALL ADEXCH_3D_RL( adKapGM, Nr, myThid ) # endif # ifdef ALLOW_KAPREDI_CONTROL CALL ADEXCH_3D_RL( adKapRedi, Nr, myThid ) # endif # ifdef ALLOW_SST0_CONTROL CALL ADEXCH_XY_RS( adSST, myThid ) # endif # ifdef ALLOW_SSS0_CONTROL CALL ADEXCH_XY_RS( adSSS, myThid ) # endif # ifdef ALLOW_BOTTOMDRAG_CONTROL CALL ADEXCH_3D_RL( adBottomDragFld, 1 , myThid ) # endif #endif /* AUTODIFF_TAMC_COMPATIBILITY */ #endif /* ALLOW_OPENAD */ 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 C----------------------------------------------------------------------- #ifndef ALLOW_OPENAD C----------------------------------------------------------------------- IF ( ( dumpAdVarExch.NE.2 ).AND.(.NOT.dumpAdByRec) ) THEN CALL WRITE_FLD_XYZ_RL( 'ADJtheta.', suff, & adTheta, myIter, myThid ) CALL WRITE_FLD_XYZ_RL( 'ADJsalt.', suff, & adSalt, myIter, myThid ) CALL WRITE_FLD_XYZ_RL( 'ADJuvel.', suff, & aduVel, myIter, myThid ) CALL WRITE_FLD_XYZ_RL( 'ADJvvel.', suff, & advVel, myIter, myThid ) CALL WRITE_FLD_XYZ_RL( 'ADJwvel.', suff, & adwVel, myIter, myThid ) CALL WRITE_FLD_XY_RL ( 'ADJetan.', suff, & adEtaN, myIter, myThid ) IF ( .NOT. useSEAICE .AND. .NOT. useEXF ) THEN CALL WRITE_FLD_XY_RS('ADJtaux.',suff, adFu, myIter, myThid ) CALL WRITE_FLD_XY_RS('ADJtauy.',suff, adFv, myIter, myThid ) CALL WRITE_FLD_XY_RS('ADJqnet.',suff, adQnet,myIter,myThid ) CALL WRITE_FLD_XY_RS('ADJempr.',suff,adEmPmR,myIter,myThid ) #ifdef SHORTWAVE_HEATING CALL WRITE_FLD_XY_RS('ADJqsw.', suff, adQsw,myIter, myThid ) #endif ENDIF #ifdef ALLOW_GGL90 c CALL WRITE_FLD_XYZ_RL ( 'ADJggl90diffkr.',suff, c & adGGL90DiffKr, myIter, myThid ) CALL WRITE_FLD_XYZ_RL( 'ADJggl90tke.', suff, & adGGL90TKE, myIter, myThid ) #endif #ifdef ALLOW_DIFFKR_CONTROL CALL WRITE_FLD_XYZ_RL( 'ADJdiffkr.', suff, & adDiffKr, myIter, myThid ) #endif #ifdef ALLOW_KAPGM_CONTROL CALL WRITE_FLD_XYZ_RL( 'ADJkapgm.', suff, & adKapGM, myIter, myThid ) #endif #ifdef ALLOW_KAPREDI_CONTROL CALL WRITE_FLD_XYZ_RL( 'ADJkapredi.', suff, & adKapRedi, myIter, myThid ) #endif #ifdef ALLOW_EDDYPSI_CONTROL CALL WRITE_FLD_XYZ_RS( 'ADJeddypsix.', suff, & adEddyPsiX, myIter, myThid ) CALL WRITE_FLD_XYZ_RS( 'ADJeddypsiy.', suff, & adEddyPsiY, myIter, myThid ) #endif #ifdef ALLOW_SST0_CONTROL CALL WRITE_FLD_XY_RS( 'ADJsst.',suff, adSST, myIter, myThid ) #endif #ifdef ALLOW_SSS0_CONTROL CALL WRITE_FLD_XY_RS( 'ADJsss.',suff, adSSS, myIter, myThid ) #endif #ifdef ALLOW_BOTTOMDRAG_CONTROL CALL WRITE_FLD_XY_RL ( 'ADJbottomdrag.', suff, & adBottomDragFld, myIter, myThid ) #endif ELSEIF ( ( dumpAdVarExch.NE.2 ).AND.(dumpAdByRec) ) THEN CALL WRITE_REC_XYZ_RL( 'ADJtheta', & adTheta, dumpAdRecMn, myIter,myThid ) CALL WRITE_REC_XYZ_RL( 'ADJsalt', & adSalt, dumpAdRecMn, myIter, myThid ) CALL WRITE_REC_XYZ_RL( 'ADJuvel', & aduVel, dumpAdRecMn, myIter, myThid ) CALL WRITE_REC_XYZ_RL( 'ADJvvel', & advVel, dumpAdRecMn, myIter, myThid ) CALL WRITE_REC_XYZ_RL( 'ADJwvel', & adwVel, dumpAdRecMn, myIter, myThid ) CALL WRITE_REC_XY_RL ( 'ADJetan', & adEtaN, dumpAdRecMn, myIter, myThid ) IF ( .NOT. useSEAICE .AND. .NOT. useEXF ) THEN CALL WRITE_REC_XY_RS('ADJtaux', & adFu, dumpAdRecMn, myIter, myThid ) CALL WRITE_REC_XY_RS('ADJtauy', & adFv, dumpAdRecMn, myIter, myThid ) CALL WRITE_REC_XY_RS('ADJqnet', & adQnet,dumpAdRecMn, myIter,myThid ) CALL WRITE_REC_XY_RS('ADJempr', & adEmPmR,dumpAdRecMn, myIter,myThid ) #ifdef SHORTWAVE_HEATING CALL WRITE_REC_XY_RS('ADJqsw', & adQsw,dumpAdRecMn, myIter, myThid ) #endif ENDIF #ifdef ALLOW_GGL90 c CALL WRITE_REC_XYZ_RL ( 'ADJggl90diffkr', c & adGGL90DiffKr, dumpAdRecMn, myIter, myThid ) CALL WRITE_REC_XYZ_RL( 'ADJggl90tke', & adGGL90TKE, dumpAdRecMn, myIter, myThid ) #endif #ifdef ALLOW_DIFFKR_CONTROL CALL WRITE_REC_XYZ_RL( 'ADJdiffkr', & adDiffKr, dumpAdRecMn, myIter, myThid ) #endif #ifdef ALLOW_KAPGM_CONTROL CALL WRITE_REC_XYZ_RL( 'ADJkapgm', & adKapGM, dumpAdRecMn, myIter, myThid ) #endif #ifdef ALLOW_KAPREDI_CONTROL CALL WRITE_REC_XYZ_RL( 'ADJkapredi', & adKapRedi, dumpAdRecMn, myIter, myThid ) #endif #ifdef ALLOW_EDDYPSI_CONTROL CALL WRITE_REC_XYZ_RS( 'ADJeddypsix', & adEddyPsiX, dumpAdRecMn, myIter, myThid ) CALL WRITE_REC_XYZ_RS( 'ADJeddypsiy', & adEddyPsiY, dumpAdRecMn, myIter, myThid ) #endif #ifdef ALLOW_SST0_CONTROL CALL WRITE_REC_XY_RS( 'ADJsst', & adSST, dumpAdRecMn, myIter, myThid ) #endif #ifdef ALLOW_SSS0_CONTROL CALL WRITE_REC_XY_RS( 'ADJsss', & adSSS, dumpAdRecMn, myIter, myThid ) #endif #ifdef ALLOW_BOTTOMDRAG_CONTROL CALL WRITE_REC_XY_RL ( 'ADJbottomdrag', & adBottomDragFld, dumpAdRecMn, myIter, myThid ) #endif ELSE C case dumpAdVarExch = 2 CALL COPY_ADVAR_OUTP( dumRS, adTheta,var3Du, Nr, 12, myThid ) IF (.NOT.dumpAdByRec) CALL WRITE_FLD_XYZ_RL( 'ADJtheta.', & suff, var3Du, myIter, myThid ) IF ( dumpAdByRec ) CALL WRITE_REC_XYZ_RL( 'ADJtheta', & var3Du, dumpAdRecMn, myIter, myThid ) CALL COPY_ADVAR_OUTP( dumRS, adSalt, var3Du, Nr, 12, myThid ) IF (.NOT.dumpAdByRec) CALL WRITE_FLD_XYZ_RL( 'ADJsalt.', & suff, var3Du, myIter, myThid ) IF ( dumpAdByRec ) CALL WRITE_REC_XYZ_RL( 'ADJsalt', & var3Du, dumpAdRecMn, myIter, myThid ) CALL COPY_AD_UV_OUTP( dumRS, dumRS, aduVel, advVel, & var3Du, var3Dv, Nr, 34, myThid ) IF (.NOT.dumpAdByRec) CALL WRITE_FLD_XYZ_RL( 'ADJuvel.', & suff, var3Du, myIter, myThid ) IF ( dumpAdByRec ) CALL WRITE_REC_XYZ_RL( 'ADJuvel', & var3Du, dumpAdRecMn, myIter, myThid ) IF (.NOT.dumpAdByRec) CALL WRITE_FLD_XYZ_RL( 'ADJvvel.', & suff, var3Dv, myIter, myThid ) IF ( dumpAdByRec ) CALL WRITE_REC_XYZ_RL( 'ADJvvel', & var3Dv, dumpAdRecMn, myIter, myThid ) CALL COPY_ADVAR_OUTP( dumRS, adwVel, var3Du, Nr, 12, myThid ) IF (.NOT.dumpAdByRec) CALL WRITE_FLD_XYZ_RL( 'ADJwvel.', & suff, var3Du, myIter, myThid ) IF ( dumpAdByRec ) CALL WRITE_REC_XYZ_RL( 'ADJwvel', & var3Du, dumpAdRecMn, myIter, myThid ) CALL COPY_ADVAR_OUTP( dumRS, adEtaN, var2Du, 1 , 12, myThid ) IF (.NOT.dumpAdByRec) CALL WRITE_FLD_XY_RL( 'ADJetan.', & suff, var2Du, myIter, myThid ) IF ( dumpAdByRec ) CALL WRITE_REC_XY_RL( 'ADJetan', & var2Du, dumpAdRecMn, myIter, myThid ) IF ( .NOT. useSEAICE .AND. .NOT. useEXF ) THEN CALL COPY_AD_UV_OUTP( adFu, adFv, dumRL, dumRL, & var2Du, var2Dv, 1, 33, myThid ) IF (.NOT.dumpAdByRec) CALL WRITE_FLD_XY_RL( 'ADJtaux.', & suff,var2Du,myIter,myThid ) IF ( dumpAdByRec ) CALL WRITE_REC_XY_RL( 'ADJtaux', & var2Du,dumpAdRecMn, myIter,myThid ) IF (.NOT.dumpAdByRec) CALL WRITE_FLD_XY_RL( 'ADJtauy.', & suff,var2Dv,myIter,myThid ) IF ( dumpAdByRec ) CALL WRITE_REC_XY_RL( 'ADJtauy', & var2Dv,dumpAdRecMn, myIter,myThid ) CALL COPY_ADVAR_OUTP( adQnet, dumRL, var2Du, 1, 11, myThid ) IF (.NOT.dumpAdByRec) CALL WRITE_FLD_XY_RL( 'ADJqnet.', & suff,var2Du,myIter,myThid ) IF ( dumpAdByRec ) CALL WRITE_REC_XY_RL( 'ADJqnet', & var2Du,dumpAdRecMn, myIter,myThid ) CALL COPY_ADVAR_OUTP( adEmPmR,dumRL, var2Du, 1, 11, myThid ) IF (.NOT.dumpAdByRec) CALL WRITE_FLD_XY_RL( 'ADJempr.', & suff,var2Du,myIter,myThid ) IF ( dumpAdByRec ) CALL WRITE_REC_XY_RL( 'ADJempr', & var2Du,dumpAdRecMn, myIter,myThid ) #ifdef SHORTWAVE_HEATING CALL COPY_ADVAR_OUTP( adQsw, dumRL, var2Du, 1, 11, myThid ) IF (.NOT.dumpAdByRec) CALL WRITE_FLD_XY_RL( 'ADJqsw.', & suff,var2Du,myIter,myThid ) IF ( dumpAdByRec ) CALL WRITE_REC_XY_RL( 'ADJqsw', & var2Du,dumpAdRecMn, myIter,myThid ) #endif ENDIF #ifdef ALLOW_GGL90 CALL COPY_ADVAR_OUTP( dumRS,adGGL90TKE,var3Du,Nr, 12,myThid ) IF (.NOT.dumpAdByRec) CALL WRITE_FLD_XYZ_RL( 'ADJggl90tke.', & suff, var3Du, myIter, myThid ) IF ( dumpAdByRec ) CALL WRITE_REC_XYZ_RL( 'ADJggl90tke', & var3Du, dumpAdRecMn, myIter, myThid ) #endif #ifdef ALLOW_DIFFKR_CONTROL CALL COPY_ADVAR_OUTP( dumRS, adDiffKr,var3Du, Nr, 12,myThid ) IF (.NOT.dumpAdByRec) CALL WRITE_FLD_XYZ_RL( 'ADJdiffkr.', & suff, var3Du, myIter, myThid ) IF ( dumpAdByRec ) CALL WRITE_REC_XYZ_RL( 'ADJdiffkr', & var3Du, dumpAdRecMn, myIter, myThid ) #endif #ifdef ALLOW_KAPGM_CONTROL CALL COPY_ADVAR_OUTP( dumRS, adKapGM, var3Du, Nr, 12,myThid ) IF (.NOT.dumpAdByRec) CALL WRITE_FLD_XYZ_RL( 'ADJkapgm.', & suff, var3Du, myIter, myThid ) IF ( dumpAdByRec ) CALL WRITE_REC_XYZ_RL( 'ADJkapgm', & var3Du, dumpAdRecMn, myIter, myThid ) #endif #ifdef ALLOW_KAPREDI_CONTROL CALL COPY_ADVAR_OUTP( dumRS,adKapRedi,var3Du, Nr, 12,myThid ) IF (.NOT.dumpAdByRec) CALL WRITE_FLD_XYZ_RL( 'ADJkapredi.', & suff, var3Du, myIter, myThid ) IF ( dumpAdByRec ) CALL WRITE_REC_XYZ_RL( 'ADJkapredi', & var3Du, dumpAdRecMn, myIter, myThid ) #endif #ifdef ALLOW_EDDYPSI_CONTROL CALL COPY_AD_UV_OUTP( adEddyPsiX, adEddyPsiY, dumRL, dumRL, & var3Du, var3Dv, Nr, 33, myThid ) IF (.NOT.dumpAdByRec) CALL WRITE_FLD_XYZ_RL( 'ADJeddypsix.', & suff, var3Du, myIter, myThid ) IF ( dumpAdByRec ) CALL WRITE_REC_XYZ_RL( 'ADJeddypsix', & var3Du, dumpAdRecMn, myIter, myThid ) IF (.NOT.dumpAdByRec) CALL WRITE_FLD_XYZ_RL( 'ADJeddypsiy.', & suff, var3Dv, myIter, myThid ) IF ( dumpAdByRec ) CALL WRITE_REC_XYZ_RL( 'ADJeddypsiy', & var3Dv, dumpAdRecMn, myIter, myThid ) #endif #ifdef ALLOW_SST0_CONTROL CALL COPY_ADVAR_OUTP( adSST, dumRL, var2Du, 1, 11, myThid ) IF (.NOT.dumpAdByRec) CALL WRITE_FLD_XY_RL( 'ADJsst.', & suff,var2Du,myIter,myThid ) IF ( dumpAdByRec ) CALL WRITE_REC_XY_RL( 'ADJsst', & var2Du,dumpAdRecMn, myIter,myThid ) #endif #ifdef ALLOW_SSS0_CONTROL CALL COPY_ADVAR_OUTP( adSSS, dumRL, var2Du, 1, 11, myThid ) IF (.NOT.dumpAdByRec) CALL WRITE_FLD_XY_RL( 'ADJsss.', & suff,var2Du,myIter,myThid ) IF ( dumpAdByRec ) CALL WRITE_REC_XY_RL( 'ADJsss', & var2Du,dumpAdRecMn, myIter,myThid ) #endif #ifdef ALLOW_BOTTOMDRAG_CONTROL CALL COPY_ADVAR_OUTP( dumRS, adBottomDragFld, & var2Du, 1, 12, myThid ) IF (.NOT.dumpAdByRec) CALL WRITE_FLD_XY_RL( 'ADJbottomdrag.', & suff, var2Du, myIter, myThid ) IF ( dumpAdByRec ) CALL WRITE_REC_XY_RL( 'ADJbottomdrag', & var2Du, dumpAdRecMn, myIter, myThid ) #endif C end if dumpAdVarExch = 2 ENDIF C----------------------------------------------------------------------- #else /* ndef ALLOW_OPENAD */ C----------------------------------------------------------------------- IF ( ( dumpAdVarExch.NE.2 ).AND.(.NOT.dumpAdByRec) ) THEN foo3D = thetad CALL WRITE_FLD_XYZ_RL( 'ADJtheta.', suff, & foo3D, myIter, myThid ) foo3D = saltd CALL WRITE_FLD_XYZ_RL( 'ADJsalt.', suff, & foo3D, myIter, myThid ) foo3D = uveld CALL WRITE_FLD_XYZ_RL( 'ADJuvel.', suff, & foo3D, myIter, myThid ) foo3D = vveld CALL WRITE_FLD_XYZ_RL( 'ADJvvel.', suff, & foo3D, myIter, myThid ) foo3D = wveld CALL WRITE_FLD_XYZ_RL( 'ADJwvel.', suff, & foo3D, myIter, myThid ) foo2D = etaNd CALL WRITE_FLD_XY_RL ( 'ADJetan.', suff, & foo2D, myIter, myThid ) IF ( .NOT. useSEAICE .AND. .NOT. useEXF ) THEN foo2D = Fud CALL WRITE_FLD_XY_RS('ADJtaux.',suff, foo2d, myIter, myThid ) foo2D = Fvd CALL WRITE_FLD_XY_RS('ADJtauy.',suff, foo2d, myIter, myThid ) foo2D = Qnetd CALL WRITE_FLD_XY_RS('ADJqnet.',suff, foo2d,myIter,myThid ) foo2D = EmPmRd CALL WRITE_FLD_XY_RS('ADJempr.',suff,foo2d,myIter,myThid ) #ifdef SHORTWAVE_HEATING cc foo2D = Qsw%d cc CALL WRITE_FLD_XY_RS('ADJqsw.', suff, foo2d,myIter, myThid ) #endif ENDIF #ifdef ALLOW_GGL90 c CALL WRITE_FLD_XYZ_RL ( 'ADJggl90diffkr.',suff, c & adGGL90DiffKr, myIter, myThid ) cc foo3D = GGL90TKE%d cc CALL WRITE_FLD_XYZ_RL( 'ADJggl90tke.', suff, cc & foo3d, myIter, myThid ) #endif #ifdef ALLOW_DIFFKR_CONTROL foo3D = DiffKrd CALL WRITE_FLD_XYZ_RL( 'ADJdiffkr.', suff, & foo3d, myIter, myThid ) #endif #ifdef ALLOW_KAPGM_CONTROL foo3D = KapGMd CALL WRITE_FLD_XYZ_RL( 'ADJkapgm.', suff, & foo3d, myIter, myThid ) #endif #ifdef ALLOW_KAPREDI_CONTROL foo3D = KapRedid CALL WRITE_FLD_XYZ_RL( 'ADJkapredi.', suff, & foo3d, myIter, myThid ) #endif #ifdef ALLOW_EDDYPSI_CONTROL foo3D = EddyPsiXd CALL WRITE_FLD_XYZ_RS( 'ADJeddypsix.', suff, & foo3d, myIter, myThid ) foo3D = EddyPsiYd CALL WRITE_FLD_XYZ_RS( 'ADJeddypsiy.', suff, & foo3d, myIter, myThid ) #endif #ifdef ALLOW_SST0_CONTROL foo2D = sstd CALL WRITE_FLD_XY_RS( 'ADJsst.',suff, adSST, myIter, myThid ) #endif #ifdef ALLOW_SSS0_CONTROL foo2D = sssd CALL WRITE_FLD_XY_RS( 'ADJsss.',suff, adSSS, myIter, myThid ) #endif #ifdef ALLOW_BOTTOMDRAG_CONTROL foo2D = BottomDragFldd CALL WRITE_FLD_XY_RL ( 'ADJbottomdrag.', suff, & adBottomDragFld, myIter, myThid ) #endif ELSEIF ( ( dumpAdVarExch.NE.2 ).AND.(dumpAdByRec) ) THEN foo3D = thetad CALL WRITE_REC_XYZ_RL( 'ADJtheta', & foo3d, dumpAdRecMn, myIter,myThid ) foo3D = saltd CALL WRITE_REC_XYZ_RL( 'ADJsalt', & foo3d, dumpAdRecMn, myIter, myThid ) foo3D = uveld CALL WRITE_REC_XYZ_RL( 'ADJuvel', & foo3d, dumpAdRecMn, myIter, myThid ) foo3D = vveld CALL WRITE_REC_XYZ_RL( 'ADJvvel', & foo3d, dumpAdRecMn, myIter, myThid ) foo3D = wveld CALL WRITE_REC_XYZ_RL( 'ADJwvel', & foo3d, dumpAdRecMn, myIter, myThid ) foo2D = etand CALL WRITE_REC_XY_RL ( 'ADJetan', & foo2d, dumpAdRecMn, myIter, myThid ) IF ( .NOT. useSEAICE .AND. .NOT. useEXF ) THEN foo2D = fud CALL WRITE_REC_XY_RS('ADJtaux', & foo2d, dumpAdRecMn, myIter, myThid ) foo2D = fvd CALL WRITE_REC_XY_RS('ADJtauy', & foo2d, dumpAdRecMn, myIter, myThid ) foo2D = Qnetd CALL WRITE_REC_XY_RS('ADJqnet', & foo2d,dumpAdRecMn, myIter,myThid ) foo2D = EmPmRd CALL WRITE_REC_XY_RS('ADJempr', & foo2d,dumpAdRecMn, myIter,myThid ) #ifdef SHORTWAVE_HEATING cc foo2D = Qsw%d cc CALL WRITE_REC_XY_RS('ADJqsw', cc & foo2d,dumpAdRecMn, myIter, myThid ) #endif ENDIF #ifdef ALLOW_GGL90 c CALL WRITE_REC_XYZ_RL ( 'ADJggl90diffkr', c & adGGL90DiffKr, dumpAdRecMn, myIter, myThid ) cc foo3D = GGL90TKE%d cc CALL WRITE_REC_XYZ_RL( 'ADJggl90tke', cc & foo3d, dumpAdRecMn, myIter, myThid ) #endif #ifdef ALLOW_DIFFKR_CONTROL foo3D = Diffkrd CALL WRITE_REC_XYZ_RL( 'ADJdiffkr', & foo3d, dumpAdRecMn, myIter, myThid ) #endif #ifdef ALLOW_KAPGM_CONTROL foo3D = KapGMd CALL WRITE_REC_XYZ_RL( 'ADJkapgm', & foo3d, dumpAdRecMn, myIter, myThid ) #endif #ifdef ALLOW_KAPREDI_CONTROL foo3D = KapRedid CALL WRITE_REC_XYZ_RL( 'ADJkapredi', & foo3d, dumpAdRecMn, myIter, myThid ) #endif #ifdef ALLOW_EDDYPSI_CONTROL foo3D = EddyPsiXd CALL WRITE_REC_XYZ_RS( 'ADJeddypsix', & foo3d, dumpAdRecMn, myIter, myThid ) foo3D = EddyPsiYd CALL WRITE_REC_XYZ_RS( 'ADJeddypsiy', & foo3d, dumpAdRecMn, myIter, myThid ) #endif #ifdef ALLOW_SST0_CONTROL foo2D = sstd CALL WRITE_REC_XY_RS( 'ADJsst', & foo2d, dumpAdRecMn, myIter, myThid ) #endif #ifdef ALLOW_SSS0_CONTROL foo2D = sssd CALL WRITE_REC_XY_RS( 'ADJsss', & foo2d, dumpAdRecMn, myIter, myThid ) #endif #ifdef ALLOW_BOTTOMDRAG_CONTROL foo2D = BottomDragFldd CALL WRITE_REC_XY_RL ( 'ADJbottomdrag', & foo2d, dumpAdRecMn, myIter, myThid ) #endif ELSE C case dumpAdVarExch = 2 CALL COPY_ADVAR_OUTP( dumRS, thetad,var3Du, Nr, 12, myThid ) IF (.NOT.dumpAdByRec) CALL WRITE_FLD_XYZ_RL( 'ADJtheta.', & suff, var3Du, myIter, myThid ) IF ( dumpAdByRec ) CALL WRITE_REC_XYZ_RL( 'ADJtheta', & var3Du, dumpAdRecMn, myIter, myThid ) CALL COPY_ADVAR_OUTP( dumRS, saltd, var3Du, Nr, 12, myThid ) IF (.NOT.dumpAdByRec) CALL WRITE_FLD_XYZ_RL( 'ADJsalt.', & suff, var3Du, myIter, myThid ) IF ( dumpAdByRec ) CALL WRITE_REC_XYZ_RL( 'ADJsalt', & var3Du, dumpAdRecMn, myIter, myThid ) CALL COPY_AD_UV_OUTP( dumRS, dumRS, uVeld, vVeld, & var3Du, var3Dv, Nr, 34, myThid ) IF (.NOT.dumpAdByRec) CALL WRITE_FLD_XYZ_RL( 'ADJuvel.', & suff, var3Du, myIter, myThid ) IF ( dumpAdByRec ) CALL WRITE_REC_XYZ_RL( 'ADJuvel', & var3Du, dumpAdRecMn, myIter, myThid ) IF (.NOT.dumpAdByRec) CALL WRITE_FLD_XYZ_RL( 'ADJvvel.', & suff, var3Dv, myIter, myThid ) IF ( dumpAdByRec ) CALL WRITE_REC_XYZ_RL( 'ADJvvel', & var3Dv, dumpAdRecMn, myIter, myThid ) CALL COPY_ADVAR_OUTP( dumRS, wVeld, var3Du, Nr, 12, myThid ) IF (.NOT.dumpAdByRec) CALL WRITE_FLD_XYZ_RL( 'ADJwvel.', & suff, var3Du, myIter, myThid ) IF ( dumpAdByRec ) CALL WRITE_REC_XYZ_RL( 'ADJwvel', & var3Du, dumpAdRecMn, myIter, myThid ) CALL COPY_ADVAR_OUTP( dumRS, EtaNd, var2Du, 1 , 12, myThid ) IF (.NOT.dumpAdByRec) CALL WRITE_FLD_XY_RL( 'ADJetan.', & suff, var2Du, myIter, myThid ) IF ( dumpAdByRec ) CALL WRITE_REC_XY_RL( 'ADJetan', & var2Du, dumpAdRecMn, myIter, myThid ) IF ( .NOT. useSEAICE .AND. .NOT. useEXF ) THEN CALL COPY_AD_UV_OUTP( Fud, Fvd, dumRL, dumRL, & var2Du, var2Dv, 1, 33, myThid ) IF (.NOT.dumpAdByRec) CALL WRITE_FLD_XY_RL( 'ADJtaux.', & suff,var2Du,myIter,myThid ) IF ( dumpAdByRec ) CALL WRITE_REC_XY_RL( 'ADJtaux', & var2Du,dumpAdRecMn, myIter,myThid ) IF (.NOT.dumpAdByRec) CALL WRITE_FLD_XY_RL( 'ADJtauy.', & suff,var2Dv,myIter,myThid ) IF ( dumpAdByRec ) CALL WRITE_REC_XY_RL( 'ADJtauy', & var2Dv,dumpAdRecMn, myIter,myThid ) CALL COPY_ADVAR_OUTP( Qnetd, dumRL, var2Du, 1, 11, myThid ) IF (.NOT.dumpAdByRec) CALL WRITE_FLD_XY_RL( 'ADJqnet.', & suff,var2Du,myIter,myThid ) IF ( dumpAdByRec ) CALL WRITE_REC_XY_RL( 'ADJqnet', & var2Du,dumpAdRecMn, myIter,myThid ) CALL COPY_ADVAR_OUTP( EmPmRd,dumRL, var2Du, 1, 11, myThid ) IF (.NOT.dumpAdByRec) CALL WRITE_FLD_XY_RL( 'ADJempr.', & suff,var2Du,myIter,myThid ) IF ( dumpAdByRec ) CALL WRITE_REC_XY_RL( 'ADJempr', & var2Du,dumpAdRecMn, myIter,myThid ) #ifdef SHORTWAVE_HEATING cc CALL COPY_ADVAR_OUTP( Qsw%d, dumRL, var2Du, 1, 11, myThid ) cc IF (.NOT.dumpAdByRec) CALL WRITE_FLD_XY_RL( 'ADJqsw.', cc & suff,var2Du,myIter,myThid ) cc IF ( dumpAdByRec ) CALL WRITE_REC_XY_RL( 'ADJqsw', cc & var2Du,dumpAdRecMn, myIter,myThid ) #endif ENDIF #ifdef ALLOW_GGL90 cc CALL COPY_ADVAR_OUTP( dumRS,GGL90TKE%d,var3Du,Nr, 12,myThid ) cc IF (.NOT.dumpAdByRec) CALL WRITE_FLD_XYZ_RL( 'ADJggl90tke.', cc & suff, var3Du, myIter, myThid ) cc IF ( dumpAdByRec ) CALL WRITE_REC_XYZ_RL( 'ADJggl90tke', cc & var3Du, dumpAdRecMn, myIter, myThid ) #endif #ifdef ALLOW_DIFFKR_CONTROL CALL COPY_ADVAR_OUTP( dumRS, DiffKrd,var3Du, Nr, 12,myThid ) IF (.NOT.dumpAdByRec) CALL WRITE_FLD_XYZ_RL( 'ADJdiffkr.', & suff, var3Du, myIter, myThid ) IF ( dumpAdByRec ) CALL WRITE_REC_XYZ_RL( 'ADJdiffkr', & var3Du, dumpAdRecMn, myIter, myThid ) #endif #ifdef ALLOW_KAPGM_CONTROL CALL COPY_ADVAR_OUTP( dumRS, KapGMd, var3Du, Nr, 12,myThid ) IF (.NOT.dumpAdByRec) CALL WRITE_FLD_XYZ_RL( 'ADJkapgm.', & suff, var3Du, myIter, myThid ) IF ( dumpAdByRec ) CALL WRITE_REC_XYZ_RL( 'ADJkapgm', & var3Du, dumpAdRecMn, myIter, myThid ) #endif #ifdef ALLOW_KAPREDI_CONTROL CALL COPY_ADVAR_OUTP( dumRS,KapRedid,var3Du, Nr, 12,myThid ) IF (.NOT.dumpAdByRec) CALL WRITE_FLD_XYZ_RL( 'ADJkapredi.', & suff, var3Du, myIter, myThid ) IF ( dumpAdByRec ) CALL WRITE_REC_XYZ_RL( 'ADJkapredi', & var3Du, dumpAdRecMn, myIter, myThid ) #endif #ifdef ALLOW_EDDYPSI_CONTROL CALL COPY_AD_UV_OUTP( EddyPsiXd, EddyPsiYd, dumRL, dumRL, & var3Du, var3Dv, Nr, 33, myThid ) IF (.NOT.dumpAdByRec) CALL WRITE_FLD_XYZ_RL( 'ADJeddypsix.', & suff, var3Du, myIter, myThid ) IF ( dumpAdByRec ) CALL WRITE_REC_XYZ_RL( 'ADJeddypsix', & var3Du, dumpAdRecMn, myIter, myThid ) IF (.NOT.dumpAdByRec) CALL WRITE_FLD_XYZ_RL( 'ADJeddypsiy.', & suff, var3Dv, myIter, myThid ) IF ( dumpAdByRec ) CALL WRITE_REC_XYZ_RL( 'ADJeddypsiy', & var3Dv, dumpAdRecMn, myIter, myThid ) #endif #ifdef ALLOW_SST0_CONTROL CALL COPY_ADVAR_OUTP( SSTd, dumRL, var2Du, 1, 11, myThid ) IF (.NOT.dumpAdByRec) CALL WRITE_FLD_XY_RL( 'ADJsst.', & suff,var2Du,myIter,myThid ) IF ( dumpAdByRec ) CALL WRITE_REC_XY_RL( 'ADJsst', & var2Du,dumpAdRecMn, myIter,myThid ) #endif #ifdef ALLOW_SSS0_CONTROL CALL COPY_ADVAR_OUTP( SSSd, dumRL, var2Du, 1, 11, myThid ) IF (.NOT.dumpAdByRec) CALL WRITE_FLD_XY_RL( 'ADJsss.', & suff,var2Du,myIter,myThid ) IF ( dumpAdByRec ) CALL WRITE_REC_XY_RL( 'ADJsss', & var2Du,dumpAdRecMn, myIter,myThid ) #endif #ifdef ALLOW_BOTTOMDRAG_CONTROL CALL COPY_ADVAR_OUTP( dumRS, BottomDragFldd, & var2Du, 1, 12, myThid ) IF (.NOT.dumpAdByRec) CALL WRITE_FLD_XY_RL( 'ADJbottomdrag.', & suff, var2Du, myIter, myThid ) IF ( dumpAdByRec ) CALL WRITE_REC_XY_RL( 'ADJbottomdrag', & var2Du, dumpAdRecMn, myIter, myThid ) #endif C end if dumpAdVarExch = 2 ENDIF C----------------------------------------------------------------------- #endif /* ndef ALLOW_OPENAD */ C----------------------------------------------------------------------- C-- NOW NMC output #ifndef ALLOW_OPENAD #ifdef ALLOW_MNC IF (useMNC .AND. autodiff_mnc) THEN CALL MNC_CW_SET_UDIM('adstate', -1, myThid) CALL MNC_CW_RL_W_S('D','adstate',0,0,'T',myTime,myThid) CALL MNC_CW_SET_UDIM('adstate', 0, myThid) CALL MNC_CW_I_W_S('I','adstate',0,0,'iter',myIter,myThid) CALL MNC_CW_RL_W_S('D','adstate',0,0,'model_time',myTime, & myThid) IF ( dumpAdVarExch.EQ.2 ) THEN CALL COPY_AD_UV_OUTP( dumRS, dumRS, aduVel, advVel, & var3Du, var3Dv, Nr, 34, myThid ) CALL MNC_CW_RL_W('D','adstate',0,0,'adU', var3Du, myThid) CALL MNC_CW_RL_W('D','adstate',0,0,'adV', var3Dv, myThid) CALL COPY_ADVAR_OUTP( dumRS, adTheta,var3Du, Nr, 12, myThid ) CALL MNC_CW_RL_W('D','adstate',0,0,'adT', var3Du, myThid) CALL COPY_ADVAR_OUTP( dumRS, adSalt,var3Du, Nr, 12, myThid ) CALL MNC_CW_RL_W('D','adstate',0,0,'adS', var3Du, myThid) CALL COPY_ADVAR_OUTP( dumRS, adEtaN, var2Du, 1 , 12, myThid ) CALL MNC_CW_RL_W('D','adstate',0,0,'adEta', var2Du, myThid) CALL COPY_ADVAR_OUTP( dumRS, adwVel, var3Du, Nr, 12, myThid ) CALL MNC_CW_RL_W('D','adstate',0,0,'adW', var3Du, myThid) CALL COPY_ADVAR_OUTP( adQnet, dumRL, var2Du, 1, 11, myThid ) CALL MNC_CW_RL_W('D','adstate',0,0,'adQnet', var2Du, myThid) CALL COPY_ADVAR_OUTP( adEmPmR,dumRL, var2Du, 1, 11, myThid ) CALL MNC_CW_RL_W('D','adstate',0,0,'adEmpmr', var2Du, myThid) CALL COPY_AD_UV_OUTP( adFu, adFv, dumRL, dumRL, & var2Du, var2Dv, 1, 33, myThid ) CALL MNC_CW_RL_W('D','adstate',0,0,'adFu', var2Du, myThid) CALL MNC_CW_RL_W('D','adstate',0,0,'adFv', var2Dv, myThid) #ifdef ALLOW_SST0_CONTROL CALL COPY_ADVAR_OUTP( adSST, dumRL, var2Du, 1, 11, myThid ) CALL MNC_CW_RL_W('D','adstate',0,0,'adSST', var2Du, myThid) #endif #ifdef ALLOW_SSS0_CONTROL CALL COPY_ADVAR_OUTP( adSSS, dumRL, var2Du, 1, 11, myThid ) CALL MNC_CW_RL_W('D','adstate',0,0,'adSSS', var2Du, myThid) #endif #ifdef ALLOW_BOTTOMDRAG_CONTROL CALL COPY_ADVAR_OUTP( dumRS, adBottomDragFld, & var2Du, 1, 12, myThid ) CALL MNC_CW_RL_W('D','adstate',0,0, & 'adBottomDrag', var2Du, myThid) #endif #ifdef ALLOW_DIFFKR_CONTROL CALL COPY_ADVAR_OUTP( dumRS, adDiffKr,var3Du, Nr, 12,myThid ) CALL MNC_CW_RL_W('D','adstate',0,0, & 'adDiffkr', var3Du, myThid) #endif #ifdef ALLOW_KAPGM_CONTROL CALL COPY_ADVAR_OUTP( dumRS, adKapGM, var3Du, Nr, 12,myThid ) CALL MNC_CW_RL_W('D','adstate',0,0, & 'adkapgm', var3Du, myThid) #endif #ifdef ALLOW_KAPREDI_CONTROL CALL COPY_ADVAR_OUTP( dumRS,adKapRedi,var3Du, Nr, 12,myThid ) CALL MNC_CW_RL_W('D','adstate',0,0, & 'adkapredi', var3Du, myThid) #endif ELSE C dumpAdVarExch.NE.2 CALL MNC_CW_RL_W('D','adstate',0,0,'adU', aduVel, myThid) CALL MNC_CW_RL_W('D','adstate',0,0,'adV', advVel, myThid) CALL MNC_CW_RL_W('D','adstate',0,0,'adT', adtheta, myThid) CALL MNC_CW_RL_W('D','adstate',0,0,'adS', adsalt, myThid) CALL MNC_CW_RL_W('D','adstate',0,0,'adEta', adetaN, myThid) CALL MNC_CW_RL_W('D','adstate',0,0,'adW', adwVel, myThid) CALL MNC_CW_RS_W('D','adstate',0,0,'adQnet', adQnet, myThid) CALL MNC_CW_RS_W('D','adstate',0,0,'adEmpmr', adEmpmr, myThid) CALL MNC_CW_RS_W('D','adstate',0,0,'adFu', adfu, myThid) CALL MNC_CW_RS_W('D','adstate',0,0,'adFv', adfv, myThid) #ifdef ALLOW_SST0_CONTROL CALL MNC_CW_RS_W('D','adstate',0,0,'adSST', adsst, myThid) #endif #ifdef ALLOW_SSS0_CONTROL CALL MNC_CW_RS_W('D','adstate',0,0,'adSSS', adsss, myThid) #endif #ifdef ALLOW_BOTTOMDRAG_CONTROL CALL MNC_CW_RL_W('D','adstate',0,0, & 'adBottomDrag', adbottomdragfld, myThid) #endif #ifdef ALLOW_DIFFKR_CONTROL CALL MNC_CW_RL_W('D','adstate',0,0, & 'adDiffkr', addiffkr, myThid) #endif #ifdef ALLOW_KAPGM_CONTROL CALL MNC_CW_RL_W('D','adstate',0,0, & 'adkapgm', adkapgm, myThid) #endif #ifdef ALLOW_KAPREDI_CONTROL CALL MNC_CW_RL_W('D','adstate',0,0, & 'adkapredi', adkapredi, myThid) #endif ENDIF C endif mnc ENDIF #endif /* ALLOW_MNC */ #endif /* ALLOW_OPENAD */ #ifdef ALLOW_EXF cph IF ( useEXF ) CALL EXF_AD_DUMP( myTime, myIter, myThid ) #endif #ifdef ALLOW_SEAICE IF ( useSEAICE ) & CALL SEAICE_AD_DUMP( myTime, myIter, myThid ) #endif #ifdef ALLOW_PTRACERS IF ( usePTRACERS ) & CALL PTRACERS_AD_DUMP( myTime, myIter, myThid ) #endif CALL TIMER_STOP( 'I/O (WRITE) [ADJOINT LOOP]', myThid ) ENDIF #endif /* ALLOW_AUTODIFF_MONITOR */ #endif /* ALLOW_ADJOINT_RUN */ RETURN END