MODULE dynspg_tam !!---------------------------------------------------------------------- !! This software is governed by the CeCILL licence (Version 2) !!---------------------------------------------------------------------- #if defined key_tam !!====================================================================== !! *** MODULE dynspg_tam *** !! Ocean dynamics: surface pressure gradient control !! Tangent and Adjoint Module !!====================================================================== !! History of the direct module: !! 9.0 ! 05-12 (C. Talandier, G. Madec) Original code !! 9.0 ! 05-12 (V. Garnier) dyn_spg_ctl: Original code !! History of the T&A module: !! 9.0 ! 08-06 (A. Vidard) Skeleton !! ! 08-11 (A. Vidard) nemo v3 !! ! 09-03 (A. Weaver) dynspg_flt_tam !!---------------------------------------------------------------------- !! dyn_spg_tan : update the dynamics trend with the surface pressure !! gradient (tangent routine) !! dyn_spg_adj : update the dynamics trend with the surface pressure !! gradient (adjoint routine) !! dyn_spg_adj_tst : Test of the adjoint routine !!---------------------------------------------------------------------- USE par_kind , ONLY: & ! Precision variables & wp USE par_oce , ONLY: & ! Ocean space and time domain variables & lk_esopa #if defined key_obc USE obc_oce , ONLY: & ! ocean open boundary conditions & ln_vol_cst, & & ln_obc_fla #endif USE dynspg_oce , ONLY: & ! surface pressure gradient variables & lk_dynspg_flt, & & lk_dynspg_ts, & & lk_dynspg_exp, & & lk_dynspg_rl USE in_out_manager, ONLY: & ! I/O manager & lwp, & & numout, & & nit000, & & nitend, & & ctl_stop USE dom_oce , ONLY: & ! Ocean space and time domain & rdt, & & rdtbt ! USE dynspg_exp_tam ! surface pressure gradient (dyn_spg_exp routine) ! USE dynspg_ts_tam ! surface pressure gradient (dyn_spg_ts routine) ! USE dynspg_rl_tam ! surface pressure gradient (dyn_spg_rl routine) USE dynspg_flt_tam ! surface pressure gradient (dyn_spg_flt routine) IMPLICIT NONE PRIVATE !! * Accessibility PUBLIC dyn_spg_tan, & ! routine called by steptan module & dyn_spg_adj, & ! routine called by stepadj module & dyn_spg_adj_tst ! routine controlling adjoint tests #if defined key_tst_tlm PUBLIC dyn_spg_tlm_tst #endif !! * module variables INTEGER :: nspg = 0 ! type of surface pressure gradient scheme defined from lk_dynspg_... !! * Substitutions # include "domzgr_substitute.h90" # include "vectopt_loop_substitute.h90" CONTAINS SUBROUTINE dyn_spg_tan( kt, kindic ) !!---------------------------------------------------------------------- !! *** ROUTINE dyn_spg_tan *** !! !! ** Purpose of the direct routine: !! compute the lateral ocean dynamics physics. !!---------------------------------------------------------------------- INTEGER, INTENT( IN ) :: & & kt ! ocean time-step index INTEGER, INTENT( OUT ) :: & & kindic ! solver flag !!---------------------------------------------------------------------- IF( kt == nit000 ) CALL dyn_spg_ctl_tam ! initialisation & control of options SELECT CASE ( nspg ) ! compute surf. pressure gradient ! trend and add it to the general trend CASE ( 0 ) CALL ctl_stop ( 'dyn_spg_exp_tan not available yet' ) !!! CALL dyn_spg_exp_tan( kt ) ! explicit CASE ( 1 ) CALL ctl_stop ( 'dyn_spg_ts_tan not available yet' ) !!! CALL dyn_spg_ts_tan ( kt ) ! time-splitting CASE ( 2 ) CALL dyn_spg_flt_tan( kt, kindic ) ! filtered CASE ( 3 ) CALL ctl_stop ( 'dyn_spg_rl_tan not available yet' ) !!! CALL dyn_spg_rl_tan ( kt, kindic ) ! rigid lid ! END SELECT ! END SUBROUTINE dyn_spg_tan SUBROUTINE dyn_spg_adj( kt, kindic ) !!---------------------------------------------------------------------- !! *** ROUTINE dyn_spg_adj *** !! !! ** Purpose of the direct routine: !! compute the lateral ocean dynamics physics. !!---------------------------------------------------------------------- INTEGER, INTENT( IN ) :: & & kt ! ocean time-step index INTEGER, INTENT( OUT ) :: & & kindic ! solver flag !!---------------------------------------------------------------------- IF( kt == nitend ) CALL dyn_spg_ctl_tam ! initialisation & control of options SELECT CASE ( nspg ) ! compute surf. pressure gradient ! trend and add it to the general trend CASE ( 0 ) CALL ctl_stop ( 'dyn_spg_exp_adj not available yet' ) !!! CALL dyn_spg_exp_adj( kt ) ! explicit CASE ( 1 ) CALL ctl_stop ( 'dyn_spg_ts_adj not available yet' ) !!! CALL dyn_spg_ts_adj ( kt ) ! time-splitting CASE ( 2 ) CALL dyn_spg_flt_adj( kt, kindic ) ! filtered CASE ( 3 ) CALL ctl_stop ( 'dyn_spg_rl_adj not available yet' ) !!! CALL dyn_spg_rl_adj ( kt, kindic ) ! rigid lid ! END SELECT ! END SUBROUTINE dyn_spg_adj SUBROUTINE dyn_spg_adj_tst( kumadt ) !!----------------------------------------------------------------------- !! !! *** ROUTINE dyn_spg_flt_adj_tst *** !! !! ** Purpose : Test the adjoint routine. !! !! ** Method : Verify the scalar product !! !! ( L dx )^T W dy = dx^T L^T W dy !! !! where L = tangent routine !! L^T = adjoint routine !! W = diagonal matrix of scale factors !! dx = input perturbation (random field) !! dy = L dx !! !! ** Action : Call the appropriate test routine depending on the !! choice of free surface. !! !! History : !! ! 09-01 (A. Weaver) !!----------------------------------------------------------------------- !! * Modules used !! * Arguments INTEGER, INTENT(IN) :: & & kumadt ! Output unit CALL dyn_spg_ctl_tam ! initialisation & control of options SELECT CASE ( nspg ) CASE ( 0 ) CALL ctl_stop ( 'dyn_spg_exp_adj_tst not available yet' ) !!! CALL dyn_spg_exp_adj_tst( kumadt ) ! explicit CASE ( 1 ) CALL ctl_stop ( 'dyn_spg_ts_adj_tst not available yet' ) !!! CALL dyn_spg_ts_adj_tst ( kumadt ) ! time-splitting CASE ( 2 ) CALL dyn_spg_flt_adj_tst( kumadt ) ! filtered CASE ( 3 ) CALL ctl_stop ( 'dyn_spg_rl_adj_tst not available yet' ) !!! CALL dyn_spg_rl_adj_tst ( kumadt ) ! rigid lid ! END SELECT ! END SUBROUTINE dyn_spg_adj_tst SUBROUTINE dyn_spg_ctl_tam !!--------------------------------------------------------------------- !! *** ROUTINE dyn_spg_ctl_tam *** !! !! ** Purpose : Control the consistency between cpp options for !! surface pressure gradient schemes !!---------------------------------------------------------------------- !! * Local declarations INTEGER :: & & ioptio !!---------------------------------------------------------------------- ! Parameter control and print ! --------------------------- ! Control print IF(lwp) THEN WRITE(numout,*) WRITE(numout,*) 'dyn_spg_ctl_tam : choice of the surface pressure gradient scheme' WRITE(numout,*) '~~~~~~~~~~~~~~~' WRITE(numout,*) ' Explicit free surface lk_dynspg_exp = ', lk_dynspg_exp WRITE(numout,*) ' Free surface with time splitting lk_dynspg_ts = ', lk_dynspg_ts WRITE(numout,*) ' Filtered free surface cst volume lk_dynspg_flt = ', lk_dynspg_flt WRITE(numout,*) ' Rigid-lid case lk_dynspg_rl = ', lk_dynspg_rl ENDIF ! Control of surface pressure gradient scheme options ! --------------------------------------------------- ioptio = 0 IF(lk_dynspg_exp) ioptio = ioptio + 1 IF(lk_dynspg_ts ) ioptio = ioptio + 1 IF(lk_dynspg_flt) ioptio = ioptio + 1 IF(lk_dynspg_rl ) ioptio = ioptio + 1 IF( ( ioptio > 1 .AND. .NOT. lk_esopa ) .OR. ioptio == 0 ) & & CALL ctl_stop( ' Choose only one surface pressure gradient scheme with a key cpp' ) IF( lk_esopa ) nspg = -1 IF( lk_dynspg_exp) nspg = 0 IF( lk_dynspg_ts ) nspg = 1 IF( lk_dynspg_flt) nspg = 2 IF( lk_dynspg_rl ) nspg = 3 IF( nspg == 13 ) nspg = 3 IF( lk_esopa ) nspg = -1 IF(lwp) THEN WRITE(numout,*) IF( nspg == -1 ) WRITE(numout,*) ' ESOPA test All scheme used except rigid-lid' IF( nspg == 0 ) WRITE(numout,*) ' explicit free surface' IF( nspg == 1 ) WRITE(numout,*) ' free surface with time splitting scheme' IF( nspg == 2 ) WRITE(numout,*) ' filtered free surface' IF( nspg == 3 ) WRITE(numout,*) ' rigid-lid' IF( nspg == 10 ) WRITE(numout,*) ' explicit free surface with j-k-i loop' IF( nspg == 11 ) WRITE(numout,*) ' time splitting free surface with j-k-i loop' IF( nspg == 12 ) WRITE(numout,*) ' filtered free surface with j-k-i loop' ENDIF ! Control of timestep choice ! -------------------------- IF( lk_dynspg_ts ) THEN IF( MOD( rdt , rdtbt ) /= 0. ) & & CALL ctl_stop( ' The barotropic timestep must be an integer divisor of the baroclinic timestep' ) ENDIF #if defined key_obc ! Conservation of ocean volume (key_dynspg_flt) ! --------------------------------------------- IF( lk_dynspg_flt ) ln_vol_cst = .true. ! Application of Flather's algorithm at open boundaries ! ----------------------------------------------------- IF( lk_dynspg_flt ) ln_obc_fla = .false. IF( lk_dynspg_exp ) ln_obc_fla = .true. IF( lk_dynspg_ts ) ln_obc_fla = .true. #endif END SUBROUTINE dyn_spg_ctl_tam #if defined key_tst_tlm SUBROUTINE dyn_spg_tlm_tst( kumadt ) !!----------------------------------------------------------------------- !! !! *** ROUTINE dyn_spg_tlm_tst *** !! !! ** Purpose : Test the tangent linear routine. !! !! ** Method : Verify the relative error Er of the linear model !! !! Er = 100 norm( En ) / norm( L(t0,tn) gamma dx0 ) !! --> zero when gamma --> zero !! !! where En = Nn( gamma dx0 ) - L(t0, tn ) gamma dx0 !! L = Linear routine !! Nn = Perturbation evolution ( M( x0 + gamma dx0 ) - M( x0 ) ) !! gamma dx0 = input perturbation (random field) !! !! History : !! ! 09-06 (F. Vigilant) !!----------------------------------------------------------------------- !! * Modules used !! * Arguments INTEGER, INTENT(IN) :: & & kumadt ! Output unit CALL dyn_spg_ctl_tam ! initialisation & control of options SELECT CASE ( nspg ) CASE ( 0 ) CALL ctl_stop ( 'dyn_spg_exp_adj_tst not available yet' ) !!! CALL dyn_spg_exp_adj_tst( kumadt ) ! explicit CASE ( 1 ) CALL ctl_stop ( 'dyn_spg_ts_adj_tst not available yet' ) !!! CALL dyn_spg_ts_adj_tst ( kumadt ) ! time-splitting CASE ( 2 ) CALL dyn_spg_flt_tlm_tst( kumadt ) ! filtered CASE ( 3 ) CALL ctl_stop ( 'dyn_spg_rl_adj_tst not available yet' ) !!! CALL dyn_spg_rl_adj_tst ( kumadt ) ! rigid lid ! END SELECT ! END SUBROUTINE dyn_spg_tlm_tst !!====================================================================== #endif #endif END MODULE dynspg_tam