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 12624 for NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE – NEMO

Ignore:
Timestamp:
2020-03-29T12:55:27+02:00 (4 years ago)
Author:
techene
Message:

all: add e3 substitute and limit precompiled files lines to about 130 character, change key_LF into key_QCO, change module name (dynatfQCO, traatfQCO, stepLF)

Location:
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE
Files:
8 edited
3 moved

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/ASM/asminc.F90

    r12616 r12624  
    760760            ! 
    761761            ssh(:,:,Kbb) = ssh(:,:,Kmm)                        ! Update before fields 
    762 #if ! defined key_LF 
     762#if ! defined key_QCO 
    763763            e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 
    764764#endif 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/CRS/crsini.F90

    r12616 r12624  
    176176      
    177177     ! 
    178 #if ! defined key_LF 
    179      ze3t(:,:,:) = e3t(:,:,:,Kmm) 
    180      ze3u(:,:,:) = e3u(:,:,:,Kmm) 
    181      ze3v(:,:,:) = e3v(:,:,:,Kmm) 
    182      ze3w(:,:,:) = e3w(:,:,:,Kmm) 
    183 #else 
    184178     DO jk = 1, jpk 
    185179        ze3t(:,:,jk) = e3t(:,:,jk,Kmm) 
     
    187181        ze3v(:,:,jk) = e3v(:,:,jk,Kmm) 
    188182        ze3w(:,:,jk) = e3w(:,:,jk,Kmm) 
    189      END DO  
    190 #endif  
     183     END DO   
    191184 
    192185     !    3.d.2   Surfaces  
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DOM/domqe.F90

    r12584 r12624  
    4444   PUBLIC  dom_qe_sf_nxt     ! called by steplf.F90 
    4545   PUBLIC  dom_qe_sf_update  ! called by steplf.F90 
    46    PUBLIC  dom_qe_interpol   ! called by dynnxt.F90 
     46   PUBLIC  dom_h_nxt         ! called by steplf.F90 
    4747   PUBLIC  dom_qe_r3c        ! called by steplf.F90 
    4848 
     
    292292 
    293293 
     294   SUBROUTINE dom_h_nxt( kt, Kbb, Kmm, Kaa, kcall ) 
     295      !!---------------------------------------------------------------------- 
     296      !!                ***  ROUTINE dom_qe_sf_nxt  *** 
     297      !! 
     298      !! ** Purpose :  - compute the after water heigh used in tra_zdf, dynnxt, 
     299      !!                 tranxt and dynspg routines 
     300      !! 
     301      !! ** Method  :  - z_star case:  Proportionnaly to the water column thickness. 
     302      !! 
     303      !! ** Action  :  - h(u/v) update wrt ssh/h(u/v)_0 
     304      !! 
     305      !!---------------------------------------------------------------------- 
     306      INTEGER, INTENT( in )           ::   kt             ! time step 
     307      INTEGER, INTENT( in )           ::   Kbb, Kmm, Kaa  ! time step 
     308      INTEGER, INTENT( in ), OPTIONAL ::   kcall          ! optional argument indicating call sequence 
     309      ! 
     310      !!---------------------------------------------------------------------- 
     311      ! 
     312      IF( ln_linssh )   RETURN      ! No calculation in linear free surface 
     313      ! 
     314      IF( ln_timing )   CALL timing_start('dom_h_nxt') 
     315      ! 
     316      IF( kt == nit000 ) THEN 
     317         IF(lwp) WRITE(numout,*) 
     318         IF(lwp) WRITE(numout,*) 'dom_h_nxt : compute after scale factors' 
     319         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~' 
     320      ENDIF 
     321      ! 
     322      ! *********************************** ! 
     323      ! After depths at u- v points         ! 
     324      ! *********************************** ! 
     325      hu(:,:,Kaa) = hu_0(:,:) * ( 1._wp + r3u(:,:,Kaa) ) 
     326      hv(:,:,Kaa) = hv_0(:,:) * ( 1._wp + r3v(:,:,Kaa) ) 
     327      !                                        ! Inverse of the local depth 
     328      r1_hu(:,:,Kaa) = ssumask(:,:) / ( hu(:,:,Kaa) + 1._wp - ssumask(:,:) ) 
     329      r1_hv(:,:,Kaa) = ssvmask(:,:) / ( hv(:,:,Kaa) + 1._wp - ssvmask(:,:) ) 
     330      ! 
     331      IF( ln_timing )   CALL timing_stop('dom_h_nxt') 
     332      ! 
     333   END SUBROUTINE dom_h_nxt 
     334 
     335 
    294336   SUBROUTINE dom_qe_sf_update( kt, Kbb, Kmm, Kaa ) 
    295337      !!---------------------------------------------------------------------- 
     
    398440      ! 
    399441   END SUBROUTINE dom_qe_sf_update 
    400  
    401  
    402    SUBROUTINE dom_qe_interpol( pe3_in, pe3_out, pout ) 
    403       !!--------------------------------------------------------------------- 
    404       !!                  ***  ROUTINE dom_qe_interpol  *** 
    405       !! 
    406       !! ** Purpose :   interpolate scale factors from one grid point to another 
    407       !! 
    408       !! ** Method  :   e3_out = e3_0 + interpolation(e3_in - e3_0) 
    409       !!                - horizontal interpolation: grid cell surface averaging 
    410       !!                - vertical interpolation: simple averaging 
    411       !!---------------------------------------------------------------------- 
    412       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::  pe3_in    ! input e3 to be interpolated 
    413       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::  pe3_out   ! output interpolated e3 
    414       CHARACTER(LEN=*)                , INTENT(in   ) ::  pout      ! grid point of out scale factors 
    415       !                                                             !   =  'U', 'V', 'W, 'F', 'UW' or 'VW' 
    416       ! 
    417       INTEGER ::   ji, jj, jk                                       ! dummy loop indices 
    418       REAL(wp) ::  zlnwd                                            ! =1./0. when ln_wd_il = T/F 
    419       !!---------------------------------------------------------------------- 
    420       ! 
    421       IF(ln_wd_il) THEN 
    422         zlnwd = 1.0_wp 
    423       ELSE 
    424         zlnwd = 0.0_wp 
    425       END IF 
    426       ! 
    427       SELECT CASE ( pout )    !==  type of interpolation  ==! 
    428          ! 
    429       CASE( 'U' )                   !* from T- to U-point : hor. surface weighted mean 
    430          DO_3D_10_10( 1, jpk ) 
    431             pe3_out(ji,jj,jk) = 0.5_wp * (  umask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2u(ji,jj)   & 
    432                &                       * (   e1e2t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) )     & 
    433                &                           + e1e2t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) ) 
    434          END_3D 
    435          CALL lbc_lnk( 'domqe', pe3_out(:,:,:), 'U', 1._wp ) 
    436          pe3_out(:,:,:) = pe3_out(:,:,:) + e3u_0(:,:,:) 
    437          ! 
    438       CASE( 'V' )                   !* from T- to V-point : hor. surface weighted mean 
    439          DO_3D_10_10( 1, jpk ) 
    440             pe3_out(ji,jj,jk) = 0.5_wp * ( vmask(ji,jj,jk)  * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2v(ji,jj)   & 
    441                &                       * (   e1e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) )     & 
    442                &                           + e1e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) ) 
    443          END_3D 
    444          CALL lbc_lnk( 'domqe', pe3_out(:,:,:), 'V', 1._wp ) 
    445          pe3_out(:,:,:) = pe3_out(:,:,:) + e3v_0(:,:,:) 
    446          ! 
    447       CASE( 'F' )                   !* from U-point to F-point : hor. surface weighted mean 
    448          DO_3D_10_10( 1, jpk ) 
    449             pe3_out(ji,jj,jk) = 0.5_wp * (  umask(ji,jj,jk) * umask(ji,jj+1,jk) * (1.0_wp - zlnwd) + zlnwd ) & 
    450                &                       *    r1_e1e2f(ji,jj)                                                  & 
    451                &                       * (   e1e2u(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3u_0(ji,jj  ,jk) )     & 
    452                &                           + e1e2u(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3u_0(ji,jj+1,jk) ) ) 
    453          END_3D 
    454          CALL lbc_lnk( 'domqe', pe3_out(:,:,:), 'F', 1._wp ) 
    455          pe3_out(:,:,:) = pe3_out(:,:,:) + e3f_0(:,:,:) 
    456          ! 
    457       CASE( 'W' )                   !* from T- to W-point : vertical simple mean 
    458          ! 
    459          !zlnwd = 1.0_wp 
    460          pe3_out(:,:,1) = e3w_0(:,:,1) + pe3_in(:,:,1) - e3t_0(:,:,1) 
    461          ! - ML - The use of mask in this formulea enables the special treatment of the last w-point without indirect adressing 
    462 !!gm BUG? use here wmask in case of ISF ?  to be checked 
    463          DO jk = 2, jpk 
    464             pe3_out(:,:,jk) = e3w_0(:,:,jk) + ( 1.0_wp - 0.5_wp * ( tmask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd ) )   & 
    465                &                            * ( pe3_in(:,:,jk-1) - e3t_0(:,:,jk-1) )                               & 
    466                &                            +            0.5_wp * ( tmask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd )     & 
    467                &                            * ( pe3_in(:,:,jk  ) - e3t_0(:,:,jk  ) ) 
    468          END DO 
    469          ! 
    470       CASE( 'UW' )                  !* from U- to UW-point : vertical simple mean 
    471          ! 
    472          !zlnwd = 1.0_wp 
    473          pe3_out(:,:,1) = e3uw_0(:,:,1) + pe3_in(:,:,1) - e3u_0(:,:,1) 
    474          ! - ML - The use of mask in this formaula enables the special treatment of the last w- point without indirect adressing 
    475 !!gm BUG? use here wumask in case of ISF ?  to be checked 
    476          DO jk = 2, jpk 
    477             pe3_out(:,:,jk) = e3uw_0(:,:,jk) + ( 1.0_wp - 0.5_wp * ( umask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd ) )  & 
    478                &                             * ( pe3_in(:,:,jk-1) - e3u_0(:,:,jk-1) )                              & 
    479                &                             +            0.5_wp * ( umask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd )    & 
    480                &                             * ( pe3_in(:,:,jk  ) - e3u_0(:,:,jk  ) ) 
    481          END DO 
    482          ! 
    483       CASE( 'VW' )                  !* from V- to VW-point : vertical simple mean 
    484          ! 
    485          !zlnwd = 1.0_wp 
    486          pe3_out(:,:,1) = e3vw_0(:,:,1) + pe3_in(:,:,1) - e3v_0(:,:,1) 
    487          ! - ML - The use of mask in this formaula enables the special treatment of the last w- point without indirect adressing 
    488 !!gm BUG? use here wvmask in case of ISF ?  to be checked 
    489          DO jk = 2, jpk 
    490             pe3_out(:,:,jk) = e3vw_0(:,:,jk) + ( 1.0_wp - 0.5_wp * ( vmask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd ) )  & 
    491                &                             * ( pe3_in(:,:,jk-1) - e3v_0(:,:,jk-1) )                              & 
    492                &                             +            0.5_wp * ( vmask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd )    & 
    493                &                             * ( pe3_in(:,:,jk  ) - e3v_0(:,:,jk  ) ) 
    494          END DO 
    495       END SELECT 
    496       ! 
    497    END SUBROUTINE dom_qe_interpol 
    498442 
    499443 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DOM/domzgr_substitute.h90

    r12616 r12624  
    1111!! Software governed by the CeCILL license (see ./LICENSE) 
    1212!!---------------------------------------------------------------------- 
    13 #if defined key_LF 
     13#if defined key_QCO 
    1414#   define  e3t(i,j,k,t)   (e3t_0(i,j,k)*(1.+r3t(i,j,t)*tmask(i,j,k))) 
    1515#   define  e3u(i,j,k,t)   (e3u_0(i,j,k)*(1.+r3u(i,j,t)*umask(i,j,k))) 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DYN/dynatfQCO.F90

    r12623 r12624  
    1 MODULE dynatfLF 
     1MODULE dynatfqco 
    22   !!========================================================================= 
    3    !!                       ***  MODULE  dynatfLF  *** 
     3   !!                       ***  MODULE  dynatfqco  *** 
    44   !! Ocean dynamics: time filtering 
    55   !!========================================================================= 
     
    2424 
    2525   !!---------------------------------------------------------------------------------------------- 
    26    !!   dyn_atfLF       : apply Asselin time filtering to "now" velocities and vertical scale factors 
     26   !!   dyn_atf_qco       : apply Asselin time filtering to "now" velocities and vertical scale factors 
    2727   !!---------------------------------------------------------------------------------------------- 
    2828   USE oce            ! ocean dynamics and tracers 
     
    5757   PRIVATE 
    5858 
    59    PUBLIC    dyn_atf_lf   ! routine called by step.F90 
     59   PUBLIC    dyn_atf_qco   ! routine called by step.F90 
    6060 
    6161   !! * Substitutions 
    6262#  include "do_loop_substitute.h90" 
     63#  include "domzgr_substitute.h90" 
    6364   !!---------------------------------------------------------------------- 
    6465   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    6869CONTAINS 
    6970 
    70    SUBROUTINE dyn_atf_lf ( kt, Kbb, Kmm, Kaa, puu, pvv, pe3t, pe3u, pe3v ) 
     71   SUBROUTINE dyn_atf_qco ( kt, Kbb, Kmm, Kaa, puu, pvv, pe3t, pe3u, pe3v ) 
    7172      !!---------------------------------------------------------------------- 
    72       !!                  ***  ROUTINE dyn_atf_lf  *** 
     73      !!                  ***  ROUTINE dyn_atf_qco  *** 
    7374      !! 
    7475      !! ** Purpose :   Finalize after horizontal velocity. Apply the boundary 
     
    106107      !!---------------------------------------------------------------------- 
    107108      ! 
    108       IF( ln_timing    )   CALL timing_start('dyn_atf_lf') 
     109      IF( ln_timing    )   CALL timing_start('dyn_atf_qco') 
    109110      IF( ln_dynspg_ts )   ALLOCATE( zue(jpi,jpj)     , zve(jpi,jpj)     ) 
    110111      IF( l_trddyn     )   ALLOCATE( zua(jpi,jpj,jpk) , zva(jpi,jpj,jpk) ) 
     
    112113      IF( kt == nit000 ) THEN 
    113114         IF(lwp) WRITE(numout,*) 
    114          IF(lwp) WRITE(numout,*) 'dyn_atf_lf : Asselin time filtering' 
     115         IF(lwp) WRITE(numout,*) 'dyn_atf_qco : Asselin time filtering' 
    115116         IF(lwp) WRITE(numout,*) '~~~~~~~' 
    116117      ENDIF 
    117  
    118 !       IF ( ln_dynspg_ts ) THEN 
    119 !          ! Ensure below that barotropic velocities match time splitting estimate 
    120 !          ! Compute actual transport and replace it with ts estimate at "after" time step 
    121 !          zue(:,:) = pe3u(:,:,1,Kaa) * puu(:,:,1,Kaa) * umask(:,:,1) 
    122 !          zve(:,:) = pe3v(:,:,1,Kaa) * pvv(:,:,1,Kaa) * vmask(:,:,1) 
    123 !          DO jk = 2, jpkm1 
    124 !             zue(:,:) = zue(:,:) + pe3u(:,:,jk,Kaa) * puu(:,:,jk,Kaa) * umask(:,:,jk) 
    125 !             zve(:,:) = zve(:,:) + pe3v(:,:,jk,Kaa) * pvv(:,:,jk,Kaa) * vmask(:,:,jk) 
    126 !          END DO 
    127 !          DO jk = 1, jpkm1 
    128 !             puu(:,:,jk,Kaa) = ( puu(:,:,jk,Kaa) - zue(:,:) * r1_hu(:,:,Kaa) + uu_b(:,:,Kaa) ) * umask(:,:,jk) 
    129 !             pvv(:,:,jk,Kaa) = ( pvv(:,:,jk,Kaa) - zve(:,:) * r1_hv(:,:,Kaa) + vv_b(:,:,Kaa) ) * vmask(:,:,jk) 
    130 !          END DO 
    131 !          ! 
    132 !          IF( .NOT.ln_bt_fw ) THEN 
    133 !             ! Remove advective velocity from "now velocities" 
    134 !             ! prior to asselin filtering 
    135 !             ! In the forward case, this is done below after asselin filtering 
    136 !             ! so that asselin contribution is removed at the same time 
    137 !             DO jk = 1, jpkm1 
    138 !                puu(:,:,jk,Kmm) = ( puu(:,:,jk,Kmm) - un_adv(:,:)*r1_hu(:,:,Kmm) + uu_b(:,:,Kmm) )*umask(:,:,jk) 
    139 !                pvv(:,:,jk,Kmm) = ( pvv(:,:,jk,Kmm) - vn_adv(:,:)*r1_hv(:,:,Kmm) + vv_b(:,:,Kmm) )*vmask(:,:,jk) 
    140 !             END DO 
    141 !          ENDIF 
    142 !       ENDIF 
    143 ! 
    144 !       ! Update after velocity on domain lateral boundaries 
    145 !       ! -------------------------------------------------- 
    146 ! # if defined key_agrif 
    147 !       CALL Agrif_dyn( kt )             !* AGRIF zoom boundaries 
    148 ! # endif 
    149 !       ! 
    150 !       CALL lbc_lnk_multi( 'dynatfLF', puu(:,:,:,Kaa), 'U', -1., pvv(:,:,:,Kaa), 'V', -1. )     !* local domain boundaries 
    151 !       ! 
    152 !       !                                !* BDY open boundaries 
    153 !       IF( ln_bdy .AND. ln_dynspg_exp )   CALL bdy_dyn( kt, Kbb, puu, pvv, Kaa ) 
    154 !       IF( ln_bdy .AND. ln_dynspg_ts  )   CALL bdy_dyn( kt, Kbb, puu, pvv, Kaa, dyn3d_only=.true. ) 
    155  
    156 !!$   Do we need a call to bdy_vol here?? 
    157118      ! 
    158119      IF( l_trddyn ) THEN             ! prepare the atf trend computation + some diagnostics 
     
    191152            ! Time-filtered scale factor at t-points 
    192153            ! ---------------------------------------------------- 
    193             DO jk = 1, jpk                                          ! filtered scale factor at T-points 
    194                pe3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( 1._wp + r3t_f(:,:) * tmask(:,:,jk) ) 
    195             END DO 
     154            ! DO jk = 1, jpk                                          ! filtered scale factor at T-points 
     155            !    pe3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( 1._wp + r3t_f(:,:) * tmask(:,:,jk) ) 
     156            ! END DO 
    196157            ! 
    197158            ! 
    198159            IF( ln_dynadv_vec ) THEN      ! Asselin filter applied on velocity 
    199160               ! Before filtered scale factor at (u/v)-points 
    200                DO jk = 1, jpk 
    201                   pe3u(:,:,jk,Kmm) = e3u_0(:,:,jk) * ( 1._wp + r3u_f(:,:) * umask(:,:,jk) ) 
    202                   pe3v(:,:,jk,Kmm) = e3v_0(:,:,jk) * ( 1._wp + r3v_f(:,:) * vmask(:,:,jk) ) 
    203                END DO 
     161               ! DO jk = 1, jpk 
     162               !    pe3u(:,:,jk,Kmm) = e3u_0(:,:,jk) * ( 1._wp + r3u_f(:,:) * umask(:,:,jk) ) 
     163               !    pe3v(:,:,jk,Kmm) = e3v_0(:,:,jk) * ( 1._wp + r3v_f(:,:) * vmask(:,:,jk) ) 
     164               ! END DO 
    204165               ! 
    205166               DO_3D_11_11( 1, jpkm1 ) 
     
    211172               ! 
    212173               DO_3D_11_11( 1, jpkm1 ) 
    213                   zue3a = pe3u(ji,jj,jk,Kaa) * puu(ji,jj,jk,Kaa) 
    214                   zve3a = pe3v(ji,jj,jk,Kaa) * pvv(ji,jj,jk,Kaa) 
    215                   zue3n = pe3u(ji,jj,jk,Kmm) * puu(ji,jj,jk,Kmm) 
    216                   zve3n = pe3v(ji,jj,jk,Kmm) * pvv(ji,jj,jk,Kmm) 
    217                   zue3b = pe3u(ji,jj,jk,Kbb) * puu(ji,jj,jk,Kbb) 
    218                   zve3b = pe3v(ji,jj,jk,Kbb) * pvv(ji,jj,jk,Kbb) 
     174                  ! zue3a = pe3u(ji,jj,jk,Kaa) * puu(ji,jj,jk,Kaa) 
     175                  ! zve3a = pe3v(ji,jj,jk,Kaa) * pvv(ji,jj,jk,Kaa) 
     176                  ! zue3n = pe3u(ji,jj,jk,Kmm) * puu(ji,jj,jk,Kmm) 
     177                  ! zve3n = pe3v(ji,jj,jk,Kmm) * pvv(ji,jj,jk,Kmm) 
     178                  ! zue3b = pe3u(ji,jj,jk,Kbb) * puu(ji,jj,jk,Kbb) 
     179                  ! zve3b = pe3v(ji,jj,jk,Kbb) * pvv(ji,jj,jk,Kbb) 
     180                  ! 
     181                  zue3a = ( 1._wp + r3u(ji,jj,Kaa) * umask(ji,jj,jk) ) * puu(ji,jj,jk,Kaa) 
     182                  zve3a = ( 1._wp + r3v(ji,jj,Kaa) * vmask(ji,jj,jk) ) * pvv(ji,jj,jk,Kaa) 
     183                  zue3n = ( 1._wp + r3u(ji,jj,Kmm) * umask(ji,jj,jk) ) * puu(ji,jj,jk,Kmm) 
     184                  zve3n = ( 1._wp + r3v(ji,jj,Kmm) * vmask(ji,jj,jk) ) * pvv(ji,jj,jk,Kmm) 
     185                  zue3b = ( 1._wp + r3u(ji,jj,Kbb) * umask(ji,jj,jk) ) * puu(ji,jj,jk,Kbb) 
     186                  zve3b = ( 1._wp + r3v(ji,jj,Kbb) * vmask(ji,jj,jk) ) * pvv(ji,jj,jk,Kbb) 
    219187                  !                                                 ! filtered scale factor at U-,V-points 
    220                   pe3u(ji,jj,jk,Kmm) = e3u_0(ji,jj,jk) * ( 1._wp + r3u_f(ji,jj) * umask(ji,jj,jk) ) 
    221                   pe3v(ji,jj,jk,Kmm) = e3v_0(ji,jj,jk) * ( 1._wp + r3v_f(ji,jj) * vmask(ji,jj,jk) ) 
     188                  ! pe3u(ji,jj,jk,Kmm) = e3u_0(ji,jj,jk) * ( 1._wp + r3u_f(ji,jj) * umask(ji,jj,jk) ) 
     189                  ! pe3v(ji,jj,jk,Kmm) = e3v_0(ji,jj,jk) * ( 1._wp + r3v_f(ji,jj) * vmask(ji,jj,jk) ) 
    222190                  ! 
    223                   puu(ji,jj,jk,Kmm) = ( zue3n + atfp * ( zue3b - 2._wp * zue3n  + zue3a ) ) / pe3u(ji,jj,jk,Kmm) !!st ze3u_f(ji,jj,jk) 
    224                   pvv(ji,jj,jk,Kmm) = ( zve3n + atfp * ( zve3b - 2._wp * zve3n  + zve3a ) ) / pe3v(ji,jj,jk,Kmm) !!st ze3v_f(ji,jj,jk) 
     191                  puu(ji,jj,jk,Kmm) = ( zue3n + atfp * ( zue3b - 2._wp * zue3n  + zue3a ) ) / ( 1._wp + r3u_f(ji,jj)*umask(ji,jj,jk) ) !!st ze3u_f(ji,jj,jk) 
     192                  pvv(ji,jj,jk,Kmm) = ( zve3n + atfp * ( zve3b - 2._wp * zve3n  + zve3a ) ) / ( 1._wp + r3v_f(ji,jj)*vmask(ji,jj,jk) ) !!st ze3v_f(ji,jj,jk) 
    225193               END_3D 
    226194               ! 
     
    232200            ! Revert filtered "now" velocities to time split estimate 
    233201            ! Doing it here also means that asselin filter contribution is removed 
    234             zue(:,:) = pe3u(:,:,1,Kmm) * puu(:,:,1,Kmm) * umask(:,:,1) 
    235             zve(:,:) = pe3v(:,:,1,Kmm) * pvv(:,:,1,Kmm) * vmask(:,:,1) 
     202            ! zue(:,:) = pe3u(:,:,1,Kmm) * puu(:,:,1,Kmm) * umask(:,:,1) 
     203            ! zve(:,:) = pe3v(:,:,1,Kmm) * pvv(:,:,1,Kmm) * vmask(:,:,1) 
     204            ! DO jk = 2, jpkm1 
     205            !    zue(:,:) = zue(:,:) + pe3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm) * umask(:,:,jk) 
     206            !    zve(:,:) = zve(:,:) + pe3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) * vmask(:,:,jk) 
     207            ! END DO 
     208            zue(:,:) = e3u(:,:,1,Kmm) * puu(:,:,1,Kmm) * umask(:,:,1) 
     209            zve(:,:) = e3v(:,:,1,Kmm) * pvv(:,:,1,Kmm) * vmask(:,:,1) 
    236210            DO jk = 2, jpkm1 
    237                zue(:,:) = zue(:,:) + pe3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm) * umask(:,:,jk) 
    238                zve(:,:) = zve(:,:) + pe3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) * vmask(:,:,jk) 
     211               zue(:,:) = zue(:,:) + e3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm) * umask(:,:,jk) 
     212               zve(:,:) = zve(:,:) + e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) * vmask(:,:,jk) 
    239213            END DO 
    240214            DO jk = 1, jpkm1 
     
    251225      ! 
    252226      IF(.NOT.ln_linssh ) THEN 
    253          hu(:,:,Kmm) = pe3u(:,:,1,Kmm ) * umask(:,:,1) 
    254          hv(:,:,Kmm) = pe3v(:,:,1,Kmm ) * vmask(:,:,1) 
     227         hu(:,:,Kmm) = e3u(:,:,1,Kmm ) * umask(:,:,1) 
     228         hv(:,:,Kmm) = e3v(:,:,1,Kmm ) * vmask(:,:,1) 
    255229         DO jk = 2, jpkm1 
    256             hu(:,:,Kmm) = hu(:,:,Kmm) + pe3u(:,:,jk,Kmm ) * umask(:,:,jk) 
    257             hv(:,:,Kmm) = hv(:,:,Kmm) + pe3v(:,:,jk,Kmm ) * vmask(:,:,jk) 
     230            hu(:,:,Kmm) = hu(:,:,Kmm) + e3u(:,:,jk,Kmm ) * umask(:,:,jk) 
     231            hv(:,:,Kmm) = hv(:,:,Kmm) + e3v(:,:,jk,Kmm ) * vmask(:,:,jk) 
    258232         END DO 
    259233         r1_hu(:,:,Kmm) = ssumask(:,:) / ( hu(:,:,Kmm) + 1._wp - ssumask(:,:) ) 
     
    261235      ENDIF 
    262236      ! 
    263       uu_b(:,:,Kaa) = pe3u(:,:,1,Kaa) * puu(:,:,1,Kaa) * umask(:,:,1) 
    264       uu_b(:,:,Kmm) = pe3u(:,:,1,Kmm) * puu(:,:,1,Kmm) * umask(:,:,1) 
    265       vv_b(:,:,Kaa) = pe3v(:,:,1,Kaa) * pvv(:,:,1,Kaa) * vmask(:,:,1) 
    266       vv_b(:,:,Kmm) = pe3v(:,:,1,Kmm) * pvv(:,:,1,Kmm) * vmask(:,:,1) 
     237      uu_b(:,:,Kaa) = e3u(:,:,1,Kaa) * puu(:,:,1,Kaa) * umask(:,:,1) 
     238      uu_b(:,:,Kmm) = e3u(:,:,1,Kmm) * puu(:,:,1,Kmm) * umask(:,:,1) 
     239      vv_b(:,:,Kaa) = e3v(:,:,1,Kaa) * pvv(:,:,1,Kaa) * vmask(:,:,1) 
     240      vv_b(:,:,Kmm) = e3v(:,:,1,Kmm) * pvv(:,:,1,Kmm) * vmask(:,:,1) 
    267241      DO jk = 2, jpkm1 
    268          uu_b(:,:,Kaa) = uu_b(:,:,Kaa) + pe3u(:,:,jk,Kaa) * puu(:,:,jk,Kaa) * umask(:,:,jk) 
    269          uu_b(:,:,Kmm) = uu_b(:,:,Kmm) + pe3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm) * umask(:,:,jk) 
    270          vv_b(:,:,Kaa) = vv_b(:,:,Kaa) + pe3v(:,:,jk,Kaa) * pvv(:,:,jk,Kaa) * vmask(:,:,jk) 
    271          vv_b(:,:,Kmm) = vv_b(:,:,Kmm) + pe3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) * vmask(:,:,jk) 
     242         uu_b(:,:,Kaa) = uu_b(:,:,Kaa) + e3u(:,:,jk,Kaa) * puu(:,:,jk,Kaa) * umask(:,:,jk) 
     243         uu_b(:,:,Kmm) = uu_b(:,:,Kmm) + e3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm) * umask(:,:,jk) 
     244         vv_b(:,:,Kaa) = vv_b(:,:,Kaa) + e3v(:,:,jk,Kaa) * pvv(:,:,jk,Kaa) * vmask(:,:,jk) 
     245         vv_b(:,:,Kmm) = vv_b(:,:,Kmm) + e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) * vmask(:,:,jk) 
    272246      END DO 
    273247      uu_b(:,:,Kaa) = uu_b(:,:,Kaa) * r1_hu(:,:,Kaa) 
     
    291265      IF( ln_dynspg_ts )   DEALLOCATE( zue, zve ) 
    292266      IF( l_trddyn     )   DEALLOCATE( zua, zva ) 
    293       IF( ln_timing    )   CALL timing_stop('dyn_atf_lf') 
    294       ! 
    295    END SUBROUTINE dyn_atf_lf 
     267      IF( ln_timing    )   CALL timing_stop('dyn_atf_qco') 
     268      ! 
     269   END SUBROUTINE dyn_atf_qco 
    296270 
    297271   !!========================================================================= 
    298 END MODULE dynatfLF 
     272END MODULE dynatfqco 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/ISF/isfcpl.F90

    r12622 r12624  
    1515   USE isfutils, ONLY : debug 
    1616   USE lib_mpp , ONLY: mpp_sum, mpp_max ! mpp routine 
    17 #if ! defined key_LF 
     17#if ! defined key_QCO 
    1818   USE domvvl  , ONLY: dom_vvl_zgr      ! vertical scale factor interpolation 
    1919#else 
     
    117117      vv   (:,:,:,Kbb)   = vv   (:,:,:,Kmm) 
    118118      ssh (:,:,Kbb)     = ssh (:,:,Kmm) 
    119 #if ! defined key_LF 
     119#if ! defined key_QCO 
    120120      e3t(:,:,:,Kbb)   = e3t(:,:,:,Kmm) 
    121121#endif  
     
    224224      IF(lwp) write(numout,*) 'isfcpl_ssh : recompute scale factor from ssh (new wet cell,Kmm)' 
    225225      IF(lwp) write(numout,*) '~~~~~~~~~~~' 
    226 #if ! defined key_LF 
     226#if ! defined key_QCO 
    227227      DO jk = 1, jpk 
    228228         e3t(:,:,jk,Kmm) =  e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kmm) ) & 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/SBC/sbcice_cice.F90

    r12616 r12624  
    233233!!gm This should be put elsewhere....   (same remark for limsbc) 
    234234!!gm especially here it is assumed zstar coordinate, but it can be ztilde.... 
    235 #if defined key_LF 
     235#if defined key_QCO 
    236236            IF( .NOT.ln_linssh )   CALL dom_qe_zgr( Kbb, Kmm, Kaa )   ! interpolation scale factor, depth and water column 
    237237#else 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/TRA/traadv.F90

    r12377 r12624  
    6565   INTEGER, PARAMETER ::   np_UBS     = 4   ! 3rd order Upstream Biased Scheme 
    6666   INTEGER, PARAMETER ::   np_QCK     = 5   ! QUICK scheme 
    67     
     67 
     68#  include "domzgr_substitute.h90" 
    6869   !!---------------------------------------------------------------------- 
    6970   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    103104      IF( ln_wave .AND. ln_sdw )  THEN 
    104105         DO jk = 1, jpkm1                                                       ! eulerian transport + Stokes Drift 
    105             zuu(:,:,jk) = e2u  (:,:) * e3u(:,:,jk,Kmm) * ( uu(:,:,jk,Kmm) + usd(:,:,jk) ) 
    106             zvv(:,:,jk) = e1v  (:,:) * e3v(:,:,jk,Kmm) * ( vv(:,:,jk,Kmm) + vsd(:,:,jk) ) 
    107             zww(:,:,jk) = e1e2t(:,:)                 * ( ww(:,:,jk) + wsd(:,:,jk) ) 
     106            zuu(:,:,jk) =   & 
     107               &  e2u  (:,:) * e3u(:,:,jk,Kmm) * ( uu(:,:,jk,Kmm) + usd(:,:,jk) ) 
     108            zvv(:,:,jk) =   &  
     109               &  e1v  (:,:) * e3v(:,:,jk,Kmm) * ( vv(:,:,jk,Kmm) + vsd(:,:,jk) ) 
     110            zww(:,:,jk) =   &  
     111               &  e1e2t(:,:)                 * ( ww(:,:,jk) + wsd(:,:,jk) ) 
    108112         END DO 
    109113      ELSE 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/TRA/traatfQCO.F90

    r12623 r12624  
    1 MODULE traatfLF 
     1MODULE traatfqco 
    22   !!====================================================================== 
    3    !!                       ***  MODULE  traatfLF  *** 
     3   !!                       ***  MODULE  traatfqco  *** 
    44   !! Ocean active tracers:  Asselin time filtering for temperature and salinity 
    55   !!====================================================================== 
     
    5252   PRIVATE 
    5353 
    54    PUBLIC   tra_atf_lf       ! routine called by step.F90 
     54   PUBLIC   tra_atf_qco       ! routine called by step.F90 
    5555   PUBLIC   tra_atf_fix_lf   ! to be used in trcnxt !!st WARNING discrepancy here interpol is used 
    56    PUBLIC   tra_atf_qe_lf    ! to be used in trcnxt !!st WARNING discrepancy here interpol is used 
     56   PUBLIC   tra_atf_qco_lf    ! to be used in trcnxt !!st WARNING discrepancy here interpol is used 
    5757 
    5858   !! * Substitutions 
    5959#  include "do_loop_substitute.h90" 
     60#  include "domzgr_substitute.h90" 
    6061   !!---------------------------------------------------------------------- 
    6162   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    6566CONTAINS 
    6667 
    67    SUBROUTINE tra_atf_lf( kt, Kbb, Kmm, Kaa, pts ) 
     68   SUBROUTINE tra_atf_qco( kt, Kbb, Kmm, Kaa, pts ) 
    6869      !!---------------------------------------------------------------------- 
    6970      !!                   ***  ROUTINE traatfLF  *** 
     
    9596      !!---------------------------------------------------------------------- 
    9697      ! 
    97       IF( ln_timing )   CALL timing_start( 'tra_atf_lf') 
     98      IF( ln_timing )   CALL timing_start( 'tra_atf_qco') 
    9899      ! 
    99100      IF( kt == nit000 ) THEN 
    100101         IF(lwp) WRITE(numout,*) 
    101          IF(lwp) WRITE(numout,*) 'tra_atf_lf : apply Asselin time filter to "now" fields' 
     102         IF(lwp) WRITE(numout,*) 'tra_atf_qco : apply Asselin time filter to "now" fields' 
    102103         IF(lwp) WRITE(numout,*) '~~~~~~~' 
    103104      ENDIF 
     
    131132         ! G Nurser 23 Mar 2017. Recalculate trend as Delta(e3t*T)/e3tn; e3tn cancel from pts(Kmm) terms 
    132133         DO jk = 1, jpkm1 
    133             ztrdt(:,:,jk) = ( pts(:,:,jk,jp_tem,Kaa)*e3t(:,:,jk,Kaa) / e3t(:,:,jk,Kmm) - pts(:,:,jk,jp_tem,Kmm)) * zfact 
    134             ztrds(:,:,jk) = ( pts(:,:,jk,jp_sal,Kaa)*e3t(:,:,jk,Kaa) / e3t(:,:,jk,Kmm) - pts(:,:,jk,jp_sal,Kmm)) * zfact 
     134            ! ztrdt(:,:,jk) = ( pts(:,:,jk,jp_tem,Kaa)*e3t(:,:,jk,Kaa) / e3t(:,:,jk,Kmm) - pts(:,:,jk,jp_tem,Kmm)) * zfact 
     135            ! ztrds(:,:,jk) = ( pts(:,:,jk,jp_sal,Kaa)*e3t(:,:,jk,Kaa) / e3t(:,:,jk,Kmm) - pts(:,:,jk,jp_sal,Kmm)) * zfact 
     136            ztrdt(:,:,jk) = ( pts(:,:,jk,jp_tem,Kaa) * (1._wp + r3t(:,:,Kaa) * tmask(:,:,jk))/(1._wp + r3t(:,:,Kmm) * tmask(:,:,jk))  & 
     137               &            - pts(:,:,jk,jp_tem,Kmm) ) * zfact 
     138            ztrds(:,:,jk) = ( pts(:,:,jk,jp_sal,Kaa) * (1._wp + r3t(:,:,Kaa) * tmask(:,:,jk))/(1._wp + r3t(:,:,Kmm) * tmask(:,:,jk))  & 
     139               &            - pts(:,:,jk,jp_sal,Kmm) ) * zfact 
    135140         END DO 
    136141         CALL trd_tra( kt, Kmm, Kaa, 'TRA', jp_tem, jptra_tot, ztrdt ) 
     
    156161      ELSE                                            ! Leap-Frog + Asselin filter time stepping 
    157162         ! 
    158          IF( ln_linssh ) THEN   ;   CALL tra_atf_fix_lf( kt, Kbb, Kmm, Kaa, nit000,      'TRA', pts, jpts )  ! linear free surface 
    159          ELSE                   ;   CALL tra_atf_qe_lf( kt, Kbb, Kmm, Kaa, nit000, rdt, 'TRA', pts, sbc_tsc, sbc_tsc_b, jpts )  ! non-linear free surface 
    160          ENDIF 
    161          ! 
    162          CALL lbc_lnk_multi( 'traatfLF', pts(:,:,:,jp_tem,Kbb) , 'T', 1., pts(:,:,:,jp_sal,Kbb) , 'T', 1., & 
     163         IF ( ln_linssh ) THEN   ;   CALL tra_atf_fix_lf( kt, Kbb, Kmm, Kaa, nit000,      'TRA', pts, jpts )  ! linear free surface 
     164         ELSE                    ;   CALL tra_atf_qco_lf( kt, Kbb, Kmm, Kaa, nit000, rdt, 'TRA', pts, sbc_tsc, sbc_tsc_b, jpts )  ! non-linear free surface 
     165         ENDIF 
     166         ! 
     167         CALL lbc_lnk_multi( 'traatfqco', pts(:,:,:,jp_tem,Kbb) , 'T', 1., pts(:,:,:,jp_sal,Kbb) , 'T', 1., & 
    163168                  &                    pts(:,:,:,jp_tem,Kmm) , 'T', 1., pts(:,:,:,jp_sal,Kmm) , 'T', 1., & 
    164169                  &                    pts(:,:,:,jp_tem,Kaa), 'T', 1., pts(:,:,:,jp_sal,Kaa), 'T', 1.  ) 
     
    181186         &                                  tab3d_2=pts(:,:,:,jp_sal,Kmm), clinfo2=       ' Sn: ', mask2=tmask ) 
    182187      ! 
    183       IF( ln_timing )   CALL timing_stop('tra_atf_lf') 
    184       ! 
    185    END SUBROUTINE tra_atf_lf 
     188      IF( ln_timing )   CALL timing_stop('tra_atf_qco') 
     189      ! 
     190   END SUBROUTINE tra_atf_qco 
    186191 
    187192 
     
    227232 
    228233 
    229    SUBROUTINE tra_atf_qe_lf( kt, Kbb, Kmm, Kaa, kit000, p2dt, cdtype, pt, psbc_tc, psbc_tc_b, kjpt ) 
     234   SUBROUTINE tra_atf_qco_lf( kt, Kbb, Kmm, Kaa, kit000, p2dt, cdtype, pt, psbc_tc, psbc_tc_b, kjpt ) 
    230235      !!---------------------------------------------------------------------- 
    231236      !!                   ***  ROUTINE tra_atf_vvl  *** 
     
    234239      !! 
    235240      !! ** Method  : - Apply a thickness weighted Asselin time filter on now fields. 
    236       !!             pt(Kmm)  = ( e3t(Kmm)*pt(Kmm) + atfp*[ e3t(Kbb)*pt(Kbb) - 2 e3t(Kmm)*pt(Kmm) + e3t_a*pt(Kaa) ] ) 
    237       !!                       /( e3t(Kmm)         + atfp*[ e3t(Kbb)         - 2 e3t(Kmm)         + e3t(Kaa)    ] ) 
     241      !!             pt(Kmm)  = ( e3t_m*pt(Kmm) + atfp*[ e3t_b*pt(Kbb) - 2 e3t_m*pt(Kmm) + e3t_a*pt(Kaa) ] ) 
     242      !!                       /( e3t_m         + atfp*[ e3t_b         - 2 e3t_m         + e3t_a    ] ) 
    238243      !! 
    239244      !! ** Action  : - pt(Kmm) ready for the next time step 
     
    258263      IF( kt == kit000 )  THEN 
    259264         IF(lwp) WRITE(numout,*) 
    260          IF(lwp) WRITE(numout,*) 'tra_atf_vvl : time filtering', cdtype 
     265         IF(lwp) WRITE(numout,*) 'tra_atf_qco : time filtering', cdtype 
    261266         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
    262267      ENDIF 
     
    325330                  IF ( jk == misfkb_cav(ji,jj) ) THEN 
    326331                     ztc_f  = ztc_f  - zfact1 * ( risf_cav_tsc(ji,jj,jn) - risf_cav_tsc_b(ji,jj,jn) )  & 
    327                             &                 * e3t(ji,jj,jk,Kmm) / rhisf_tbl_cav(ji,jj) * rfrac_tbl_cav(ji,jj) 
     332                            &                 * e3t(ji,jj,jk,Kmm) / rhisf_tbl_cav(ji,jj)               & 
     333                            &                 * rfrac_tbl_cav(ji,jj) 
    328334                  END IF 
    329335               END IF 
     
    339345                  IF ( jk == misfkb_par(ji,jj) ) THEN 
    340346                     ztc_f  = ztc_f  - zfact1 * ( risf_par_tsc(ji,jj,jn) - risf_par_tsc_b(ji,jj,jn) )  & 
    341                             &                 * e3t(ji,jj,jk,Kmm) / rhisf_tbl_par(ji,jj) * rfrac_tbl_par(ji,jj) 
     347                            &                 * e3t(ji,jj,jk,Kmm) / rhisf_tbl_par(ji,jj)               & 
     348                            &                 * rfrac_tbl_par(ji,jj) 
    342349                  END IF 
    343350               END IF 
     
    380387      ENDIF 
    381388      ! 
    382    END SUBROUTINE tra_atf_qe_lf 
     389   END SUBROUTINE tra_atf_qco_lf 
    383390 
    384391   !!====================================================================== 
    385 END MODULE traatfLF 
     392END MODULE traatfqco 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/ZDF/zdfmxl.F90

    r12622 r12624  
    3838   !! * Substitutions 
    3939#  include "do_loop_substitute.h90" 
     40#  include "domzgr_substitute.h90" 
    4041   !!---------------------------------------------------------------------- 
    4142   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/stepLF.F90

    r12623 r12624  
    4141   USE iom              ! xIOs server 
    4242   USE domqe 
    43    USE traatfLF          ! time filtering                   (tra_atf_lf routine) 
    44    USE dynatfLF          ! time filtering                   (dyn_atf_lf routine) 
     43   USE traatfqco         ! time filtering                   (tra_atf_qco routine) 
     44   USE dynatfqco         ! time filtering                   (dyn_atf_qco routine) 
    4545   USE dynspg_ts         ! surface pressure gradient: split-explicit scheme (define un_adv) 
    4646   USE bdydyn            ! ocean open boundary conditions (define bdy_dyn) 
     
    186186                            CALL ssh_nxt       ( kstp, Nbb, Nnn, ssh, Naa )    ! after ssh (includes call to div_hor) 
    187187      IF( .NOT.ln_linssh )  CALL dom_qe_r3c    ( ssh(:,:,Naa), r3t(:,:,Naa), r3u(:,:,Naa), r3v(:,:,Naa) ) 
    188       IF( .NOT.ln_linssh )  CALL dom_qe_sf_nxt ( kstp, Nbb, Nnn,      Naa )    ! after vertical scale factors 
     188      IF( .NOT.ln_linssh )  CALL dom_h_nxt     ( kstp, Nbb, Nnn,      Naa )    ! after vertical scale factors 
     189      !IF( .NOT.ln_linssh )  CALL dom_qe_sf_nxt ( kstp, Nbb, Nnn,      Naa )    ! after vertical scale factors 
    189190                            CALL wzv           ( kstp, Nbb, Nnn, ww,  Naa )    ! now cross-level velocity 
    190191      IF( ln_zad_Aimp )     CALL wAimp         ( kstp,      Nnn           )  ! Adaptive-implicit vertical advection partitioning 
     
    214215         IF(.NOT.ln_linssh) CALL dom_qe_r3c    ( ssh(:,:,Naa), r3t(:,:,Naa), r3u(:,:,Naa), r3v(:,:,Naa), r3f(:,:) ) 
    215216         IF(.NOT.ln_linssh) CALL dom_qe_sf_nxt ( kstp, Nbb, Nnn, Naa, kcall=2 )  ! after vertical scale factors (update depth average component) 
     217         !IF(.NOT.ln_linssh) CALL dom_h_nxt ( kstp, Nbb, Nnn, Naa, kcall=2 )  ! after vertical scale factors (update depth average component) 
    216218      ENDIF 
    217219                            CALL dyn_zdf    ( kstp, Nbb, Nnn, Nrhs, uu, vv, Naa  )  ! vertical diffusion 
     
    296298                         CALL ssh_atf       ( kstp, Nbb, Nnn, Naa, ssh )                     ! time filtering of "now" sea surface height 
    297299                         CALL dom_qe_r3c    ( ssh(:,:,Nnn), r3t_f, r3u_f, r3v_f )            ! "now" ssh/h_0 ratio from filtrered ssh 
    298                          CALL tra_atf_lf    ( kstp, Nbb, Nnn, Naa, ts )                      ! time filtering of "now" tracer arrays 
    299                          CALL dyn_atf_lf    ( kstp, Nbb, Nnn, Naa, uu, vv, e3t, e3u, e3v  )  ! time filtering of "now" velocities and scale factors 
     300                         CALL tra_atf_qco   ( kstp, Nbb, Nnn, Naa, ts )                      ! time filtering of "now" tracer arrays 
     301                         CALL dyn_atf_qco   ( kstp, Nbb, Nnn, Naa, uu, vv, e3t, e3u, e3v  )  ! time filtering of "now" velocities and scale factors 
    300302                         r3t(:,:,Nnn) = r3t_f(:,:) 
    301303                         r3u(:,:,Nnn) = r3u_f(:,:) 
Note: See TracChangeset for help on using the changeset viewer.