New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 12779 – NEMO

Changeset 12779


Ignore:
Timestamp:
2020-04-20T18:53:13+02:00 (3 years ago)
Author:
techene
Message:

modify TOP to be able to run with key_qco i.e. remove e3. gdep. and use a substitute instead (# include "domzgr_substitute.h90")

Location:
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3
Files:
26 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/cfgs/GYRE_PISCES/cpp_GYRE_PISCES.fcm

    r12724 r12779  
    1 bld::tool::fppkeys   key_mpp_mpi key_iomput key_qco 
     1bld::tool::fppkeys   key_mpp_mpi key_iomput key_top key_qco 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DOM/domqco.F90

    r12732 r12779  
    114114      !!---------------------------------------------------------------------- 
    115115      INTEGER, INTENT(in) :: Kbb, Kmm, Kaa 
    116       !!---------------------------------------------------------------------- 
    117       INTEGER ::   ji, jj, jk 
    118       INTEGER ::   ii0, ii1, ij0, ij1 
    119       REAL(wp)::   zcoef 
    120116      !!---------------------------------------------------------------------- 
    121117      ! 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/oce.F90

    r12761 r12779  
    3535   !! ------------ 
    3636   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ssh, uu_b,  vv_b   !: SSH [m] and barotropic velocities [m/s] 
    37    !REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:,:) ::   ssh           !: SSH [m] 
    38    !REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:,:) ::   uu_b,  vv_b   !: barotropic velocities [m/s] 
    3937    
    4038   !! Arrays at barotropic time step:                   ! befbefore! before !  now   ! after  ! 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/stpMLF.F90

    r12761 r12779  
    245245      IF( lk_diamlr  )   CALL dia_mlr                           ! Update time used in multiple-linear-regression analysis 
    246246 
     247      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     248      ! Now ssh filtering 
     249      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     250                         CALL ssh_atf    ( kstp, Nbb, Nnn, Naa, ssh )            ! time filtering of "now" sea surface height 
     251                         CALL dom_qco_r3c( ssh(:,:,Nnn), r3t_f, r3u_f, r3v_f )   ! "now" ssh/h_0 ratio from filtrered ssh 
    247252#if defined key_top 
    248253      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    249254      ! Passive Tracer Model 
    250255      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    251                          ALLOCATE( zssh_f(jpi,jpj) ) 
    252                          CALL ssh_atf    ( kstp, Nbb, Nnn, Naa , ssh, zssh_f )   ! time filtering of "now" sea surface height 
    253                          CALL dom_qco_r3c( zssh_f, r3t_f, r3u_f, r3v_f )         ! "now" ssh/h_0 ratio from filtrered ssh 
    254                          ! 
    255256                         CALL trc_stp    ( kstp, Nbb, Nnn, Nrhs, Naa )           ! time-stepping 
    256                          DEALLOCATE( zssh_f ) 
    257257#endif 
    258258 
    … …  
    300300!!    place. 
    301301!! 
    302                          CALL zdyn_ts      ( Nnn, Naa, uu, vv )                    ! barotrope ajustment 
     302                         CALL mlf_baro_corr ( Nnn, Naa, uu, vv )                    ! barotrope ajustment 
    303303                         CALL finalize_sbc  ( kstp, Nbb, Naa, uu, vv, ts )          ! boundary condifions 
    304                          CALL ssh_atf       ( kstp, Nbb, Nnn, Naa, ssh )            ! time filtering of "now" sea surface height 
    305                          CALL dom_qco_r3c   ( ssh(:,:,Nnn), r3t_f, r3u_f, r3v_f )   ! "now" ssh/h_0 ratio from filtrered ssh 
    306304                         CALL tra_atf_qco   ( kstp, Nbb, Nnn, Naa, ts )             ! time filtering of "now" tracer arrays 
    307305                         CALL dyn_atf_qco   ( kstp, Nbb, Nnn, Naa, uu, vv  )        ! time filtering of "now" velocities and scale factors 
    … …  
    377375 
    378376 
    379    SUBROUTINE zdyn_ts (Kmm, Kaa, puu, pvv) 
    380       !!---------------------------------------------------------------------- 
    381       !!                  ***  ROUTINE zdyn_ts  *** 
     377   SUBROUTINE mlf_baro_corr (Kmm, Kaa, puu, pvv) 
     378      !!---------------------------------------------------------------------- 
     379      !!                  ***  ROUTINE mlf_baro_corr  *** 
    382380      !! 
    383381      !! ** Purpose :   Finalize after horizontal velocity. 
    … …  
    426424      ENDIF 
    427425      ! 
    428    END SUBROUTINE zdyn_ts 
     426   END SUBROUTINE mlf_baro_corr 
    429427 
    430428 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OFF/dtadyn.F90

    r12724 r12779  
    2323   USE c1d             ! 1D configuration: lk_c1d 
    2424   USE dom_oce         ! ocean domain: variables 
     25#if ! defined key_qco  
    2526   USE domvvl          ! variable volume 
     27#else 
     28   USE domqco 
     29#endif 
    2630   USE zdf_oce         ! ocean vertical physics: variables 
    2731   USE sbc_oce         ! surface module: variables 
    … …  
    5256   PUBLIC   dta_dyn_sed        ! called by nemo_gcm 
    5357   PUBLIC   dta_dyn_atf        ! called by nemo_gcm 
     58#if ! defined key_qco 
    5459   PUBLIC   dta_dyn_sf_interp  ! called by nemo_gcm 
     60#endif 
    5561 
    5662   CHARACTER(len=100) ::   cn_dir          !: Root directory for location of ssr files 
    … …  
    128134      IF( l_ldfslp .AND. .NOT.lk_c1d )   CALL  dta_dyn_slp( kt, Kbb, Kmm )    ! Computation of slopes 
    129135      ! 
    130       ts(:,:,:,jp_tem,Kmm) = sf_dyn(jf_tem)%fnow(:,:,:) * tmask(:,:,:)    ! temperature 
    131       ts(:,:,:,jp_sal,Kmm) = sf_dyn(jf_sal)%fnow(:,:,:) * tmask(:,:,:)    ! salinity 
    132       wndm(:,:)         = sf_dyn(jf_wnd)%fnow(:,:,1) * tmask(:,:,1)    ! wind speed - needed for gas exchange 
    133       fmmflx(:,:)       = sf_dyn(jf_fmf)%fnow(:,:,1) * tmask(:,:,1)    ! downward salt flux (v3.5+) 
    134       fr_i(:,:)         = sf_dyn(jf_ice)%fnow(:,:,1) * tmask(:,:,1)    ! Sea-ice fraction 
    135       qsr (:,:)         = sf_dyn(jf_qsr)%fnow(:,:,1) * tmask(:,:,1)    ! solar radiation 
    136       emp (:,:)         = sf_dyn(jf_emp)%fnow(:,:,1) * tmask(:,:,1)    ! E-P 
     136      ts    (:,:,:,jp_tem,Kmm) = sf_dyn(jf_tem)%fnow(:,:,:) * tmask(:,:,:)    ! temperature 
     137      ts    (:,:,:,jp_sal,Kmm) = sf_dyn(jf_sal)%fnow(:,:,:) * tmask(:,:,:)    ! salinity 
     138      wndm  (:,:)              = sf_dyn(jf_wnd)%fnow(:,:,1) * tmask(:,:,1)    ! wind speed - needed for gas exchange 
     139      fmmflx(:,:)              = sf_dyn(jf_fmf)%fnow(:,:,1) * tmask(:,:,1)    ! downward salt flux (v3.5+) 
     140      fr_i  (:,:)              = sf_dyn(jf_ice)%fnow(:,:,1) * tmask(:,:,1)    ! Sea-ice fraction 
     141      qsr   (:,:)              = sf_dyn(jf_qsr)%fnow(:,:,1) * tmask(:,:,1)    ! solar radiation 
     142      emp   (:,:)              = sf_dyn(jf_emp)%fnow(:,:,1) * tmask(:,:,1)    ! E-P 
    137143      IF( ln_dynrnf ) THEN  
    138          rnf (:,:)      = sf_dyn(jf_rnf)%fnow(:,:,1) * tmask(:,:,1)    ! E-P 
    139          IF( ln_dynrnf_depth .AND. .NOT. ln_linssh )    CALL  dta_dyn_hrnf(Kmm) 
    140       ENDIF 
    141       ! 
    142       uu(:,:,:,Kmm)        = sf_dyn(jf_uwd)%fnow(:,:,:) * umask(:,:,:)    ! effective u-transport 
    143       vv(:,:,:,Kmm)        = sf_dyn(jf_vwd)%fnow(:,:,:) * vmask(:,:,:)    ! effective v-transport 
    144       ww(:,:,:)        = sf_dyn(jf_wwd)%fnow(:,:,:) * tmask(:,:,:)    ! effective v-transport 
     144         rnf(:,:)              = sf_dyn(jf_rnf)%fnow(:,:,1) * tmask(:,:,1)    ! E-P 
     145         IF( ln_dynrnf_depth .AND. .NOT.ln_linssh )   CALL dta_dyn_hrnf( Kmm ) 
     146      ENDIF 
     147      ! 
     148      uu(:,:,:,Kmm)            = sf_dyn(jf_uwd)%fnow(:,:,:) * umask(:,:,:)    ! effective u-transport 
     149      vv(:,:,:,Kmm)            = sf_dyn(jf_vwd)%fnow(:,:,:) * vmask(:,:,:)    ! effective v-transport 
     150      ww(:,:,:)                = sf_dyn(jf_wwd)%fnow(:,:,:) * tmask(:,:,:)    ! effective v-transport 
    145151      ! 
    146152      IF( .NOT.ln_linssh ) THEN 
    147153         ALLOCATE( zemp(jpi,jpj) , zhdivtr(jpi,jpj,jpk) ) 
    148          zhdivtr(:,:,:) = sf_dyn(jf_div)%fnow(:,:,:) * tmask(:,:,:)    ! effective u-transport 
     154         zhdivtr(:,:,:) = sf_dyn(jf_div )%fnow(:,:,:) * tmask(:,:,:)    ! effective u-transport 
    149155         emp_b  (:,:)   = sf_dyn(jf_empb)%fnow(:,:,1) * tmask(:,:,1)    ! E-P 
    150156         zemp   (:,:)   = ( 0.5_wp * ( emp(:,:) + emp_b(:,:) ) + rnf(:,:) + fwbcorr ) * tmask(:,:,1) 
    151          CALL dta_dyn_ssh( kt, zhdivtr, ssh(:,:,Kbb), zemp, ssh(:,:,Kaa), e3t(:,:,:,Kaa) )  !=  ssh, vertical scale factor & vertical transport 
     157#if defined key_qco 
     158         CALL dta_dyn_ssh( kt, zhdivtr, ssh(:,:,Kbb), zemp, ssh(:,:,Kaa) ) 
     159         CALL dom_qco_r3c( ssh(:,:,Kaa), r3t(:,:,Kaa), r3u(:,:,Kaa), r3v(:,:,Kaa) ) 
     160#else 
     161         CALL dta_dyn_ssh( kt, zhdivtr, ssh(:,:,Kbb), zemp, ssh(:,:,Kaa), e3t(:,:,:,Kaa) )  !=  ssh, vertical scale factor 
     162#endif 
    152163         DEALLOCATE( zemp , zhdivtr ) 
    153164         !                                           Write in the tracer restart file 
    … …  
    329340        ENDIF 
    330341        ! 
     342#if defined key_qco 
     343        CALL dom_qco_r3c( ssh(:,:,Kbb), r3t(:,:,Kbb), r3u(:,:,Kbb), r3v(:,:,Kbb) ) 
     344        CALL dom_qco_r3c( ssh(:,:,Kmm), r3t(:,:,Kmm), r3u(:,:,Kmm), r3v(:,:,Kmm) ) 
     345#else 
    331346        DO jk = 1, jpkm1 
    332            e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( 1._wp + ssh(:,:,Kmm) * tmask(:,:,1) / ( ht_0(:,:) + 1.0 - tmask(:,:,1) ) ) 
    333         ENDDO 
     347           e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( 1._wp + ssh(:,:,Kmm) * r1_ht_0(:,:) * tmask(:,:,jk) ) 
     348        END DO 
    334349        e3t(:,:,jpk,Kaa) = e3t_0(:,:,jpk) 
    335350 
    … …  
    342357        ! ------------------------------------ 
    343358        CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3w(:,:,:,Kmm), 'W' ) 
    344    
     359!!gm this should be computed from ssh(Kbb)   
    345360        e3t(:,:,:,Kbb)  = e3t(:,:,:,Kmm) 
    346361        e3u(:,:,:,Kbb)  = e3u(:,:,:,Kmm) 
    … …  
    366381        gdepw(:,:,:,Kbb) = gdepw(:,:,:,Kmm) 
    367382        ! 
    368       ENDIF 
     383     ENDIF 
     384#endif 
    369385      ! 
    370386      IF( ln_dynrnf .AND. ln_dynrnf_depth ) THEN       ! read depht over which runoffs are distributed 
    … …  
    389405            ENDIF 
    390406         END_2D 
     407!!st pourquoi on n'utilise pas le gde3w ici plutôt que de faire une boucle ?  
    391408         DO_2D_11_11 
    392409            h_rnf(ji,jj) = 0._wp 
    … …  
    413430   END SUBROUTINE dta_dyn_init 
    414431 
     432    
    415433   SUBROUTINE dta_dyn_sed( kt, Kmm ) 
    416434      !!---------------------------------------------------------------------- 
    … …  
    529547   END SUBROUTINE dta_dyn_sed_init 
    530548 
     549    
    531550   SUBROUTINE dta_dyn_atf( kt, Kbb, Kmm, Kaa ) 
    532551     !!--------------------------------------------------------------------- 
    … …  
    551570      ! 
    552571   END SUBROUTINE dta_dyn_atf 
     572 
    553573    
     574#if ! defined key_qco     
    554575   SUBROUTINE dta_dyn_sf_interp( kt, Kmm ) 
    555576      !!--------------------------------------------------------------------- 
    … …  
    588609      ! 
    589610   END SUBROUTINE dta_dyn_sf_interp 
    590  
     611#endif 
     612 
     613    
    591614   SUBROUTINE dta_dyn_ssh( kt, phdivtr, psshb,  pemp, pssha, pe3ta ) 
    592615      !!---------------------------------------------------------------------- 
    … …  
    606629      !!          The boundary conditions are w=0 at the bottom (no flux) 
    607630      !! 
    608       !! ** action  :   ssh(:,:,Kaa) / e3t(:,:,:,Kaa) / ww 
     631      !! ** action  :   ssh(:,:,Kaa) / e3t(:,:,k,Kaa) / ww 
    609632      !! 
    610633      !! Reference  : Leclair, M., and G. Madec, 2009, Ocean Modelling. 
    … …  
    630653      !                                                ! Sea surface  elevation time-stepping 
    631654      pssha(:,:) = ( psshb(:,:) - z2dt * ( r1_rho0 * pemp(:,:)  + zhdiv(:,:) ) ) * ssmask(:,:) 
    632       !                                                 !  
    633       !                                                 ! After acale factors at t-points ( z_star coordinate ) 
    634       DO jk = 1, jpkm1 
    635         pe3ta(:,:,jk) = e3t_0(:,:,jk) * ( 1._wp + pssha(:,:) * tmask(:,:,1) / ( ht_0(:,:) + 1.0 - tmask(:,:,1) ) ) 
    636       END DO 
     655      ! 
     656      IF( PRESENT( pe3ta ) ) THEN                      ! After acale factors at t-points ( z_star coordinate ) 
     657         DO jk = 1, jpkm1 
     658            pe3ta(:,:,jk) = e3t_0(:,:,jk) * ( 1._wp + pssha(:,:) * r1_ht_0(:,:) * tmask(:,:,jk) ) 
     659         END DO 
     660      ENDIF 
    637661      ! 
    638662   END SUBROUTINE dta_dyn_ssh 
    … …  
    657681      !!---------------------------------------------------------------------- 
    658682      ! 
     683!!st code dupliqué même remarque que plus haut pourquoi ne pas utiliser gdepw ? 
    659684      DO_2D_11_11 
    660685         h_rnf(ji,jj) = 0._wp 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OFF/nemogcm.F90

    r12724 r12779  
    2828   USE usrdef_nam     ! user defined configuration 
    2929   USE eosbn2         ! equation of state            (eos bn2 routine) 
     30#if defined key_qco 
     31   USE domqco         ! tools for scale factor         (dom_qco_r3c  routine) 
     32#endif 
    3033   !              ! ocean physics 
    3134   USE ldftra         ! lateral diffusivity setting    (ldf_tra_init routine) 
    … …  
    117120                                CALL dta_dyn    ( istp, Nbb, Nnn, Naa )       ! Interpolation of the dynamical fields 
    118121#endif 
     122#if ! defined key_sed_off 
     123         IF( .NOT.ln_linssh ) THEN 
     124                                CALL dta_dyn_atf( istp, Nbb, Nnn, Naa )       ! time filter of sea  surface height and vertical scale factors 
     125# if defined key_qco 
     126                                CALL dom_qco_r3c( ssh(:,:,Kmm), r3t_f, r3u_f, r3v_f ) 
     127# endif 
     128         ENDIF 
    119129                                CALL trc_stp    ( istp, Nbb, Nnn, Nrhs, Naa ) ! time-stepping 
    120 #if ! defined key_sed_off 
    121          IF( .NOT.ln_linssh )   CALL dta_dyn_atf( istp, Nbb, Nnn, Naa )       ! time filter of sea  surface height and vertical scale factors 
     130# if defined key_qco 
     131                                !r3t(:,:,Kmm) = r3t_f(:,:)                     ! update ssh to h0 ratio 
     132                                !r3u(:,:,Kmm) = r3u_f(:,:) 
     133                                !r3v(:,:,Kmm) = r3v_f(:,:) 
     134# endif 
    122135#endif 
    123136         ! Swap time levels 
    … …  
    127140         Naa = Nrhs 
    128141         ! 
    129 #if ! defined key_sed_off 
     142#if ! defined key_qco 
     143# if ! defined key_sed_off 
    130144         IF( .NOT.ln_linssh )   CALL dta_dyn_sf_interp( istp, Nnn )  ! calculate now grid parameters 
    131 #endif 
     145# endif 
     146#endif          
    132147                                CALL stp_ctl    ( istp, indic )  ! Time loop: control and print 
    133148         istp = istp + 1 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/PISCES/P4Z/p4zbio.F90

    r12377 r12779  
    4040   !! * Substitutions 
    4141#  include "do_loop_substitute.h90" 
     42#  include "domzgr_substitute.h90" 
    4243   !!---------------------------------------------------------------------- 
    4344   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/PISCES/P4Z/p4zche.F90

    r12377 r12779  
    132132   !! * Substitutions 
    133133#  include "do_loop_substitute.h90" 
     134#  include "domzgr_substitute.h90" 
    134135   !!---------------------------------------------------------------------- 
    135136   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/PISCES/P4Z/p4zfechem.F90

    r12377 r12779  
    3333   !! * Substitutions 
    3434#  include "do_loop_substitute.h90" 
     35#  include "domzgr_substitute.h90" 
    3536   !!---------------------------------------------------------------------- 
    3637   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/PISCES/P4Z/p4zprod.F90

    r12377 r12779  
    4848   !! * Substitutions 
    4949#  include "do_loop_substitute.h90" 
     50#  include "domzgr_substitute.h90" 
    5051   !!---------------------------------------------------------------------- 
    5152   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/PISCES/P4Z/p4zsink.F90

    r12377 r12779  
    4040   !! * Substitutions 
    4141#  include "do_loop_substitute.h90" 
     42#  include "domzgr_substitute.h90" 
    4243   !!---------------------------------------------------------------------- 
    4344   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/PISCES/P4Z/p5zprod.F90

    r12377 r12779  
    5252   !! * Substitutions 
    5353#  include "do_loop_substitute.h90" 
     54#  include "domzgr_substitute.h90" 
    5455   !!---------------------------------------------------------------------- 
    5556   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/PISCES/SED/oce_sed.F90

    r12724 r12779  
    1313   USE dom_oce , ONLY :   glamt     =>   glamt          !: longitude of t-point (degre) 
    1414   USE dom_oce , ONLY :   gphit     =>   gphit          !: latitude  of t-point (degre) 
    15 !!st USE dom_oce , ONLY :   e3t       =>   e3t            !: latitude  of t-point (degre) 
     15!!st  
     16#if ! defined key_qco 
     17   USE dom_oce , ONLY :   e3t       =>   e3t            !: latitude  of t-point (degre) 
     18#endif 
    1619   USE dom_oce , ONLY :   e3t_1d    =>   e3t_1d         !: reference depth of t-points (m) 
    1720   USE dom_oce , ONLY :   gdepw_0   =>   gdepw_0        !: reference depth of t-points (m) 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/PISCES/trcwri_pisces.F90

    r12377 r12779  
    2121   !! * Substitutions 
    2222#  include "do_loop_substitute.h90" 
     23#  include "domzgr_substitute.h90" 
    2324   !!---------------------------------------------------------------------- 
    2425   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/TRP/trcadv.F90

    r12724 r12779  
    5858   INTEGER, PARAMETER ::   np_UBS     = 4   ! 3rd order Upstream Biased Scheme 
    5959   INTEGER, PARAMETER ::   np_QCK     = 5   ! QUICK scheme 
    60     
     60 
     61#  include "domzgr_substitute.h90" 
    6162   !!---------------------------------------------------------------------- 
    6263   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/TRP/trcatf.F90

    r12724 r12779  
    3131   USE trd_oce 
    3232   USE trdtra 
     33# if defined key_qco 
     34   USE traatfqco 
     35# else 
    3336   USE traatf 
     37# endif 
    3438   USE bdy_oce   , ONLY: ln_bdy 
    3539   USE trcbdy          ! BDY open boundaries 
    … …  
    5054   !! * Substitutions 
    5155#  include "do_loop_substitute.h90" 
     56#  include "domzgr_substitute.h90" 
    5257   !!---------------------------------------------------------------------- 
    5358   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    107112            DO jn = 1, jptra 
    108113               CALL trd_tra( kt, Kmm, Kaa, 'TRC', jn, jptra_zdfp, ztrdt(:,:,:,jn) ) 
    109             ENDDO 
     114            END DO 
    110115         ENDIF 
    111116 
    112117         ! total trend for the non-time-filtered variables.  
    113118         zfact = 1.0 / rn_Dt 
    114          ! G Nurser 23 Mar 2017. Recalculate trend as Delta(e3t*T)/e3tn; e3tn cancel from ts(Kmm) terms 
     119         ! G Nurser 23 Mar 2017. Recalculate trend as Delta(e3ta*Ta)/e3tn; e3tn cancel from ts(Kmm) terms 
    115120         IF( ln_linssh ) THEN       ! linear sea surface height only 
    116121            DO jn = 1, jptra 
    … …  
    129134         DO jn = 1, jptra 
    130135            CALL trd_tra( kt, Kmm, Kaa, 'TRC', jn, jptra_tot, ztrdt(:,:,:,jn) ) 
    131          ENDDO 
     136         END DO 
    132137         ! 
    133138         IF( ln_linssh ) THEN       ! linear sea surface height only 
    … …  
    146151            DO jn = 1, jptra 
    147152               CALL trd_tra( kt, Kmm, Kaa, 'TRC', jn, jptra_atf, ztrdt(:,:,:,jn) ) 
    148             ENDDO 
     153            END DO 
    149154         END IF 
    150155         ! 
    151156      ELSE      
    152157         IF( .NOT. l_offline ) THEN ! Leap-Frog + Asselin filter time stepping 
    153             IF( ln_linssh ) THEN   ;   CALL tra_atf_fix( kt, Kbb, Kmm, Kaa, nittrc000,         'TRC', ptr, jptra )                     !     linear ssh 
    154             ELSE                   ;   CALL tra_atf_vvl( kt, Kbb, Kmm, Kaa, nittrc000, rn_Dt, 'TRC', ptr, sbc_trc, sbc_trc_b, jptra ) ! non-linear ssh 
     158# if defined key_qco 
     159            IF( ln_linssh ) THEN   ;   CALL tra_atf_fix_lf( kt, Kbb, Kmm, Kaa, nittrc000,        'TRC', ptr, jptra )                     !     linear ssh 
     160            ELSE                   ;   CALL tra_atf_qco_lf( kt, Kbb, Kmm, Kaa, nittrc000, rn_Dt, 'TRC', ptr, sbc_trc, sbc_trc_b, jptra ) ! non-linear ssh 
     161# else 
     162            IF( ln_linssh ) THEN   ;   CALL tra_atf_fix   ( kt, Kbb, Kmm, Kaa, nittrc000,        'TRC', ptr, jptra )                     !     linear ssh 
     163            ELSE                   ;   CALL tra_atf_vvl   ( kt, Kbb, Kmm, Kaa, nittrc000, rn_Dt, 'TRC', ptr, sbc_trc, sbc_trc_b, jptra ) ! non-linear ssh 
     164# endif 
    155165            ENDIF 
    156166         ELSE 
    157                                        CALL trc_atf_off( kt, Kbb, Kmm, Kaa, ptr )       ! offline  
     167                                       CALL trc_atf_off   ( kt, Kbb, Kmm, Kaa, ptr )       ! offline 
    158168         ENDIF 
    159169         ! 
    … …  
    182192   END SUBROUTINE trc_atf 
    183193 
    184  
     194# if ! defined key_qco 
    185195   SUBROUTINE trc_atf_off( kt, Kbb, Kmm, Kaa, ptr ) 
    186196      !!---------------------------------------------------------------------- 
    … …  
    198208      !!                This can be summurized for tempearture as: 
    199209      !!             ztm = ( e3t_n*tn + rbcp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )   ln_dynhpg_imp = T 
    200       !!                  /( e3t(:,:,:,Kmm)    + rbcp*[ e3t(:,:,:,Kbb)    - 2 e3t(:,:,:,Kmm)    + e3t(:,:,:,Kaa)    ] )    
     210      !!                  /( e3t(:,:,jk,Kmm)    + rbcp*[ e3t(:,:,jk,Kbb)    - 2 e3t(:,:,jk,Kmm)    + e3t(:,:,jk,Kaa)    ] )    
    201211      !!             ztm = 0                                                       otherwise 
    202212      !!             tb  = ( e3t_n*tn + rn_atfp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] ) 
    203       !!                  /( e3t(:,:,:,Kmm)    + rn_atfp*[ e3t(:,:,:,Kbb)    - 2 e3t(:,:,:,Kmm)    + e3t(:,:,:,Kaa)    ] ) 
     213      !!                  /( e3t(:,:,jk,Kmm)    + rn_atfp*[ e3t(:,:,jk,Kbb)    - 2 e3t(:,:,jk,Kmm)    + e3t(:,:,jk,Kaa)    ] ) 
    204214      !!             tn  = ta  
    205215      !!             ta  = zt        (NB: reset to 0 after eos_bn2 call) 
    … …  
    257267      ! 
    258268   END SUBROUTINE trc_atf_off 
    259  
     269# else 
     270   SUBROUTINE trc_atf_off( kt, Kbb, Kmm, Kaa, ptr ) 
     271      !!---------------------------------------------------------------------- 
     272      !!                   ***  ROUTINE tra_atf_off  *** 
     273      !! 
     274      !!          !!!!!!!!!!!!!!!!! REWRITE HEADER COMMENTS !!!!!!!!!!!!!! 
     275      !! 
     276      !! ** Purpose :   Time varying volume: apply the Asselin time filter   
     277      !!  
     278      !! ** Method  : - Apply a thickness weighted Asselin time filter on now fields. 
     279      !!              - save in (ta,sa) a thickness weighted average over the three  
     280      !!             time levels which will be used to compute rdn and thus the semi- 
     281      !!             implicit hydrostatic pressure gradient (ln_dynhpg_imp = T) 
     282      !!              - swap tracer fields to prepare the next time_step. 
     283      !!                This can be summurized for tempearture as: 
     284      !!             ztm = ( e3t_n*tn + rbcp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )   ln_dynhpg_imp = T 
     285      !!                  /( e3t(:,:,jk,Kmm)    + rbcp*[ e3t(:,:,jk,Kbb)    - 2 e3t(:,:,jk,Kmm)    + e3t(:,:,jk,Kaa)    ] )    
     286      !!             ztm = 0                                                       otherwise 
     287      !!             tb  = ( e3t_n*tn + rn_atfp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] ) 
     288      !!                  /( e3t(:,:,jk,Kmm)    + rn_atfp*[ e3t(:,:,jk,Kbb)    - 2 e3t(:,:,jk,Kmm)    + e3t(:,:,jk,Kaa)    ] ) 
     289      !!             tn  = ta  
     290      !!             ta  = zt        (NB: reset to 0 after eos_bn2 call) 
     291      !! 
     292      !! ** Action  : - (tb,sb) and (tn,sn) ready for the next time step 
     293      !!              - (ta,sa) time averaged (t,s)   (ln_dynhpg_imp = T) 
     294      !!---------------------------------------------------------------------- 
     295      INTEGER                                   , INTENT(in   ) ::  kt            ! ocean time-step index 
     296      INTEGER                                   , INTENT(in   ) ::  Kbb, Kmm, Kaa ! time level indices 
     297      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) ::  ptr           ! passive tracers 
     298      !!      
     299      INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices 
     300      REAL(wp) ::   ztc_a , ztc_n , ztc_b , ztc_f , ztc_d    ! local scalar 
     301      REAL(wp) ::   ze3t_b, ze3t_n, ze3t_a, ze3t_f           !   -      - 
     302      !!---------------------------------------------------------------------- 
     303      ! 
     304      IF( kt == nittrc000 )  THEN 
     305         IF(lwp) WRITE(numout,*) 
     306         IF(lwp) WRITE(numout,*) 'trc_atf_off : Asselin time filtering' 
     307         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
     308         IF( .NOT. ln_linssh ) THEN 
     309            rfact1 = rn_atfp * rn_Dt 
     310            rfact2 = rfact1 / rho0 
     311         ENDIF 
     312        !   
     313      ENDIF 
     314      ! 
     315      DO jn = 1, jptra       
     316         DO_3D_11_11( 1, jpkm1 ) 
     317            ze3t_b = 1._wp + r3t(ji,jj,Kbb) * tmask(ji,jj,jk) 
     318            ze3t_n = 1._wp + r3t(ji,jj,Kmm) * tmask(ji,jj,jk) 
     319            ze3t_a = 1._wp + r3t(ji,jj,Kaa) * tmask(ji,jj,jk) 
     320            !                                         ! tracer content at Before, now and after 
     321            ztc_b  = ptr(ji,jj,jk,jn,Kbb) * ze3t_b 
     322            ztc_n  = ptr(ji,jj,jk,jn,Kmm) * ze3t_n 
     323            ztc_a  = ptr(ji,jj,jk,jn,Kaa) * ze3t_a 
     324            ! 
     325            ztc_d  = ztc_a  - 2. * ztc_n  + ztc_b 
     326            ! 
     327            ze3t_f = 1._wp + r3t_f(ji,jj)*tmask(ji,jj,jk) 
     328            ztc_f  = ztc_n  + rn_atfp * ztc_d 
     329            ! 
     330            IF( .NOT. ln_linssh .AND. jk == mikt(ji,jj) ) THEN           ! first level  
     331               ztc_f  = ztc_f  - rfact1 * ( sbc_trc(ji,jj,jn) - sbc_trc_b(ji,jj,jn) ) 
     332            ENDIF 
     333 
     334            ze3t_f = 1.e0 / ze3t_f 
     335            ptr(ji,jj,jk,jn,Kmm) = ztc_f * ze3t_f     ! time filtered "now" field 
     336            ! 
     337         END_3D 
     338         !  
     339      END DO 
     340      ! 
     341   END SUBROUTINE trc_atf_off 
     342# endif 
     343    
    260344#else 
    261345   !!---------------------------------------------------------------------- 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/TRP/trcdmp.F90

    r12377 r12779  
    4545   !! * Substitutions 
    4646#  include "do_loop_substitute.h90" 
     47#  include "domzgr_substitute.h90" 
    4748   !!---------------------------------------------------------------------- 
    4849   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/TRP/trcldf.F90

    r12377 r12779  
    4444   !! * Substitutions 
    4545#  include "do_loop_substitute.h90" 
     46#  include "domzgr_substitute.h90" 
    4647   !!---------------------------------------------------------------------- 
    4748   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/TRP/trcsbc.F90

    r12724 r12779  
    3030   !! * Substitutions 
    3131#  include "do_loop_substitute.h90" 
     32#  include "domzgr_substitute.h90" 
    3233   !!---------------------------------------------------------------------- 
    3334   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    4950      !!            The surface freshwater flux modify the ocean volume 
    5051      !!         and thus the concentration of a tracer as : 
    51       !!            tr(Krhs) = tr(Krhs) + emp * tr(Kmm) / e3t   for k=1 
     52      !!            tr(Krhs) = tr(Krhs) + emp * tr(Kmm) / e3t_   for k=1 
    5253      !!         where emp, the surface freshwater budget (evaporation minus 
    5354      !!         precipitation ) given in kg/m2/s is divided 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/TRP/trdmxl_trc.F90

    r12724 r12779  
    5151   !! * Substitutions 
    5252#  include "do_loop_substitute.h90" 
     53#  include "domzgr_substitute.h90" 
    5354   !!---------------------------------------------------------------------- 
    5455   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/trcbc.F90

    r12724 r12779  
    4848   !! * Substitutions 
    4949#  include "do_loop_substitute.h90" 
     50#  include "domzgr_substitute.h90" 
    5051   !!---------------------------------------------------------------------- 
    5152   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/trcdta.F90

    r12377 r12779  
    4141   !! Substitutions 
    4242#include "do_loop_substitute.h90" 
     43#include "domzgr_substitute.h90" 
    4344   !!---------------------------------------------------------------------- 
    4445   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    206207                     ztp(jk) = ptrcdta(ji,jj,jpkm1) 
    207208                  ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1 
    208                      DO jkk = 1, jpkm1                                  ! when  gdept(jkk) < zl < gdept(jkk+1) 
     209                     DO jkk = 1, jpkm1                                  ! when  gdept_1d(jkk) < zl < gdept_1d(jkk+1) 
    209210                        IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 
    210211                           zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk)) 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/trcini.F90

    r12377 r12779  
    3030    
    3131   PUBLIC   trc_init   ! called by opa 
    32  
     32    
     33#  include "domzgr_substitute.h90" 
    3334   !!---------------------------------------------------------------------- 
    3435   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/trcrst.F90

    r12724 r12779  
    3333   PUBLIC   trc_rst_cal 
    3434 
     35#  include "domzgr_substitute.h90" 
    3536   !!---------------------------------------------------------------------- 
    3637   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/trcstp.F90

    r12724 r12779  
    3636   REAL(wp) ::   rsecfst, rseclast       ! ??? 
    3737   REAL(wp), DIMENSION(:,:,:), SAVE, ALLOCATABLE ::   qsr_arr   ! save qsr during TOP time-step 
    38  
     38    
     39#  include "domzgr_substitute.h90" 
    3940   !!---------------------------------------------------------------------- 
    4041   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 

  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/TOP/trcwri.F90

    r12377 r12779  
    6060       CALL iom_put( "e3v_0", e3v_0(:,:,:) ) 
    6161       ! 
     62#if ! defined key_qco 
    6263       CALL iom_put( "e3t" , e3t(:,:,:,Kmm) ) 
    6364       CALL iom_put( "e3u" , e3u(:,:,:,Kmm) ) 
    6465       CALL iom_put( "e3v" , e3v(:,:,:,Kmm) ) 
     66#endif  
    6567       ! 
    6668      ENDIF 
Note: See TracChangeset for help on using the changeset viewer.