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 14834 for NEMO/trunk/src/OCE/ZDF – NEMO

Ignore:
Timestamp:
2021-05-11T11:24:44+02:00 (3 years ago)
Author:
hadcv
Message:

#2600: Merge in dev_r14273_HPC-02_Daley_Tiling

Location:
NEMO/trunk/src/OCE/ZDF
Files:
12 edited

Legend:

Unmodified
Added
Removed
  • NEMO/trunk/src/OCE/ZDF/zdfddm.F90

    r14053 r14834  
    8383      REAL(dp) ::          zavfs    !   -      - 
    8484      REAL(wp) ::   zavdt, zavds    !   -      - 
    85       REAL(wp), DIMENSION(jpi,jpj) ::   zrau, zmsks, zmskf, zmskd1, zmskd2, zmskd3 
     85      REAL(wp), DIMENSION(A2D(nn_hls)) ::   zrau, zmsks, zmskf, zmskd1, zmskd2, zmskd3 
    8686      !!---------------------------------------------------------------------- 
    8787      ! 
     
    9595!!gm                            and many acces in memory 
    9696          
    97          DO_2D( 1, 1, 1, 1 )           !==  R=zrau = (alpha / beta) (dk[t] / dk[s])  ==! 
     97         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )           !==  R=zrau = (alpha / beta) (dk[t] / dk[s])  ==! 
    9898            zrw =   ( gdepw(ji,jj,jk  ,Kmm) - gdept(ji,jj,jk,Kmm) )   & 
    9999!!gm please, use e3w at Kmm below  
     
    111111         END_2D 
    112112 
    113          DO_2D( 1, 1, 1, 1 )           !==  indicators  ==! 
     113         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )           !==  indicators  ==! 
    114114            ! stability indicator: msks=1 if rn2>0; 0 elsewhere 
    115115            IF( rn2(ji,jj,jk) + 1.e-12  <= 0. ) THEN   ;   zmsks(ji,jj) = 0._wp 
     
    135135         END_2D 
    136136         ! mask zmsk in order to have avt and avs masked 
    137          zmsks(:,:) = zmsks(:,:) * wmask(:,:,jk) 
     137         zmsks(:,:) = zmsks(:,:) * wmask(A2D(nn_hls),jk) 
    138138 
    139139 
     
    141141         ! ------------------ 
    142142         ! Constant eddy coefficient: reset to the background value 
    143          DO_2D( 1, 1, 1, 1 ) 
     143         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    144144            zinr = 1._wp / zrau(ji,jj) 
    145145            ! salt fingering 
  • NEMO/trunk/src/OCE/ZDF/zdfdrg.F90

    r13558 r14834  
    117117      ! 
    118118      IF( l_log_not_linssh ) THEN     !==  "log layer"  ==!   compute Cd and -Cd*|U| 
    119          DO_2D( 0, 0, 0, 0 ) 
     119         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    120120            imk = k_mk(ji,jj)          ! ocean bottom level at t-points 
    121121            zut = uu(ji,jj,imk,Kmm) + uu(ji-1,jj,imk,Kmm)     ! 2 x velocity at t-point 
     
    129129         END_2D 
    130130      ELSE                                            !==  standard Cd  ==! 
    131          DO_2D( 0, 0, 0, 0 ) 
     131         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    132132            imk = k_mk(ji,jj)    ! ocean bottom level at t-points 
    133133            zut = uu(ji,jj,imk,Kmm) + uu(ji-1,jj,imk,Kmm)     ! 2 x velocity at t-point 
     
    432432            l_log_not_linssh = .FALSE.    !- don't update Cd at each time step 
    433433            ! 
    434             DO_2D( 1, 1, 1, 1 )              ! pCd0 = mask (and boosted) logarithmic drag coef. 
     434            DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )              ! pCd0 = mask (and boosted) logarithmic drag coef. 
    435435               zzz =  0.5_wp * e3t_0(ji,jj,k_mk(ji,jj)) 
    436436               zcd = (  vkarmn / LOG( zzz / rn_z0 )  )**2 
  • NEMO/trunk/src/OCE/ZDF/zdfevd.F90

    r13295 r14834  
    6262      ! 
    6363      INTEGER ::   ji, jj, jk   ! dummy loop indices 
    64       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zavt_evd, zavm_evd 
     64      ! NOTE: [tiling] use a SAVE array to store diagnostics, then send after all tiles are finished. This is necessary because p_avt/p_avm are modified on adjacent tiles when using nn_hls > 1. zavt_evd/zavm_evd are then zero on some points when subsequently calculated for these tiles. 
     65      REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   zavt_evd, zavm_evd 
    6566      !!---------------------------------------------------------------------- 
    6667      ! 
    67       IF( kt == nit000 ) THEN 
    68          IF(lwp) WRITE(numout,*) 
    69          IF(lwp) WRITE(numout,*) 'zdf_evd : Enhanced Vertical Diffusion (evd)' 
    70          IF(lwp) WRITE(numout,*) '~~~~~~~ ' 
    71          IF(lwp) WRITE(numout,*) 
     68      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     69         IF( kt == nit000 ) THEN 
     70            IF(lwp) WRITE(numout,*) 
     71            IF(lwp) WRITE(numout,*) 'zdf_evd : Enhanced Vertical Diffusion (evd)' 
     72            IF(lwp) WRITE(numout,*) '~~~~~~~ ' 
     73            IF(lwp) WRITE(numout,*) 
     74         ENDIF 
     75 
     76         ALLOCATE( zavt_evd(jpi,jpj,jpk) ) 
     77         IF( nn_evdm == 1 ) ALLOCATE( zavm_evd(jpi,jpj,jpk) ) 
    7278      ENDIF 
    7379      ! 
    7480      ! 
    75       zavt_evd(:,:,:) = p_avt(:,:,:)         ! set avt prior to evd application 
     81      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 
     82         zavt_evd(ji,jj,jk) = p_avt(ji,jj,jk)         ! set avt prior to evd application 
     83      END_3D 
    7684      ! 
    7785      SELECT CASE ( nn_evdm ) 
     
    7987      CASE ( 1 )           !==  enhance tracer & momentum Kz  ==!   (if rn2<-1.e-12) 
    8088         ! 
    81          zavm_evd(:,:,:) = p_avm(:,:,:)      ! set avm prior to evd application 
     89         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 
     90            zavm_evd(ji,jj,jk) = p_avm(ji,jj,jk)      ! set avm prior to evd application 
     91         END_3D 
    8292         ! 
    8393!! change last digits results 
     
    8797!         END WHERE 
    8898         ! 
    89          DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     99         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
    90100            IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) THEN 
    91101               p_avt(ji,jj,jk) = rn_evd * wmask(ji,jj,jk) 
     
    94104         END_3D 
    95105         ! 
    96          zavm_evd(:,:,:) = p_avm(:,:,:) - zavm_evd(:,:,:)   ! change in avm due to evd 
    97          CALL iom_put( "avm_evd", zavm_evd )                ! output this change 
     106         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 
     107            zavm_evd(ji,jj,jk) = p_avm(ji,jj,jk) - zavm_evd(ji,jj,jk)   ! change in avm due to evd 
     108         END_3D 
     109         IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN                       ! Do only on the last tile 
     110            CALL iom_put( "avm_evd", zavm_evd )                ! output this change 
     111            DEALLOCATE( zavm_evd ) 
     112         ENDIF 
    98113         ! 
    99114      CASE DEFAULT         !==  enhance tracer Kz  ==!   (if rn2<-1.e-12)  
     
    103118!         END WHERE 
    104119 
    105          DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     120         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
    106121            IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 )   & 
    107122               p_avt(ji,jj,jk) = rn_evd * wmask(ji,jj,jk) 
     
    110125      END SELECT  
    111126      ! 
    112       zavt_evd(:,:,:) = p_avt(:,:,:) - zavt_evd(:,:,:)   ! change in avt due to evd 
    113       CALL iom_put( "avt_evd", zavt_evd )              ! output this change 
     127      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 
     128         zavt_evd(ji,jj,jk) = p_avt(ji,jj,jk) - zavt_evd(ji,jj,jk)   ! change in avt due to evd 
     129      END_3D 
     130      IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN                       ! Do only on the last tile 
     131         CALL iom_put( "avt_evd", zavt_evd )              ! output this change 
     132         DEALLOCATE( zavt_evd ) 
     133      ENDIF 
    114134      IF( l_trdtra ) CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_evd, zavt_evd ) 
    115135      ! 
  • NEMO/trunk/src/OCE/ZDF/zdfgls.F90

    r14156 r14834  
    137137      USE zdf_oce , ONLY : en, avtb, avmb   ! ocean vertical physics 
    138138      !! 
    139       INTEGER                   , INTENT(in   ) ::   kt             ! ocean time step 
    140       INTEGER                   , INTENT(in   ) ::   Kbb, Kmm       ! ocean time level indices 
    141       REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   p_sh2          ! shear production term 
    142       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   p_avm, p_avt   !  momentum and tracer Kz (w-points) 
     139      INTEGER                             , INTENT(in   ) ::   kt             ! ocean time step 
     140      INTEGER                             , INTENT(in   ) ::   Kbb, Kmm       ! ocean time level indices 
     141      REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(in   ) ::   p_sh2          ! shear production term 
     142      REAL(wp), DIMENSION(:,:,:)          , INTENT(inout) ::   p_avm, p_avt   !  momentum and tracer Kz (w-points) 
    143143      ! 
    144144      INTEGER  ::   ji, jj, jk    ! dummy loop arguments 
     
    151151      REAL(wp) ::   gh, gm, shr, dif, zsqen, zavt, zavm !   -      - 
    152152      REAL(wp) ::   zmsku, zmskv                        !   -      - 
    153       REAL(wp), DIMENSION(jpi,jpj)     ::   zdep 
    154       REAL(wp), DIMENSION(jpi,jpj)     ::   zkar 
    155       REAL(wp), DIMENSION(jpi,jpj)     ::   zflxs       ! Turbulence fluxed induced by internal waves 
    156       REAL(wp), DIMENSION(jpi,jpj)     ::   zhsro       ! Surface roughness (surface waves) 
    157       REAL(wp), DIMENSION(jpi,jpj)     ::   zice_fra    ! Tapering of wave breaking under sea ice 
    158       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   eb          ! tke at time before 
    159       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   hmxl_b      ! mixing length at time before 
    160       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   eps         ! dissipation rate 
    161       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwall_psi   ! Wall function use in the wb case (ln_sigpsi) 
    162       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   psi         ! psi at time now 
    163       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zd_lw, zd_up, zdiag   ! lower, upper  and diagonal of the matrix 
    164       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zstt, zstm  ! stability function on tracer and momentum 
     153      REAL(wp), DIMENSION(A2D(nn_hls))     ::   zdep 
     154      REAL(wp), DIMENSION(A2D(nn_hls))     ::   zkar 
     155      REAL(wp), DIMENSION(A2D(nn_hls))     ::   zflxs                 ! Turbulence fluxed induced by internal waves 
     156      REAL(wp), DIMENSION(A2D(nn_hls))     ::   zhsro                 ! Surface roughness (surface waves) 
     157      REAL(wp), DIMENSION(A2D(nn_hls))     ::   zice_fra              ! Tapering of wave breaking under sea ice 
     158      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   eb                    ! tke at time before 
     159      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   hmxl_b                ! mixing length at time before 
     160      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   eps                   ! dissipation rate 
     161      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zwall_psi             ! Wall function use in the wb case (ln_sigpsi) 
     162      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   psi                   ! psi at time now 
     163      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zd_lw, zd_up, zdiag   ! lower, upper  and diagonal of the matrix 
     164      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zstt, zstm            ! stability function on tracer and momentum 
    165165      !!-------------------------------------------------------------------- 
    166166      ! 
    167167      ! Preliminary computing 
    168  
    169       ustar2_surf(:,:) = 0._wp   ;         psi(:,:,:) = 0._wp 
    170       ustar2_top (:,:) = 0._wp   ;   zwall_psi(:,:,:) = 0._wp 
    171       ustar2_bot (:,:) = 0._wp 
     168      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     169         ustar2_surf(ji,jj) = 0._wp   ;   ustar2_top(ji,jj) = 0._wp   ;   ustar2_bot(ji,jj) = 0._wp 
     170      END_2D 
     171      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 
     172         psi(ji,jj,jk) = 0._wp   ;   zwall_psi(ji,jj,jk) = 0._wp 
     173      END_3D 
    172174 
    173175      SELECT CASE ( nn_z0_ice ) 
    174176      CASE( 0 )   ;   zice_fra(:,:) = 0._wp 
    175       CASE( 1 )   ;   zice_fra(:,:) =        TANH( fr_i(:,:) * 10._wp ) 
    176       CASE( 2 )   ;   zice_fra(:,:) =              fr_i(:,:) 
    177       CASE( 3 )   ;   zice_fra(:,:) = MIN( 4._wp * fr_i(:,:) , 1._wp ) 
     177      CASE( 1 )   ;   zice_fra(:,:) =        TANH( fr_i(A2D(nn_hls)) * 10._wp ) 
     178      CASE( 2 )   ;   zice_fra(:,:) =              fr_i(A2D(nn_hls)) 
     179      CASE( 3 )   ;   zice_fra(:,:) = MIN( 4._wp * fr_i(A2D(nn_hls)) , 1._wp ) 
    178180      END SELECT 
    179181 
    180182      ! Compute surface, top and bottom friction at T-points 
    181       DO_2D( 0, 0, 0, 0 )          !==  surface ocean friction 
     183      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )          !==  surface ocean friction 
    182184         ustar2_surf(ji,jj) = r1_rho0 * taum(ji,jj) * tmask(ji,jj,1)   ! surface friction 
    183185      END_2D 
     
    186188      ! 
    187189      IF( .NOT.ln_drg_OFF ) THEN     !== top/bottom friction   (explicit before friction) 
    188          DO_2D( 0, 0, 0, 0 )         ! bottom friction (explicit before friction) 
     190         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )          ! bottom friction (explicit before friction) 
    189191            zmsku = 0.5_wp * ( 2._wp - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) ) 
    190192            zmskv = 0.5_wp * ( 2._wp - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) )     ! (CAUTION: CdU<0) 
     
    193195         END_2D 
    194196         IF( ln_isfcav ) THEN 
    195             DO_2D( 0, 0, 0, 0 )      ! top friction 
     197            DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )      ! top friction 
    196198               zmsku = 0.5_wp * ( 2. - umask(ji-1,jj,mikt(ji,jj)) * umask(ji,jj,mikt(ji,jj)) ) 
    197199               zmskv = 0.5_wp * ( 2. - vmask(ji,jj-1,mikt(ji,jj)) * vmask(ji,jj,mikt(ji,jj)) )     ! (CAUTION: CdU<0) 
     
    206208         zhsro(:,:) = rn_hsro 
    207209      CASE ( 1 )             ! Standard Charnock formula 
    208          zhsro(:,:) = MAX( rsbc_zs1 * ustar2_surf(:,:) , rn_hsro ) 
     210         zhsro(:,:) = MAX( rsbc_zs1 * ustar2_surf(A2D(nn_hls)) , rn_hsro ) 
    209211      CASE ( 2 )             ! Roughness formulae according to Rascle et al., Ocean Modelling (2008) 
    210212!!gm faster coding : the 2 comment lines should be used 
    211213!!gm         zcof = 2._wp * 0.6_wp / 28._wp 
    212214!!gm         zdep(:,:)  = 30._wp * TANH(  zcof/ SQRT( MAX(ustar2_surf(:,:),rsmall) )  )       ! Wave age (eq. 10) 
    213          zdep (:,:) = 30.*TANH( 2.*0.3/(28.*SQRT(MAX(ustar2_surf(:,:),rsmall))) )         ! Wave age (eq. 10) 
    214          zhsro(:,:) = MAX(rsbc_zs2 * ustar2_surf(:,:) * zdep(:,:)**1.5, rn_hsro)          ! zhsro = rn_frac_hs * Hsw (eq. 11) 
     215         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     216            zcof = 30.*TANH( 2.*0.3/(28.*SQRT(MAX(ustar2_surf(ji,jj),rsmall))) )          ! Wave age (eq. 10) 
     217            zhsro(ji,jj) = MAX(rsbc_zs2 * ustar2_surf(ji,jj) * zcof**1.5, rn_hsro)        ! zhsro = rn_frac_hs * Hsw (eq. 11) 
     218         END_2D 
    215219      CASE ( 3 )             ! Roughness given by the wave model (coupled or read in file) 
    216          zhsro(:,:) = MAX(rn_frac_hs * hsw(:,:), rn_hsro)   ! (rn_frac_hs=1.6 see Eq. (5) of Rascle et al. 2008 ) 
     220         zhsro(:,:) = MAX(rn_frac_hs * hsw(A2D(nn_hls)), rn_hsro)   ! (rn_frac_hs=1.6 see Eq. (5) of Rascle et al. 2008 ) 
    217221      END SELECT 
    218222      ! 
    219223      ! adapt roughness where there is sea ice 
    220       zhsro(:,:) = ( (1._wp-zice_fra(:,:)) * zhsro(:,:) + zice_fra(:,:) * rn_hsri )*tmask(:,:,1)  + (1._wp - tmask(:,:,1))*rn_hsro 
    221       ! 
    222       DO_3D( 0, 0, 0, 0, 2, jpkm1 )  !==  Compute dissipation rate  ==! 
     224      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     225         zhsro(ji,jj) = ( (1._wp-zice_fra(ji,jj)) * zhsro(ji,jj) + zice_fra(ji,jj) * rn_hsri )*tmask(ji,jj,1)  + & 
     226            &           (1._wp - tmask(ji,jj,1))*rn_hsro 
     227      END_2D 
     228      ! 
     229      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )  !==  Compute dissipation rate  ==! 
    223230         eps(ji,jj,jk)  = rc03 * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / hmxl_n(ji,jj,jk) 
    224231      END_3D 
    225232 
    226233      ! Save tke at before time step 
    227       eb    (:,:,:) = en    (:,:,:) 
    228       hmxl_b(:,:,:) = hmxl_n(:,:,:) 
     234      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 
     235         eb    (ji,jj,jk) = en    (ji,jj,jk) 
     236         hmxl_b(ji,jj,jk) = hmxl_n(ji,jj,jk) 
     237      END_3D 
    229238 
    230239      IF( nn_clos == 0 ) THEN    ! Mellor-Yamada 
    231          DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     240         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    232241            zup   = hmxl_n(ji,jj,jk) * gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) 
    233242            zdown = vkarmn * gdepw(ji,jj,jk,Kmm) * ( -gdepw(ji,jj,jk,Kmm) + gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) ) 
     
    250259      ! Warning : after this step, en : right hand side of the matrix 
    251260 
    252       DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     261      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    253262         ! 
    254263         buoy = - p_avt(ji,jj,jk) * rn2(ji,jj,jk)     ! stratif. destruction 
     
    303312      ! 
    304313      CASE ( 0 )             ! Dirichlet boundary condition (set e at k=1 & 2) 
    305       ! First level 
    306       en   (:,:,1) = MAX(  rn_emin , rc02r * ustar2_surf(:,:) * (1._wp + (1._wp-zice_fra(:,:))*rsbc_tke1)**r2_3  ) 
    307       zd_lw(:,:,1) = en(:,:,1) 
    308       zd_up(:,:,1) = 0._wp 
    309       zdiag(:,:,1) = 1._wp 
    310       ! 
    311       ! One level below 
    312       en   (:,:,2) =  MAX(  rc02r * ustar2_surf(:,:) * (  1._wp + (1._wp-zice_fra(:,:))*rsbc_tke1 * ((zhsro(:,:)+gdepw(:,:,2,Kmm)) & 
    313          &                 / zhsro(:,:) )**(1.5_wp*ra_sf)  )**(2._wp/3._wp) , rn_emin   ) 
    314       zd_lw(:,:,2) = 0._wp 
    315       zd_up(:,:,2) = 0._wp 
    316       zdiag(:,:,2) = 1._wp 
    317       ! 
    318       ! 
     314         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     315            ! First level 
     316            en   (ji,jj,1) = MAX(  rn_emin , rc02r * ustar2_surf(ji,jj) * (1._wp + (1._wp-zice_fra(ji,jj))*rsbc_tke1)**r2_3  ) 
     317            zd_lw(ji,jj,1) = en(ji,jj,1) 
     318            zd_up(ji,jj,1) = 0._wp 
     319            zdiag(ji,jj,1) = 1._wp 
     320            ! 
     321            ! One level below 
     322            en   (ji,jj,2) =  MAX( rn_emin , rc02r * ustar2_surf(ji,jj) * (1._wp + (1._wp-zice_fra(ji,jj))*rsbc_tke1          & 
     323               &                             * ((zhsro(ji,jj)+gdepw(ji,jj,2,Kmm)) / zhsro(ji,jj) )**(1.5_wp*ra_sf)  )**r2_3 ) 
     324            zd_lw(ji,jj,2) = 0._wp 
     325            zd_up(ji,jj,2) = 0._wp 
     326            zdiag(ji,jj,2) = 1._wp 
     327         END_2D 
     328         ! 
     329         ! 
    319330      CASE ( 1 )             ! Neumann boundary condition (set d(e)/dz) 
    320       ! 
    321       ! Dirichlet conditions at k=1 
    322       en   (:,:,1) = MAX(  rc02r * ustar2_surf(:,:) * (1._wp + (1._wp-zice_fra(:,:))*rsbc_tke1)**r2_3 , rn_emin  ) 
    323       zd_lw(:,:,1) = en(:,:,1) 
    324       zd_up(:,:,1) = 0._wp 
    325       zdiag(:,:,1) = 1._wp 
    326       ! 
    327       ! at k=2, set de/dz=Fw 
    328       !cbr 
    329       DO_2D( 0, 0, 0, 0 )   ! zdiag zd_lw not defined/used on the halo 
    330          zdiag(ji,jj,2) = zdiag(ji,jj,2) +  zd_lw(ji,jj,2) ! Remove zd_lw from zdiag 
    331          zd_lw(ji,jj,2) = 0._wp 
    332       END_2D 
    333       zkar (:,:)   = (rl_sf + (vkarmn-rl_sf)*(1.-EXP(-rtrans*gdept(:,:,1,Kmm)/zhsro(:,:)) )) 
    334       zflxs(:,:)   = rsbc_tke2 * (1._wp-zice_fra(:,:)) * ustar2_surf(:,:)**1.5_wp * zkar(:,:) & 
    335           &                    * (  ( zhsro(:,:)+gdept(:,:,1,Kmm) ) / zhsro(:,:)  )**(1.5_wp*ra_sf) 
     331         ! 
     332         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     333            ! Dirichlet conditions at k=1 
     334            en   (ji,jj,1) = MAX(  rn_emin , rc02r * ustar2_surf(ji,jj) * (1._wp + (1._wp-zice_fra(ji,jj))*rsbc_tke1)**r2_3  ) 
     335            zd_lw(ji,jj,1) = en(ji,jj,1) 
     336            zd_up(ji,jj,1) = 0._wp 
     337            zdiag(ji,jj,1) = 1._wp 
     338            ! 
     339            ! at k=2, set de/dz=Fw 
     340            !cbr 
     341            ! zdiag zd_lw not defined/used on the halo 
     342            zdiag(ji,jj,2) = zdiag(ji,jj,2) +  zd_lw(ji,jj,2) ! Remove zd_lw from zdiag 
     343            zd_lw(ji,jj,2) = 0._wp 
     344            ! 
     345            zkar (ji,jj)   = (rl_sf + (vkarmn-rl_sf)*(1.-EXP(-rtrans*gdept(ji,jj,1,Kmm)/zhsro(ji,jj)) )) 
     346            zflxs(ji,jj)   = rsbc_tke2 * (1._wp-zice_fra(ji,jj)) * ustar2_surf(ji,jj)**1.5_wp * zkar(ji,jj) & 
     347                &                    * (  ( zhsro(ji,jj)+gdept(ji,jj,1,Kmm) ) / zhsro(ji,jj)  )**(1.5_wp*ra_sf) 
    336348!!gm why not   :                        * ( 1._wp + gdept(:,:,1,Kmm) / zhsro(:,:) )**(1.5_wp*ra_sf) 
    337       en(:,:,2) = en(:,:,2) + zflxs(:,:) / e3w(:,:,2,Kmm) 
    338       ! 
    339       ! 
     349            en(ji,jj,2) = en(ji,jj,2) + zflxs(ji,jj) / e3w(ji,jj,2,Kmm) 
     350         END_2D 
     351         ! 
     352         ! 
    340353      END SELECT 
    341354 
     
    348361         !                      ! en(ibot) = u*^2 / Co2 and hmxl_n(ibot) = rn_lmin 
    349362         !                      ! Balance between the production and the dissipation terms 
    350          DO_2D( 0, 0, 0, 0 ) 
     363         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    351364!!gm This means that bottom and ocean w-level above have a specified "en" value.   Sure ???? 
    352365!!   With thick deep ocean level thickness, this may be quite large, no ??? 
     
    365378         END_2D 
    366379         ! 
     380         ! NOTE: ctl_stop with ln_isfcav when using GLS 
    367381         IF( ln_isfcav) THEN     ! top boundary   (ocean cavity) 
    368             DO_2D( 0, 0, 0, 0 ) 
     382            DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    369383               itop   = mikt(ji,jj)       ! k   top w-point 
    370384               itopp1 = mikt(ji,jj) + 1   ! k+1 1st w-point below the top one 
     
    384398      CASE ( 1 )             ! Neumman boundary condition 
    385399         ! 
    386          DO_2D( 0, 0, 0, 0 ) 
     400         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    387401            ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point 
    388402            ibotm1 = mbkt(ji,jj)          ! k-1 bottom level of w-point but >=1 
     
    398412            en   (ji,jj,ibot) = z_en 
    399413         END_2D 
     414         ! NOTE: ctl_stop with ln_isfcav when using GLS 
    400415         IF( ln_isfcav) THEN     ! top boundary   (ocean cavity) 
    401             DO_2D( 0, 0, 0, 0 ) 
     416            DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    402417               itop   = mikt(ji,jj)       ! k   top w-point 
    403418               itopp1 = mikt(ji,jj) + 1   ! k+1 1st w-point below the top one 
     
    420435      ! ---------------------------------------------------------- 
    421436      ! 
    422       DO_3D( 0, 0, 0, 0, 2, jpkm1 )                ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 
     437      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )                ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 
    423438         zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1) 
    424439      END_3D 
    425       DO_3D( 0, 0, 0, 0, 2, jpkm1 )                ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 
     440      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )                ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 
    426441         zd_lw(ji,jj,jk) = en(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) * zd_lw(ji,jj,jk-1) 
    427442      END_3D 
    428       DO_3DS( 0, 0, 0, 0, jpkm1, 2, -1 )           ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 
     443      DO_3DS_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpkm1, 2, -1 )           ! Third recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 
    429444         en(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * en(ji,jj,jk+1) ) / zdiag(ji,jj,jk) 
    430445      END_3D 
    431446      !                                            ! set the minimum value of tke 
    432       en(:,:,:) = MAX( en(:,:,:), rn_emin ) 
     447      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 
     448         en(ji,jj,jk) = MAX( en(ji,jj,jk), rn_emin ) 
     449      END_3D 
    433450 
    434451      !!----------------------------------------!! 
     
    441458      ! 
    442459      CASE( 0 )               ! k-kl  (Mellor-Yamada) 
    443          DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     460         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    444461            psi(ji,jj,jk)  = eb(ji,jj,jk) * hmxl_b(ji,jj,jk) 
    445462         END_3D 
    446463         ! 
    447464      CASE( 1 )               ! k-eps 
    448          DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     465         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    449466            psi(ji,jj,jk)  = eps(ji,jj,jk) 
    450467         END_3D 
    451468         ! 
    452469      CASE( 2 )               ! k-w 
    453          DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     470         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    454471            psi(ji,jj,jk)  = SQRT( eb(ji,jj,jk) ) / ( rc0 * hmxl_b(ji,jj,jk) ) 
    455472         END_3D 
    456473         ! 
    457474      CASE( 3 )               ! generic 
    458          DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     475         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    459476            psi(ji,jj,jk)  = rc02 * eb(ji,jj,jk) * hmxl_b(ji,jj,jk)**rnn 
    460477         END_3D 
     
    469486      ! Warning : after this step, en : right hand side of the matrix 
    470487 
    471       DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     488      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    472489         ! 
    473490         ! psi / k 
     
    516533      CASE ( 0 )             ! Dirichlet boundary conditions 
    517534         ! 
    518          ! Surface value 
    519          zdep    (:,:)   = zhsro(:,:) * rl_sf ! Cosmetic 
    520          psi     (:,:,1) = rc0**rpp * en(:,:,1)**rmm * zdep(:,:)**rnn * tmask(:,:,1) 
    521          zd_lw(:,:,1) = psi(:,:,1) 
    522          zd_up(:,:,1) = 0._wp 
    523          zdiag(:,:,1) = 1._wp 
    524          ! 
    525          ! One level below 
    526          zkar    (:,:)   = (rl_sf + (vkarmn-rl_sf)*(1._wp-EXP(-rtrans*gdepw(:,:,2,Kmm)/zhsro(:,:) ))) 
    527          zdep    (:,:)   = (zhsro(:,:) + gdepw(:,:,2,Kmm)) * zkar(:,:) 
    528          psi     (:,:,2) = rc0**rpp * en(:,:,2)**rmm * zdep(:,:)**rnn * tmask(:,:,1) 
    529          zd_lw(:,:,2) = 0._wp 
    530          zd_up(:,:,2) = 0._wp 
    531          zdiag(:,:,2) = 1._wp 
     535         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     536            ! Surface value 
     537            zdep    (ji,jj)   = zhsro(ji,jj) * rl_sf ! Cosmetic 
     538            psi     (ji,jj,1) = rc0**rpp * en(ji,jj,1)**rmm * zdep(ji,jj)**rnn * tmask(ji,jj,1) 
     539            zd_lw(ji,jj,1) = psi(ji,jj,1) 
     540            zd_up(ji,jj,1) = 0._wp 
     541            zdiag(ji,jj,1) = 1._wp 
     542            ! 
     543            ! One level below 
     544            zkar    (ji,jj)   = (rl_sf + (vkarmn-rl_sf)*(1._wp-EXP(-rtrans*gdepw(ji,jj,2,Kmm)/zhsro(ji,jj) ))) 
     545            zdep    (ji,jj)   = (zhsro(ji,jj) + gdepw(ji,jj,2,Kmm)) * zkar(ji,jj) 
     546            psi     (ji,jj,2) = rc0**rpp * en(ji,jj,2)**rmm * zdep(ji,jj)**rnn * tmask(ji,jj,1) 
     547            zd_lw(ji,jj,2) = 0._wp 
     548            zd_up(ji,jj,2) = 0._wp 
     549            zdiag(ji,jj,2) = 1._wp 
     550         END_2D 
    532551         ! 
    533552      CASE ( 1 )             ! Neumann boundary condition on d(psi)/dz 
    534553         ! 
    535          ! Surface value: Dirichlet 
    536          zdep    (:,:)   = zhsro(:,:) * rl_sf 
    537          psi     (:,:,1) = rc0**rpp * en(:,:,1)**rmm * zdep(:,:)**rnn * tmask(:,:,1) 
    538          zd_lw(:,:,1) = psi(:,:,1) 
    539          zd_up(:,:,1) = 0._wp 
    540          zdiag(:,:,1) = 1._wp 
    541          ! 
    542          ! Neumann condition at k=2 
    543          DO_2D( 0, 0, 0, 0 )   ! zdiag zd_lw not defined/used on the halo 
     554         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     555            ! Surface value: Dirichlet 
     556            zdep    (ji,jj)   = zhsro(ji,jj) * rl_sf 
     557            psi     (ji,jj,1) = rc0**rpp * en(ji,jj,1)**rmm * zdep(ji,jj)**rnn * tmask(ji,jj,1) 
     558            zd_lw(ji,jj,1) = psi(ji,jj,1) 
     559            zd_up(ji,jj,1) = 0._wp 
     560            zdiag(ji,jj,1) = 1._wp 
     561            ! 
     562            ! Neumann condition at k=2, zdiag zd_lw not defined/used on the halo 
    544563            zdiag(ji,jj,2) = zdiag(ji,jj,2) +  zd_lw(ji,jj,2) ! Remove zd_lw from zdiag 
    545564            zd_lw(ji,jj,2) = 0._wp 
     565            ! 
     566            ! Set psi vertical flux at the surface: 
     567            zkar (ji,jj)   = rl_sf + (vkarmn-rl_sf)*(1._wp-EXP(-rtrans*gdept(ji,jj,1,Kmm)/zhsro(ji,jj) )) ! Lengh scale slope 
     568            zdep (ji,jj)   = ((zhsro(ji,jj) + gdept(ji,jj,1,Kmm)) / zhsro(ji,jj))**(rmm*ra_sf) 
     569            zflxs(ji,jj)   = (rnn + (1._wp-zice_fra(ji,jj))*rsbc_tke1 * (rnn + rmm*ra_sf) * zdep(ji,jj)) & 
     570               &           *(1._wp + (1._wp-zice_fra(ji,jj))*rsbc_tke1*zdep(ji,jj))**(2._wp*rmm/3._wp-1_wp) 
     571            zdep (ji,jj)   = rsbc_psi1 * (zwall_psi(ji,jj,1)*p_avm(ji,jj,1)+zwall_psi(ji,jj,2)*p_avm(ji,jj,2)) * & 
     572               &           ustar2_surf(ji,jj)**rmm * zkar(ji,jj)**rnn * (zhsro(ji,jj) + gdept(ji,jj,1,Kmm))**(rnn-1.) 
     573            zflxs(ji,jj)   = zdep(ji,jj) * zflxs(ji,jj) 
     574            psi  (ji,jj,2) = psi(ji,jj,2) + zflxs(ji,jj) / e3w(ji,jj,2,Kmm) 
    546575         END_2D 
    547          ! 
    548          ! Set psi vertical flux at the surface: 
    549          zkar (:,:)   = rl_sf + (vkarmn-rl_sf)*(1._wp-EXP(-rtrans*gdept(:,:,1,Kmm)/zhsro(:,:) )) ! Lengh scale slope 
    550          zdep (:,:)   = ((zhsro(:,:) + gdept(:,:,1,Kmm)) / zhsro(:,:))**(rmm*ra_sf) 
    551          zflxs(:,:)   = (rnn + (1._wp-zice_fra(:,:))*rsbc_tke1 * (rnn + rmm*ra_sf) * zdep(:,:)) & 
    552             &           *(1._wp + (1._wp-zice_fra(:,:))*rsbc_tke1*zdep(:,:))**(2._wp*rmm/3._wp-1_wp) 
    553          zdep (:,:)   = rsbc_psi1 * (zwall_psi(:,:,1)*p_avm(:,:,1)+zwall_psi(:,:,2)*p_avm(:,:,2)) * & 
    554             &           ustar2_surf(:,:)**rmm * zkar(:,:)**rnn * (zhsro(:,:) + gdept(:,:,1,Kmm))**(rnn-1.) 
    555          zflxs(:,:)   = zdep(:,:) * zflxs(:,:) 
    556          psi  (:,:,2) = psi(:,:,2) + zflxs(:,:) / e3w(:,:,2,Kmm) 
    557576         ! 
    558577      END SELECT 
     
    569588         !                      ! en(ibot) = u*^2 / Co2 and hmxl_n(ibot) = vkarmn * r_z0_bot 
    570589         !                      ! Balance between the production and the dissipation terms 
    571          DO_2D( 0, 0, 0, 0 ) 
     590         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    572591            ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point 
    573592            ibotm1 = mbkt(ji,jj)          ! k-1 bottom level of w-point but >=1 
     
    588607      CASE ( 1 )             ! Neumman boundary condition 
    589608         ! 
    590          DO_2D( 0, 0, 0, 0 ) 
     609         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    591610            ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point 
    592611            ibotm1 = mbkt(ji,jj)          ! k-1 bottom level of w-point but >=1 
     
    616635      ! ---------------- 
    617636      ! 
    618       DO_3D( 0, 0, 0, 0, 2, jpkm1 )                ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 
     637      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )                ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 
    619638         zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1) 
    620639      END_3D 
    621       DO_3D( 0, 0, 0, 0, 2, jpkm1 )                ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 
     640      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )                ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 
    622641         zd_lw(ji,jj,jk) = psi(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) * zd_lw(ji,jj,jk-1) 
    623642      END_3D 
    624       DO_3DS( 0, 0, 0, 0, jpkm1, 2, -1 )           ! Third recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 
     643      DO_3DS( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpkm1, 2, -1 )           ! Third recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 
    625644         psi(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * psi(ji,jj,jk+1) ) / zdiag(ji,jj,jk) 
    626645      END_3D 
     
    632651      ! 
    633652      CASE( 0 )               ! k-kl  (Mellor-Yamada) 
    634          DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     653         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
    635654            eps(ji,jj,jk) = rc03 * en(ji,jj,jk) * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / MAX( psi(ji,jj,jk), rn_epsmin) 
    636655         END_3D 
    637656         ! 
    638657      CASE( 1 )               ! k-eps 
    639          DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     658         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
    640659            eps(ji,jj,jk) = psi(ji,jj,jk) 
    641660         END_3D 
    642661         ! 
    643662      CASE( 2 )               ! k-w 
    644          DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     663         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
    645664            eps(ji,jj,jk) = rc04 * en(ji,jj,jk) * psi(ji,jj,jk) 
    646665         END_3D 
     
    650669         zex1  =      ( 1.5_wp + rmm/rnn ) 
    651670         zex2  = -1._wp / rnn 
    652          DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     671         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
    653672            eps(ji,jj,jk) = zcoef * en(ji,jj,jk)**zex1 * psi(ji,jj,jk)**zex2 
    654673         END_3D 
     
    658677      ! Limit dissipation rate under stable stratification 
    659678      ! -------------------------------------------------- 
    660       DO_3D( 0, 0, 0, 0, 1, jpkm1 )   ! Note that this set boundary conditions on hmxl_n at the same time 
     679      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )   ! Note that this set boundary conditions on hmxl_n at the same time 
    661680         ! limitation 
    662681         eps   (ji,jj,jk)  = MAX( eps(ji,jj,jk), rn_epsmin ) 
    663682         hmxl_n(ji,jj,jk)  = rc03 * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / eps(ji,jj,jk) 
    664          ! Galperin criterium (NOTE : Not required if the proper value of C3 in stable cases is calculated) 
    665          zrn2 = MAX( rn2(ji,jj,jk), rsmall ) 
    666          IF( ln_length_lim )   hmxl_n(ji,jj,jk) = MIN(  rn_clim_galp * SQRT( 2._wp * en(ji,jj,jk) / zrn2 ), hmxl_n(ji,jj,jk) ) 
    667       END_3D 
     683      END_3D 
     684      IF( ln_length_lim ) THEN        ! Galperin criterium (NOTE : Not required if the proper value of C3 in stable cases is calculated) 
     685         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
     686            zrn2 = MAX( rn2(ji,jj,jk), rsmall ) 
     687            hmxl_n(ji,jj,jk) = MIN(  rn_clim_galp * SQRT( 2._wp * en(ji,jj,jk) / zrn2 ), hmxl_n(ji,jj,jk) ) 
     688         END_3D 
     689      ENDIF 
    668690 
    669691      ! 
     
    674696      ! 
    675697      CASE ( 0 , 1 )             ! Galperin or Kantha-Clayson stability functions 
    676          DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     698         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    677699            ! zcof =  l²/q² 
    678700            zcof = hmxl_b(ji,jj,jk) * hmxl_b(ji,jj,jk) / ( 2._wp*eb(ji,jj,jk) ) 
     
    691713         ! 
    692714      CASE ( 2, 3 )               ! Canuto stability functions 
    693          DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     715         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    694716            ! zcof =  l²/q² 
    695717            zcof = hmxl_b(ji,jj,jk)*hmxl_b(ji,jj,jk) / ( 2._wp * eb(ji,jj,jk) ) 
     
    723745      ! default value, in case jpk > mbkt(ji,jj)+1. Not needed but avoid a bug when looking for undefined values (-fpe0) 
    724746      zstm(:,:,jpk) = 0. 
    725       DO_2D( 0, 0, 0, 0 )             ! update bottom with good values 
     747      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )             ! update bottom with good values 
    726748         zstm(ji,jj,mbkt(ji,jj)+1) = zstm(ji,jj,mbkt(ji,jj)) 
    727749      END_2D 
    728750 
    729       zstt(:,:,  1) = wmask(:,:,  1)  ! default value not needed but avoid a bug when looking for undefined values (-fpe0) 
    730       zstt(:,:,jpk) = wmask(:,:,jpk)  ! default value not needed but avoid a bug when looking for undefined values (-fpe0) 
     751      zstt(:,:,  1) = wmask(A2D(nn_hls),  1)  ! default value not needed but avoid a bug when looking for undefined values (-fpe0) 
     752      zstt(:,:,jpk) = wmask(A2D(nn_hls),jpk)  ! default value not needed but avoid a bug when looking for undefined values (-fpe0) 
    731753 
    732754!!gm should be done for ISF (top boundary cond.) 
     
    738760      !     later overwritten by surface/bottom boundaries conditions, so we don't really care of p_avm(:,:1) and p_avm(:,:jpk) 
    739761      !     for zd_lw and zd_up but they have to be defined to avoid a bug when looking for undefined values (-fpe0) 
    740       DO_3D( 0, 0, 0, 0, 1, jpk ) 
     762      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 
    741763         zsqen = SQRT( 2._wp * en(ji,jj,jk) ) * hmxl_n(ji,jj,jk) 
    742764         zavt  = zsqen * zstt(ji,jj,jk) 
     
    745767         p_avm(ji,jj,jk) = MAX( zavm, avmb(jk) )                   ! Note that avm is not masked at the surface and the bottom 
    746768      END_3D 
    747       p_avt(:,:,1) = 0._wp 
     769      p_avt(A2D(nn_hls),1) = 0._wp 
    748770      ! 
    749771      IF(sn_cfctl%l_prtctl) THEN 
  • NEMO/trunk/src/OCE/ZDF/zdfiwm.F90

    r13497 r14834  
    125125      ! 
    126126      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    127       REAL(wp) ::   zztmp, ztmp1, ztmp2        ! scalar workspace 
    128       REAL(wp), DIMENSION(jpi,jpj)     ::   zfact       ! Used for vertical structure 
    129       REAL(wp), DIMENSION(jpi,jpj)     ::   zhdep       ! Ocean depth 
    130       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwkb        ! WKB-stretched height above bottom 
    131       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zweight     ! Weight for high mode vertical distribution 
    132       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   znu_t       ! Molecular kinematic viscosity (T grid) 
    133       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   znu_w       ! Molecular kinematic viscosity (W grid) 
    134       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zReb        ! Turbulence intensity parameter 
    135       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zemx_iwm    ! local energy density available for mixing (W/kg) 
    136       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zav_ratio   ! S/T diffusivity ratio (only for ln_tsdiff=T) 
    137       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zav_wave    ! Internal wave-induced diffusivity 
     127      REAL(wp), SAVE :: zztmp 
     128      REAL(wp)       :: ztmp1, ztmp2        ! scalar workspace 
     129      REAL(wp), DIMENSION(A2D(nn_hls))     ::   zfact       ! Used for vertical structure 
     130      REAL(wp), DIMENSION(A2D(nn_hls))     ::   zhdep       ! Ocean depth 
     131      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zwkb        ! WKB-stretched height above bottom 
     132      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zweight     ! Weight for high mode vertical distribution 
     133      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   znu_t       ! Molecular kinematic viscosity (T grid) 
     134      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   znu_w       ! Molecular kinematic viscosity (W grid) 
     135      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zReb        ! Turbulence intensity parameter 
     136      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zemx_iwm    ! local energy density available for mixing (W/kg) 
     137      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zav_ratio   ! S/T diffusivity ratio (only for ln_tsdiff=T) 
     138      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zav_wave    ! Internal wave-induced diffusivity 
    138139      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   z3d  ! 3D workspace used for iom_put  
    139140      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   z2d  ! 2D     -      -    -     - 
     
    143144      ! Set to zero the 1st and last vertical levels of appropriate variables 
    144145      IF( iom_use("emix_iwm") ) THEN 
    145          DO_2D( 0, 0, 0, 0 ) 
     146         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    146147            zemx_iwm (ji,jj,1) = 0._wp   ;   zemx_iwm (ji,jj,jpk) = 0._wp 
    147148         END_2D 
    148149      ENDIF 
    149150      IF( iom_use("av_ratio") ) THEN 
    150          DO_2D( 0, 0, 0, 0 ) 
     151         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    151152            zav_ratio(ji,jj,1) = 0._wp   ;   zav_ratio(ji,jj,jpk) = 0._wp 
    152153         END_2D 
    153154      ENDIF 
    154155      IF( iom_use("av_wave") .OR. sn_cfctl%l_prtctl ) THEN 
    155          DO_2D( 0, 0, 0, 0 ) 
     156         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    156157            zav_wave (ji,jj,1) = 0._wp   ;   zav_wave (ji,jj,jpk) = 0._wp 
    157158         END_2D 
     
    164165      !                       !* Critical slope mixing: distribute energy over the time-varying ocean depth, 
    165166      !                                                 using an exponential decay from the seafloor. 
    166       DO_2D( 0, 0, 0, 0 )             ! part independent of the level 
     167      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )             ! part independent of the level 
    167168         zhdep(ji,jj) = gdepw_0(ji,jj,mbkt(ji,jj)+1)       ! depth of the ocean 
    168169         zfact(ji,jj) = rho0 * (  1._wp - EXP( -zhdep(ji,jj) / hcri_iwm(ji,jj) )  ) 
     
    170171      END_2D 
    171172!!gm gde3w ==>>>  check for ssh taken into account.... seem OK gde3w_n=gdept(:,:,:,Kmm) - ssh(:,:,Kmm) 
    172       DO_3D( 0, 0, 0, 0, 2, jpkm1 )   ! complete with the level-dependent part 
     173      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )   ! complete with the level-dependent part 
    173174         IF ( zfact(ji,jj) == 0._wp .OR. wmask(ji,jj,jk) == 0._wp ) THEN   ! optimization 
    174175            zemx_iwm(ji,jj,jk) = 0._wp 
     
    190191      CASE ( 1 )               ! Dissipation scales as N (recommended) 
    191192         ! 
    192          DO_2D( 0, 0, 0, 0 ) 
     193         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    193194            zfact(ji,jj) = 0._wp 
    194195         END_2D 
    195          DO_3D( 0, 0, 0, 0, 2, jpkm1 )       ! part independent of the level 
     196         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )       ! part independent of the level 
    196197            zfact(ji,jj) = zfact(ji,jj) + e3w(ji,jj,jk,Kmm) * SQRT(  MAX( 0._wp, rn2(ji,jj,jk) )  ) * wmask(ji,jj,jk) 
    197198         END_3D 
    198199         ! 
    199          DO_2D( 0, 0, 0, 0 ) 
     200         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    200201            IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = epyc_iwm(ji,jj) / ( rho0 * zfact(ji,jj) ) 
    201202         END_2D 
    202203         ! 
    203          DO_3D( 0, 0, 0, 0, 2, jpkm1 )       ! complete with the level-dependent part 
     204         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )       ! complete with the level-dependent part 
    204205            zemx_iwm(ji,jj,jk) = zemx_iwm(ji,jj,jk) + zfact(ji,jj) * SQRT(  MAX( 0._wp, rn2(ji,jj,jk) )  ) * wmask(ji,jj,jk) 
    205206         END_3D 
     
    207208      CASE ( 2 )               ! Dissipation scales as N^2 
    208209         ! 
    209          DO_2D( 0, 0, 0, 0 ) 
     210         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    210211            zfact(ji,jj) = 0._wp 
    211212         END_2D 
    212          DO_3D( 0, 0, 0, 0, 2, jpkm1 )       ! part independent of the level 
     213         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )       ! part independent of the level 
    213214            zfact(ji,jj) = zfact(ji,jj) + e3w(ji,jj,jk,Kmm) * MAX( 0._wp, rn2(ji,jj,jk) ) * wmask(ji,jj,jk) 
    214215         END_3D 
    215216         ! 
    216          DO_2D( 0, 0, 0, 0 ) 
     217         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    217218            IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = epyc_iwm(ji,jj) / ( rho0 * zfact(ji,jj) ) 
    218219         END_2D 
    219220         ! 
    220          DO_3D( 0, 0, 0, 0, 2, jpkm1 )       ! complete with the level-dependent part 
     221         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    221222            zemx_iwm(ji,jj,jk) = zemx_iwm(ji,jj,jk) + zfact(ji,jj) * MAX( 0._wp, rn2(ji,jj,jk) ) * wmask(ji,jj,jk) 
    222223         END_3D 
     
    227228      !                        !* ocean depth as proportional to rn2 * exp(-z_wkb/rn_hbot) 
    228229      ! 
    229       DO_2D( 0, 0, 0, 0 ) 
     230      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    230231         zwkb(ji,jj,1) = 0._wp 
    231232      END_2D 
    232       DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     233      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    233234         zwkb(ji,jj,jk) = zwkb(ji,jj,jk-1) + e3w(ji,jj,jk,Kmm) * SQRT(  MAX( 0._wp, rn2(ji,jj,jk) )  ) * wmask(ji,jj,jk) 
    234235      END_3D 
    235       DO_2D( 0, 0, 0, 0 ) 
     236      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    236237         zfact(ji,jj) = zwkb(ji,jj,jpkm1) 
    237238      END_2D 
    238239      ! 
    239       DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     240      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    240241         IF( zfact(ji,jj) /= 0 )   zwkb(ji,jj,jk) = zhdep(ji,jj) * ( zfact(ji,jj) - zwkb(ji,jj,jk) )   & 
    241242            &                                     * wmask(ji,jj,jk) / zfact(ji,jj) 
    242243      END_3D 
    243       DO_2D( 0, 0, 0, 0 ) 
     244      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    244245         zwkb (ji,jj,1) = zhdep(ji,jj) * wmask(ji,jj,1) 
    245246      END_2D 
    246247      ! 
    247       DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     248      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    248249         IF ( rn2(ji,jj,jk) <= 0._wp .OR. wmask(ji,jj,jk) == 0._wp ) THEN   ! optimization: EXP coast a lot 
    249250            zweight(ji,jj,jk) = 0._wp 
     
    254255      END_3D 
    255256      ! 
    256       DO_2D( 0, 0, 0, 0 ) 
     257      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    257258         zfact(ji,jj) = 0._wp 
    258259      END_2D 
    259       DO_3D( 0, 0, 0, 0, 2, jpkm1 )       ! part independent of the level 
     260      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )       ! part independent of the level 
    260261         zfact(ji,jj) = zfact(ji,jj) + zweight(ji,jj,jk) 
    261262      END_3D 
    262263      ! 
    263       DO_2D( 0, 0, 0, 0 ) 
     264      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    264265         IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = ebot_iwm(ji,jj) / ( rho0 * zfact(ji,jj) ) 
    265266      END_2D 
    266267      ! 
    267       DO_3D( 0, 0, 0, 0, 2, jpkm1 )       ! complete with the level-dependent part 
     268      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )       ! complete with the level-dependent part 
    268269         zemx_iwm(ji,jj,jk) = zemx_iwm(ji,jj,jk) + zweight(ji,jj,jk) * zfact(ji,jj) * wmask(ji,jj,jk)   & 
    269270            &                                                        / ( gde3w(ji,jj,jk) - gde3w(ji,jj,jk-1) ) 
     
    273274!!gm  this is to be replaced by just a constant value znu=1.e-6 m2/s 
    274275      ! Calculate molecular kinematic viscosity 
    275       DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     276      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
    276277         znu_t(ji,jj,jk) = 1.e-4_wp * (  17.91_wp - 0.53810_wp * ts(ji,jj,jk,jp_tem,Kmm)   & 
    277278            &                                     + 0.00694_wp * ts(ji,jj,jk,jp_tem,Kmm) * ts(ji,jj,jk,jp_tem,Kmm)  & 
    278279            &                                     + 0.02305_wp * ts(ji,jj,jk,jp_sal,Kmm)  ) * tmask(ji,jj,jk) * r1_rho0 
    279280      END_3D 
    280       DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     281      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    281282         znu_w(ji,jj,jk) = 0.5_wp * ( znu_t(ji,jj,jk-1) + znu_t(ji,jj,jk) ) * wmask(ji,jj,jk) 
    282283      END_3D 
     
    284285      ! 
    285286      ! Calculate turbulence intensity parameter Reb 
    286       DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     287      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    287288         zReb(ji,jj,jk) = zemx_iwm(ji,jj,jk) / MAX( 1.e-20_wp, znu_w(ji,jj,jk) * rn2(ji,jj,jk) ) 
    288289      END_3D 
    289290      ! 
    290291      ! Define internal wave-induced diffusivity 
    291       DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     292      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    292293         zav_wave(ji,jj,jk) = znu_w(ji,jj,jk) * zReb(ji,jj,jk) * r1_6   ! This corresponds to a constant mixing efficiency of 1/6 
    293294      END_3D 
    294295      ! 
    295296      IF( ln_mevar ) THEN                ! Variable mixing efficiency case : modify zav_wave in the 
    296          DO_3D( 0, 0, 0, 0, 2, jpkm1 )   ! energetic (Reb > 480) and buoyancy-controlled (Reb <10.224 ) regimes 
     297         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )   ! energetic (Reb > 480) and buoyancy-controlled (Reb <10.224 ) regimes 
    297298            IF( zReb(ji,jj,jk) > 480.00_wp ) THEN 
    298299               zav_wave(ji,jj,jk) = 3.6515_wp * znu_w(ji,jj,jk) * SQRT( zReb(ji,jj,jk) ) 
     
    303304      ENDIF 
    304305      ! 
    305       DO_3D( 0, 0, 0, 0, 2, jpkm1 )      ! Bound diffusivity by molecular value and 100 cm2/s 
     306      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )      ! Bound diffusivity by molecular value and 100 cm2/s 
    306307         zav_wave(ji,jj,jk) = MIN(  MAX( 1.4e-7_wp, zav_wave(ji,jj,jk) ), 1.e-2_wp  ) * wmask(ji,jj,jk) 
    307308      END_3D 
    308309      ! 
    309310      IF( kt == nit000 ) THEN        !* Control print at first time-step: diagnose the energy consumed by zav_wave 
    310          zztmp = 0._wp 
     311         IF( .NOT. l_istiled .OR. ntile == 1 ) zztmp = 0._wp                    ! Do only on the first tile 
    311312!!gm used of glosum 3D.... 
    312313         DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     
    314315               &          * MAX( 0._wp, rn2(ji,jj,jk) ) * zav_wave(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj) 
    315316         END_3D 
    316          CALL mpp_sum( 'zdfiwm', zztmp ) 
    317          zztmp = rho0 * zztmp ! Global integral of rauo * Kz * N^2 = power contributing to mixing  
    318          ! 
    319          IF(lwp) THEN 
    320             WRITE(numout,*) 
    321             WRITE(numout,*) 'zdf_iwm : Internal wave-driven mixing (iwm)' 
    322             WRITE(numout,*) '~~~~~~~ ' 
    323             WRITE(numout,*) 
    324             WRITE(numout,*) '      Total power consumption by av_wave =  ', zztmp * 1.e-12_wp, 'TW' 
     317 
     318         IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN                       ! Do only on the last tile 
     319            CALL mpp_sum( 'zdfiwm', zztmp ) 
     320            zztmp = rho0 * zztmp ! Global integral of rauo * Kz * N^2 = power contributing to mixing 
     321            ! 
     322            IF(lwp) THEN 
     323               WRITE(numout,*) 
     324               WRITE(numout,*) 'zdf_iwm : Internal wave-driven mixing (iwm)' 
     325               WRITE(numout,*) '~~~~~~~ ' 
     326               WRITE(numout,*) 
     327               WRITE(numout,*) '      Total power consumption by av_wave =  ', zztmp * 1.e-12_wp, 'TW' 
     328            ENDIF 
    325329         ENDIF 
    326330      ENDIF 
     
    332336      IF( ln_tsdiff ) THEN                !* Option for differential mixing of salinity and temperature 
    333337         ztmp1 = 0.505_wp + 0.495_wp * TANH( 0.92_wp * ( LOG10( 1.e-20_wp ) - 0.60_wp ) ) 
    334          DO_3D( 0, 0, 0, 0, 2, jpkm1 )       ! Calculate S/T diffusivity ratio as a function of Reb 
     338         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )       ! Calculate S/T diffusivity ratio as a function of Reb 
    335339            ztmp2 = zReb(ji,jj,jk) * 5._wp * r1_6 
    336340            IF ( ztmp2 > 1.e-20_wp .AND. wmask(ji,jj,jk) == 1._wp ) THEN 
     
    341345         END_3D 
    342346         CALL iom_put( "av_ratio", zav_ratio ) 
    343          DO_3D( 0, 0, 0, 0, 2, jpkm1 )    !* update momentum & tracer diffusivity with wave-driven mixing 
     347         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )    !* update momentum & tracer diffusivity with wave-driven mixing 
    344348            p_avs(ji,jj,jk) = p_avs(ji,jj,jk) + zav_wave(ji,jj,jk) * zav_ratio(ji,jj,jk) 
    345349            p_avt(ji,jj,jk) = p_avt(ji,jj,jk) + zav_wave(ji,jj,jk) 
     
    348352         ! 
    349353      ELSE                                !* update momentum & tracer diffusivity with wave-driven mixing 
    350          DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     354         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    351355            p_avs(ji,jj,jk) = p_avs(ji,jj,jk) + zav_wave(ji,jj,jk) 
    352356            p_avt(ji,jj,jk) = p_avt(ji,jj,jk) + zav_wave(ji,jj,jk) 
     
    361365                                          !  vertical integral of rho0 * Kz * N^2 , energy density (zemx_iwm) 
    362366      IF( iom_use("bflx_iwm") .OR. iom_use("pcmap_iwm") ) THEN 
    363          ALLOCATE( z2d(jpi,jpj) , z3d(jpi,jpj,jpk) ) 
     367         ALLOCATE( z2d(A2D(nn_hls)) , z3d(A2D(nn_hls),jpk) ) 
    364368         ! Initialisation for iom_put 
    365369         DO_2D( 0, 0, 0, 0 ) 
    366370            z3d(ji,jj,1) = 0._wp   ;   z3d(ji,jj,jpk) = 0._wp 
    367371         END_2D 
    368          z3d(           1:nn_hls,:,:) = 0._wp   ;   z3d(:,           1:nn_hls,:) = 0._wp 
    369          z3d(jpi-nn_hls+1:jpi   ,:,:) = 0._wp   ;   z3d(:,jpj-nn_hls+1:   jpj,:) = 0._wp 
    370          z2d(           1:nn_hls,:  ) = 0._wp   ;   z2d(:,           1:nn_hls  ) = 0._wp 
    371          z2d(jpi-nn_hls+1:jpi   ,:  ) = 0._wp   ;   z2d(:,jpj-nn_hls+1:   jpj  ) = 0._wp 
    372372 
    373373         DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
  • NEMO/trunk/src/OCE/ZDF/zdfmfc.F90

    r14433 r14834  
    9696      INTEGER                                  , INTENT(in)    :: Kmm, Krhs ! time level indices 
    9797      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts       ! active tracers and RHS of tracer equation 
    98       REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   ztsp         ! T/S of the plume 
    99       REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   ztse         ! T/S at W point 
    100       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zrwp          ! 
    101       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zrwp2         ! 
    102       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zapp          ! 
    103       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zedmf         ! 
    104       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zepsT, zepsW  ! 
    105       ! 
    106       REAL(wp), DIMENSION(jpi,jpj) :: zustar, zustar2   ! 
    107       REAL(wp), DIMENSION(jpi,jpj) :: zuws, zvws, zsws, zfnet          ! 
    108       REAL(wp), DIMENSION(jpi,jpj) :: zfbuo, zrautbm1, zrautb, zraupl 
    109       REAL(wp), DIMENSION(jpi,jpj) :: zwpsurf            ! 
    110       REAL(wp), DIMENSION(jpi,jpj) :: zop0 , zsp0 ! 
    111       REAL(wp), DIMENSION(jpi,jpj) :: zrwp_0, zrwp2_0  ! 
    112       REAL(wp), DIMENSION(jpi,jpj) :: zapp0           ! 
    113       REAL(wp), DIMENSION(jpi,jpj) :: zphp, zph, zphpm1, zphm1, zNHydro 
    114       REAL(wp), DIMENSION(jpi,jpj) :: zhcmo          ! 
    115       ! 
    116       REAL(wp), DIMENSION(jpi,jpj,jpk)   ::   zn2    ! N^2 
    117       REAL(wp), DIMENSION(jpi,jpj,2  ) ::   zab, zabm1, zabp ! alpha and beta 
     98      REAL(wp), DIMENSION(A2D(nn_hls),jpk,2) ::   ztsp         ! T/S of the plume 
     99      REAL(wp), DIMENSION(A2D(nn_hls),jpk,2) ::   ztse         ! T/S at W point 
     100      REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zrwp          ! 
     101      REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zrwp2         ! 
     102      REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zapp          ! 
     103      REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zedmf         ! 
     104      REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zepsT, zepsW  ! 
     105      ! 
     106      REAL(wp), DIMENSION(A2D(nn_hls)) :: zustar, zustar2   ! 
     107      REAL(wp), DIMENSION(A2D(nn_hls)) :: zuws, zvws, zsws, zfnet          ! 
     108      REAL(wp), DIMENSION(A2D(nn_hls)) :: zfbuo, zrautbm1, zrautb, zraupl 
     109      REAL(wp), DIMENSION(A2D(nn_hls)) :: zwpsurf            ! 
     110      REAL(wp), DIMENSION(A2D(nn_hls)) :: zop0 , zsp0 ! 
     111      REAL(wp), DIMENSION(A2D(nn_hls)) :: zrwp_0, zrwp2_0  ! 
     112      REAL(wp), DIMENSION(A2D(nn_hls)) :: zapp0           ! 
     113      REAL(wp), DIMENSION(A2D(nn_hls)) :: zphp, zph, zphpm1, zphm1, zNHydro 
     114      REAL(wp), DIMENSION(A2D(nn_hls)) :: zhcmo          ! 
     115      ! 
     116      REAL(wp), DIMENSION(A2D(nn_hls),jpk)   ::   zn2    ! N^2 
     117      REAL(wp), DIMENSION(A2D(nn_hls),2  ) ::   zab, zabm1, zabp ! alpha and beta 
    118118      
    119119      REAL(wp), PARAMETER :: zepsilon = 1.e-30                 ! local small value 
     
    136136      zcd          = 1._wp 
    137137 
    138       !------------------------------------------------------------------ 
    139       ! Surface boundary condition 
    140       !------------------------------------------------------------------ 
    141       ! surface Stress 
    142       !-------------------- 
    143       zuws(:,:) = utau(:,:) * r1_rho0  
    144       zvws(:,:) = vtau(:,:) * r1_rho0  
    145       zustar2(:,:) = SQRT(zuws(:,:)*zuws(:,:)+zvws(:,:)*zvws(:,:)) 
    146       zustar(:,:)  = SQRT(zustar2(:,:)) 
    147  
    148       ! Heat Flux 
    149       !-------------------- 
    150       zfnet(:,:) = qns(:,:) + qsr(:,:) 
    151       zfnet(:,:) = zfnet(:,:) / (rho0 * rcp) 
    152  
    153       ! Water Flux 
    154       !--------------------- 
    155       zsws(:,:) = emp(:,:) 
    156  
    157       !------------------------------------------- 
    158       ! Initialisation of prognostic variables 
    159       !------------------------------------------- 
    160       zrwp (:,:,:) =  0._wp ; zrwp2(:,:,:) =  0._wp ; zedmf(:,:,:) =  0._wp 
    161       zph  (:,:)   =  0._wp ; zphm1(:,:)   =  0._wp ; zphpm1(:,:)  =  0._wp 
    162       ztsp(:,:,:,:)=  0._wp 
    163  
    164       ! Tracers inside plume (ztsp) and environment (ztse) 
    165       ztsp(:,:,1,jp_tem) = pts(:,:,1,jp_tem,Kmm) * tmask(:,:,1) 
    166       ztsp(:,:,1,jp_sal) = pts(:,:,1,jp_sal,Kmm) * tmask(:,:,1) 
    167       ztse(:,:,1,jp_tem) = pts(:,:,1,jp_tem,Kmm) * tmask(:,:,1) 
    168       ztse(:,:,1,jp_sal) = pts(:,:,1,jp_sal,Kmm) * tmask(:,:,1) 
     138      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     139         !------------------------------------------------------------------ 
     140         ! Surface boundary condition 
     141         !------------------------------------------------------------------ 
     142         ! surface Stress 
     143         !-------------------- 
     144         zuws(ji,jj) = utau(ji,jj) * r1_rho0 
     145         zvws(ji,jj) = vtau(ji,jj) * r1_rho0 
     146         zustar2(ji,jj) = SQRT(zuws(ji,jj)*zuws(ji,jj)+zvws(ji,jj)*zvws(ji,jj)) 
     147         zustar(ji,jj)  = SQRT(zustar2(ji,jj)) 
     148 
     149         ! Heat Flux 
     150         !-------------------- 
     151         zfnet(ji,jj) = qns(ji,jj) + qsr(ji,jj) 
     152         zfnet(ji,jj) = zfnet(ji,jj) / (rho0 * rcp) 
     153 
     154         ! Water Flux 
     155         !--------------------- 
     156         zsws(ji,jj) = emp(ji,jj) 
     157 
     158         !------------------------------------------- 
     159         ! Initialisation of prognostic variables 
     160         !------------------------------------------- 
     161         zrwp (ji,jj,:) =  0._wp ; zrwp2(ji,jj,:) =  0._wp ; zedmf(ji,jj,:) =  0._wp 
     162         zph  (ji,jj)   =  0._wp ; zphm1(ji,jj)   =  0._wp ; zphpm1(ji,jj)  =  0._wp 
     163         ztsp(ji,jj,:,:)=  0._wp 
     164 
     165         ! Tracers inside plume (ztsp) and environment (ztse) 
     166         ztsp(ji,jj,1,jp_tem) = pts(ji,jj,1,jp_tem,Kmm) * tmask(ji,jj,1) 
     167         ztsp(ji,jj,1,jp_sal) = pts(ji,jj,1,jp_sal,Kmm) * tmask(ji,jj,1) 
     168         ztse(ji,jj,1,jp_tem) = pts(ji,jj,1,jp_tem,Kmm) * tmask(ji,jj,1) 
     169         ztse(ji,jj,1,jp_sal) = pts(ji,jj,1,jp_sal,Kmm) * tmask(ji,jj,1) 
     170      END_2D 
    169171 
    170172      CALL eos( ztse(:,:,1,:) ,  zrautb(:,:) ) 
     
    174176      ! Boundary Condition of Mass Flux (plume velo.; convective area, entrain/detrain) 
    175177      !------------------------------------------- 
    176       zhcmo(:,:) = e3t(:,:,1,Kmm) 
     178      zhcmo(:,:) = e3t(A1Di(nn_hls),A1Dj(nn_hls),1,Kmm) 
    177179      zfbuo(:,:)   = 0._wp 
    178180      WHERE ( ABS(zrautb(:,:)) > 1.e-20 ) zfbuo(:,:)   =   & 
    179          &      grav * ( 2.e-4_wp *zfnet(:,:) - 7.6E-4_wp*pts(:,:,1,jp_sal,Kmm)*zsws(:,:)/zrautb(:,:)) * zhcmo(:,:) 
     181         &      grav * ( 2.e-4_wp *zfnet(:,:)              & 
     182         &      - 7.6E-4_wp*pts(A2D(nn_hls),1,jp_sal,Kmm)  & 
     183         &      * zsws(:,:)/zrautb(:,:)) * zhcmo(:,:) 
    180184 
    181185      zedmf(:,:,1) = -0.065_wp*(ABS(zfbuo(:,:)))**(1._wp/3._wp)*SIGN(1.,zfbuo(:,:)) 
     
    211215         CALL eos( ztsp(:,:,jk-1,:    ) ,  zraupl(:,:)   ) 
    212216 
    213          zphm1(:,:)  = zphm1(:,:)  + grav * zrautbm1(:,:) * e3t(:,:,jk-1, Kmm) 
    214          zphpm1(:,:) = zphpm1(:,:) + grav * zraupl(:,:)   * e3t(:,:,jk-1, Kmm) 
    215          zph(:,:)    = zphm1(:,:)  + grav * zrautb(:,:)   * e3t(:,:,jk  , Kmm) 
    216          zph(:,:)    = MAX( zph(:,:), zepsilon) 
     217         DO_2D( 0, 0, 0, 0 ) 
     218            zphm1(ji,jj)  = zphm1(ji,jj)  + grav * zrautbm1(ji,jj) * e3t(ji,jj,jk-1, Kmm) 
     219            zphpm1(ji,jj) = zphpm1(ji,jj) + grav * zraupl(ji,jj)   * e3t(ji,jj,jk-1, Kmm) 
     220            zph(ji,jj)    = zphm1(ji,jj)  + grav * zrautb(ji,jj)   * e3t(ji,jj,jk  , Kmm) 
     221            zph(ji,jj)    = MAX( zph(ji,jj), zepsilon) 
     222         END_2D 
    217223 
    218224         WHERE(zrautbm1 .NE. 0.) zfbuo(:,:)  =  grav * (zraupl(:,:) - zrautbm1(:,:)) / zrautbm1(:,:) 
     
    322328 
    323329      ! Compute Mass Flux on T-point 
    324       DO jk=1,jpk-1 
    325          edmfm(:,:,jk) = (zedmf(:,:,jk+1)  + zedmf(:,:,jk) )*0.5_wp 
    326       END DO 
    327       edmfm(:,:,jpk) = zedmf(:,:,jpk)  
     330      DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     331         edmfm(ji,jj,jk) = (zedmf(ji,jj,jk+1)  + zedmf(ji,jj,jk) )*0.5_wp 
     332      END_3D 
     333      DO_2D( 0, 0, 0, 0 ) 
     334         edmfm(ji,jj,jpk) = zedmf(ji,jj,jpk) 
     335      END_2D 
    328336 
    329337      ! Save variable (on T point) 
     
    338346      !  Computation of a tridiagonal matrix and right hand side terms of the linear system 
    339347      !================================================================================= 
    340       edmfa(:,:,:)     = 0._wp 
    341       edmfb(:,:,:)     = 0._wp 
    342       edmfc(:,:,:)     = 0._wp 
    343       edmftra(:,:,:,:) = 0._wp 
     348      DO_3D( 0, 0, 0, 0, 1, jpk ) 
     349         edmfa(ji,jj,jk)     = 0._wp 
     350         edmfb(ji,jj,jk)     = 0._wp 
     351         edmfc(ji,jj,jk)     = 0._wp 
     352         edmftra(ji,jj,jk,:) = 0._wp 
     353      END_3D 
    344354 
    345355      !--------------------------------------------------------------- 
    346356      ! Diagonal terms  
    347357      !--------------------------------------------------------------- 
    348       DO jk=1,jpk-1 
    349          edmfa(:,:,jk) =  0._wp 
    350          edmfb(:,:,jk) = -edmfm(:,:,jk  ) / e3w(:,:,jk+1,Kmm) 
    351          edmfc(:,:,jk) =  edmfm(:,:,jk+1) / e3w(:,:,jk+1,Kmm) 
    352       END DO 
    353       edmfa(:,:,jpk)   = -edmfm(:,:,jpk-1) / e3w(:,:,jpk,Kmm) 
    354       edmfb(:,:,jpk)   =  edmfm(:,:,jpk  ) / e3w(:,:,jpk,Kmm) 
    355       edmfc(:,:,jpk)   =  0._wp 
     358      DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     359         edmfa(ji,jj,jk) =  0._wp 
     360         edmfb(ji,jj,jk) = -edmfm(ji,jj,jk  ) / e3w(ji,jj,jk+1,Kmm) 
     361         edmfc(ji,jj,jk) =  edmfm(ji,jj,jk+1) / e3w(ji,jj,jk+1,Kmm) 
     362      END_3D 
     363      DO_2D( 0, 0, 0, 0 ) 
     364         edmfa(ji,jj,jpk)   = -edmfm(ji,jj,jpk-1) / e3w(ji,jj,jpk,Kmm) 
     365         edmfb(ji,jj,jpk)   =  edmfm(ji,jj,jpk  ) / e3w(ji,jj,jpk,Kmm) 
     366         edmfc(ji,jj,jpk)   =  0._wp 
     367      END_2D 
    356368 
    357369      !--------------------------------------------------------------- 
    358370      ! right hand side term for Temperature 
    359371      !--------------------------------------------------------------- 
    360       DO jk=1,jpk-1 
    361         edmftra(:,:,jk,1) = - edmfm(:,:,jk  ) * ztsp(:,:,jk  ,jp_tem) / e3w(:,:,jk+1,Kmm) & 
    362                           & + edmfm(:,:,jk+1) * ztsp(:,:,jk+1,jp_tem) / e3w(:,:,jk+1,Kmm) 
    363       END DO 
    364       edmftra(:,:,jpk,1) = - edmfm(:,:,jpk-1) * ztsp(:,:,jpk-1,jp_tem) / e3w(:,:,jpk,Kmm) & 
    365                          & + edmfm(:,:,jpk  ) * ztsp(:,:,jpk  ,jp_tem) / e3w(:,:,jpk,Kmm) 
    366                          
     372      DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     373        edmftra(ji,jj,jk,1) = - edmfm(ji,jj,jk  ) * ztsp(ji,jj,jk  ,jp_tem) / e3w(ji,jj,jk+1,Kmm) & 
     374                            & + edmfm(ji,jj,jk+1) * ztsp(ji,jj,jk+1,jp_tem) / e3w(ji,jj,jk+1,Kmm) 
     375      END_3D 
     376      DO_2D( 0, 0, 0, 0 ) 
     377         edmftra(ji,jj,jpk,1) = - edmfm(ji,jj,jpk-1) * ztsp(ji,jj,jpk-1,jp_tem) / e3w(ji,jj,jpk,Kmm) & 
     378                              & + edmfm(ji,jj,jpk  ) * ztsp(ji,jj,jpk  ,jp_tem) / e3w(ji,jj,jpk,Kmm) 
     379      END_2D 
     380 
    367381      !--------------------------------------------------------------- 
    368382      ! Right hand side term for Salinity 
    369383      !--------------------------------------------------------------- 
    370       DO jk=1,jpk-1 
    371          edmftra(:,:,jk,2) =  - edmfm(:,:,jk  ) * ztsp(:,:,jk  ,jp_sal) / e3w(:,:,jk+1,Kmm) & 
    372                            &  + edmfm(:,:,jk+1) * ztsp(:,:,jk+1,jp_sal) / e3w(:,:,jk+1,Kmm) 
    373       END DO 
    374       edmftra(:,:,jpk,2) = - edmfm(:,:,jpk-1) * ztsp(:,:,jpk-1,jp_sal) / e3w(:,:,jpk,Kmm) & 
    375                          & + edmfm(:,:,jpk  ) * ztsp(:,:,jpk  ,jp_sal) / e3w(:,:,jpk,Kmm) 
    376       ! 
    377       ! 
    378       CALL lbc_lnk( 'zdfmfc', edmfm,'T',1., edmfa,'T',1., edmfb,'T',1., edmfc,'T',1., edmftra(:,:,:,jp_tem),'T',1., edmftra(:,:,:,jp_sal),'T',1.) 
     384      DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     385         edmftra(ji,jj,jk,2) =  - edmfm(ji,jj,jk  ) * ztsp(ji,jj,jk  ,jp_sal) / e3w(ji,jj,jk+1,Kmm) & 
     386                             &  + edmfm(ji,jj,jk+1) * ztsp(ji,jj,jk+1,jp_sal) / e3w(ji,jj,jk+1,Kmm) 
     387      END_3D 
     388      DO_2D( 0, 0, 0, 0 ) 
     389         edmftra(ji,jj,jpk,2) = - edmfm(ji,jj,jpk-1) * ztsp(ji,jj,jpk-1,jp_sal) / e3w(ji,jj,jpk,Kmm) & 
     390                              & + edmfm(ji,jj,jpk  ) * ztsp(ji,jj,jpk  ,jp_sal) / e3w(ji,jj,jpk,Kmm) 
     391      END_2D 
    379392      ! 
    380393   END SUBROUTINE tra_mfc 
     
    383396   SUBROUTINE diag_mfc( zdiagi, zdiagd, zdiags, p2dt, Kaa ) 
    384397 
    385       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::  zdiagi, zdiagd, zdiags  ! inout: tridaig. terms  
    386       REAL(wp)                        , INTENT(in   ) ::   p2dt                   ! tracer time-step 
    387       INTEGER                         , INTENT(in   ) ::   Kaa                    ! ocean time level indices 
     398      REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(inout) ::  zdiagi, zdiagd, zdiags  ! inout: tridaig. terms 
     399      REAL(wp)                            , INTENT(in   ) ::   p2dt                   ! tracer time-step 
     400      INTEGER                             , INTENT(in   ) ::   Kaa                    ! ocean time level indices 
    388401 
    389402      INTEGER  ::   ji, jj, jk  ! dummy  loop arguments    
  • NEMO/trunk/src/OCE/ZDF/zdfmxl.F90

    r13497 r14834  
    2626   PRIVATE 
    2727 
    28    PUBLIC   zdf_mxl   ! called by zdfphy.F90 
     28   PUBLIC   zdf_mxl, zdf_mxl_turb   ! called by zdfphy.F90 
    2929 
    3030   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   nmln    !: number of level in the mixed layer (used by LDF, ZDF, TRD, TOP) 
     
    4141   !!---------------------------------------------------------------------- 
    4242   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    43    !! $Id$  
     43   !! $Id$ 
    4444   !! Software governed by the CeCILL license (see ./LICENSE) 
    4545   !!---------------------------------------------------------------------- 
     
    6565      !!                  ***  ROUTINE zdfmxl  *** 
    6666      !!                    
    67       !! ** Purpose :   Compute the turbocline depth and the mixed layer depth 
    68       !!              with density criteria. 
     67      !! ** Purpose :   Compute the mixed layer depth with density criteria. 
    6968      !! 
    7069      !! ** Method  :   The mixed layer depth is the shallowest W depth with  
    7170      !!      the density of the corresponding T point (just bellow) bellow a 
    7271      !!      given value defined locally as rho(10m) + rho_c 
    73       !!               The turbocline depth is the depth at which the vertical 
    74       !!      eddy diffusivity coefficient (resulting from the vertical physics 
    75       !!      alone, not the isopycnal part, see trazdf.F) fall below a given 
    76       !!      value defined locally (avt_c here taken equal to 5 cm/s2 by default) 
    7772      !! 
    78       !! ** Action  :   nmln, hmld, hmlp, hmlpt 
     73      !! ** Action  :   nmln, hmlp, hmlpt 
    7974      !!---------------------------------------------------------------------- 
    8075      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     
    8277      ! 
    8378      INTEGER  ::   ji, jj, jk      ! dummy loop indices 
    84       INTEGER  ::   iikn, iiki, ikt ! local integer 
     79      INTEGER  ::   iik, ikt        ! local integer 
    8580      REAL(wp) ::   zN2_c           ! local scalar 
    86       INTEGER, DIMENSION(jpi,jpj) ::   imld   ! 2D workspace 
    8781      !!---------------------------------------------------------------------- 
    8882      ! 
    89       IF( kt == nit000 ) THEN 
    90          IF(lwp) WRITE(numout,*) 
    91          IF(lwp) WRITE(numout,*) 'zdf_mxl : mixed layer depth' 
    92          IF(lwp) WRITE(numout,*) '~~~~~~~ ' 
    93          !                             ! allocate zdfmxl arrays 
    94          IF( zdf_mxl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_mxl : unable to allocate arrays' ) 
     83      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     84         IF( kt == nit000 ) THEN 
     85            IF(lwp) WRITE(numout,*) 
     86            IF(lwp) WRITE(numout,*) 'zdf_mxl : mixed layer depth' 
     87            IF(lwp) WRITE(numout,*) '~~~~~~~ ' 
     88            !                             ! allocate zdfmxl arrays 
     89            IF( zdf_mxl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_mxl : unable to allocate arrays' ) 
     90         ENDIF 
    9591      ENDIF 
    9692      ! 
    9793      ! w-level of the mixing and mixed layers 
    98       nmln(:,:)  = nlb10                  ! Initialization to the number of w ocean point 
    99       hmlp(:,:)  = 0._wp                  ! here hmlp used as a dummy variable, integrating vertically N^2 
     94      DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls ) 
     95         nmln(ji,jj)  = nlb10                  ! Initialization to the number of w ocean point 
     96         hmlp(ji,jj)  = 0._wp                  ! here hmlp used as a dummy variable, integrating vertically N^2 
     97      END_2D 
    10098      zN2_c = grav * rho_c * r1_rho0      ! convert density criteria into N^2 criteria 
    101       DO_3D( 1, 1, 1, 1, nlb10, jpkm1 )   ! Mixed layer level: w-level 
     99      DO_3D_OVR( nn_hls, nn_hls, nn_hls, nn_hls, nlb10, jpkm1 )   ! Mixed layer level: w-level 
    102100         ikt = mbkt(ji,jj) 
    103101         hmlp(ji,jj) =   & 
     
    105103         IF( hmlp(ji,jj) < zN2_c )   nmln(ji,jj) = MIN( jk , ikt ) + 1   ! Mixed layer level 
    106104      END_3D 
    107       ! 
    108       ! w-level of the turbocline and mixing layer (iom_use) 
    109       imld(:,:) = mbkt(:,:) + 1                ! Initialization to the number of w ocean point 
    110       DO_3DS( 1, 1, 1, 1, jpkm1, nlb10, -1 )   ! from the bottom to nlb10 
    111          IF( avt (ji,jj,jk) < avt_c * wmask(ji,jj,jk) )   imld(ji,jj) = jk      ! Turbocline  
    112       END_3D 
    113       ! depth of the mixing and mixed layers 
    114       DO_2D( 1, 1, 1, 1 ) 
    115          iiki = imld(ji,jj) 
    116          iikn = nmln(ji,jj) 
    117          hmld (ji,jj) = gdepw(ji,jj,iiki  ,Kmm) * ssmask(ji,jj)    ! Turbocline depth  
    118          hmlp (ji,jj) = gdepw(ji,jj,iikn  ,Kmm) * ssmask(ji,jj)    ! Mixed layer depth 
    119          hmlpt(ji,jj) = gdept(ji,jj,iikn-1,Kmm) * ssmask(ji,jj)    ! depth of the last T-point inside the mixed layer 
     105      ! depth of the mixed layer 
     106      DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls ) 
     107         iik = nmln(ji,jj) 
     108         hmlp (ji,jj) = gdepw(ji,jj,iik  ,Kmm) * ssmask(ji,jj)    ! Mixed layer depth 
     109         hmlpt(ji,jj) = gdept(ji,jj,iik-1,Kmm) * ssmask(ji,jj)    ! depth of the last T-point inside the mixed layer 
    120110      END_2D 
    121111      ! 
    122       IF( .NOT.l_offline ) THEN 
    123          IF( iom_use("mldr10_1") ) THEN 
    124             IF( ln_isfcav ) THEN  ;  CALL iom_put( "mldr10_1", hmlp - risfdep)   ! mixed layer thickness 
    125             ELSE                  ;  CALL iom_put( "mldr10_1", hmlp )            ! mixed layer depth 
    126             END IF 
     112      IF( .NOT.l_offline .AND. iom_use("mldr10_1") ) THEN 
     113         IF( ln_isfcav ) THEN  ;  CALL iom_put( "mldr10_1", hmlp - risfdep)   ! mixed layer thickness 
     114         ELSE                  ;  CALL iom_put( "mldr10_1", hmlp )            ! mixed layer depth 
    127115         END IF 
    128          IF( iom_use("mldkz5") ) THEN 
    129             IF( ln_isfcav ) THEN  ;  CALL iom_put( "mldkz5"  , hmld - risfdep )   ! turbocline thickness 
    130             ELSE                  ;  CALL iom_put( "mldkz5"  , hmld )             ! turbocline depth 
    131             END IF 
    132          ENDIF 
    133116      ENDIF 
    134117      ! 
     
    137120   END SUBROUTINE zdf_mxl 
    138121 
     122 
     123   SUBROUTINE zdf_mxl_turb( kt, Kmm ) 
     124      !!---------------------------------------------------------------------- 
     125      !!                  ***  ROUTINE zdf_mxl_turb  *** 
     126      !! 
     127      !! ** Purpose :   Compute the turbocline depth. 
     128      !! 
     129      !! ** Method  :   The turbocline depth is the depth at which the vertical 
     130      !!      eddy diffusivity coefficient (resulting from the vertical physics 
     131      !!      alone, not the isopycnal part, see trazdf.F) fall below a given 
     132      !!      value defined locally (avt_c here taken equal to 5 cm/s2 by default) 
     133      !! 
     134      !! ** Action  :   hmld 
     135      !!---------------------------------------------------------------------- 
     136      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     137      INTEGER, INTENT(in) ::   Kmm  ! ocean time level index 
     138      ! 
     139      INTEGER  ::   ji, jj, jk      ! dummy loop indices 
     140      INTEGER  ::   iik             ! local integer 
     141      INTEGER, DIMENSION(A2D(nn_hls)) ::   imld   ! 2D workspace 
     142      !!---------------------------------------------------------------------- 
     143      ! 
     144      ! w-level of the turbocline and mixing layer (iom_use) 
     145      imld(:,:) = mbkt(A2D(nn_hls)) + 1                ! Initialization to the number of w ocean point 
     146      DO_3DS( 1, 1, 1, 1, jpkm1, nlb10, -1 )   ! from the bottom to nlb10 
     147         IF( avt (ji,jj,jk) < avt_c * wmask(ji,jj,jk) )   imld(ji,jj) = jk      ! Turbocline 
     148      END_3D 
     149      ! depth of the mixing layer 
     150      DO_2D_OVR( 1, 1, 1, 1 ) 
     151         iik = imld(ji,jj) 
     152         hmld (ji,jj) = gdepw(ji,jj,iik  ,Kmm) * ssmask(ji,jj)    ! Turbocline depth 
     153      END_2D 
     154      ! 
     155      IF( .NOT.l_offline .AND. iom_use("mldkz5") ) THEN 
     156         IF( ln_isfcav ) THEN  ;  CALL iom_put( "mldkz5"  , hmld - risfdep )   ! turbocline thickness 
     157         ELSE                  ;  CALL iom_put( "mldkz5"  , hmld )             ! turbocline depth 
     158         END IF 
     159      ENDIF 
     160      ! 
     161   END SUBROUTINE zdf_mxl_turb 
    139162   !!====================================================================== 
    140163END MODULE zdfmxl 
  • NEMO/trunk/src/OCE/ZDF/zdfphy.F90

    r14433 r14834  
    1212   !!---------------------------------------------------------------------- 
    1313   USE oce            ! ocean dynamics and tracers variables 
     14   ! TEMP: [tiling] This change not necessary after finalisation of zdf_osm (not yet tiled) 
     15   USE domtile 
    1416   USE zdf_oce        ! vertical physics: shared variables 
    1517   USE zdfdrg         ! vertical physics: top/bottom drag coef. 
     
    5456   INTEGER, PARAMETER ::   np_OSM = 5   ! OSMOSIS-OBL closure scheme for Kz 
    5557 
    56    LOGICAL ::   l_zdfsh2   ! shear production term flag (=F for CST, =T otherwise (i.e. TKE, GLS, RIC)) 
    57  
     58   LOGICAL, PUBLIC ::   l_zdfsh2   ! shear production term flag (=F for CST, =T otherwise (i.e. TKE, GLS, RIC)) 
     59 
     60   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   avm_k_n !: "Now" avm_k used for calculation of zsh2 with tiling 
     61 
     62   !! * Substitutions 
     63#  include "do_loop_substitute.h90" 
    5864   !!---------------------------------------------------------------------- 
    5965   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    180186      IF( lk_top    .AND. ln_zdfnpc )   CALL ctl_stop( 'zdf_phy_init: npc scheme is not working with key_top' ) 
    181187      IF( lk_top    .AND. ln_zdfosm )   CALL ctl_warn( 'zdf_phy_init: osmosis gives no non-local fluxes for TOP tracers yet' ) 
     188      ! TEMP: [tiling] This change not necessary after finalisation of zdf_osm (not yet tiled) 
     189      IF( ln_tile   .AND. ln_zdfosm )   CALL ctl_warn( 'zdf_phy_init: osmosis does not yet work with tiling' ) 
    182190      IF( lk_top    .AND. ln_zdfmfc )   CALL ctl_stop( 'zdf_phy_init: Mass Flux scheme is not working with key_top' ) 
    183191      IF(lwp) THEN 
     
    210218      ENDIF 
    211219      !                                ! shear production term flag 
    212       IF( ln_zdfcst ) THEN   ;   l_zdfsh2 = .FALSE. 
    213       ELSE                   ;   l_zdfsh2 = .TRUE. 
    214       ENDIF 
     220      IF( ln_zdfcst .OR. ln_zdfosm ) THEN   ;   l_zdfsh2 = .FALSE. 
     221      ELSE                                  ;   l_zdfsh2 = .TRUE. 
     222      ENDIF 
     223      IF( ln_tile .AND. l_zdfsh2 ) ALLOCATE( avm_k_n(jpi,jpj,jpk) ) 
    215224      !                          !== Mass Flux Convectiive algorithm  ==! 
    216225      IF( ln_zdfmfc )   CALL zdf_mfc_init       ! Convection computed with eddy diffusivity mass flux 
     
    246255      ! 
    247256      INTEGER ::   ji, jj, jk   ! dummy loop indice 
    248       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zsh2   ! shear production 
     257      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zsh2   ! shear production 
     258      ! TEMP: [tiling] This change not necessary after finalisation of zdf_osm (not yet tiled) 
     259      LOGICAL :: lskip 
    249260      !! --------------------------------------------------------------------- 
    250261      ! 
    251262      IF( ln_timing )   CALL timing_start('zdf_phy') 
     263 
     264      ! TEMP: [tiling] These changes not necessary after finalisation of zdf_osm (not yet tiled) 
     265      lskip = .FALSE. 
     266 
     267      IF( ln_tile .AND. nzdf_phy == np_OSM )  THEN 
     268         IF( ntile == 1 ) THEN 
     269            CALL dom_tile_stop( ldhold=.TRUE. ) 
     270         ELSE 
     271            lskip = .TRUE. 
     272         ENDIF 
     273      ENDIF 
    252274      ! 
    253275      IF( l_zdfdrg ) THEN     !==  update top/bottom drag  ==!   (non-linear cases) 
     
    267289      IF ( ln_drgice_imp) THEN 
    268290         IF ( ln_isfcav ) THEN 
    269             rCdU_top(:,:) = rCdU_top(:,:) + ssmask(:,:) * tmask(:,:,1) * rCdU_ice(:,:) 
     291            DO_2D_OVR( 1, 1, 1, 1 ) 
     292               rCdU_top(ji,jj) = rCdU_top(ji,jj) + ssmask(ji,jj) * tmask(ji,jj,1) * rCdU_ice(ji,jj) 
     293            END_2D 
    270294         ELSE 
    271             rCdU_top(:,:) = rCdU_ice(:,:) 
     295            DO_2D_OVR( 1, 1, 1, 1 ) 
     296               rCdU_top(ji,jj) = rCdU_ice(ji,jj) 
     297            END_2D 
    272298         ENDIF 
    273299      ENDIF 
    274300#endif 
    275301      ! 
    276       !                       !==  Kz from chosen turbulent closure  ==!   (avm_k, avt_k) 
    277       ! 
    278       IF( l_zdfsh2 )   &         !* shear production at w-points (energy conserving form) 
    279          CALL zdf_sh2( Kbb, Kmm, avm_k,   &     ! <<== in 
    280             &                     zsh2    )     ! ==>> out : shear production 
    281       ! 
    282       SELECT CASE ( nzdf_phy )                  !* Vertical eddy viscosity and diffusivity coefficients at w-points 
    283       CASE( np_RIC )   ;   CALL zdf_ric( kt,      Kmm, zsh2, avm_k, avt_k )    ! Richardson number dependent Kz 
    284       CASE( np_TKE )   ;   CALL zdf_tke( kt, Kbb, Kmm, zsh2, avm_k, avt_k )    ! TKE closure scheme for Kz 
    285       CASE( np_GLS )   ;   CALL zdf_gls( kt, Kbb, Kmm, zsh2, avm_k, avt_k )    ! GLS closure scheme for Kz 
    286       CASE( np_OSM )   ;   CALL zdf_osm( kt, Kbb, Kmm, Krhs, avm_k, avt_k )    ! OSMOSIS closure scheme for Kz 
    287 !     CASE( np_CST )                                  ! Constant Kz (reset avt, avm to the background value) 
    288 !         ! avt_k and avm_k set one for all at initialisation phase 
     302      CALL zdf_mxl( kt, Kmm )                        !* mixed layer depth, and level 
     303 
     304      ! TEMP: [tiling] These changes not necessary after finalisation of zdf_osm (not yet tiled) 
     305      IF( .NOT. lskip ) THEN 
     306         !                       !==  Kz from chosen turbulent closure  ==!   (avm_k, avt_k) 
     307         ! 
     308         ! NOTE: [tiling] the closure schemes (zdf_tke etc) will update avm_k. With tiling, the calculation of zsh2 on adjacent tiles then uses both updated (next timestep) and non-updated (current timestep) values of avm_k. To preserve results, we save a read-only copy of the "now" avm_k to use in the calculation of zsh2. 
     309         IF( l_zdfsh2 ) THEN        !* shear production at w-points (energy conserving form) 
     310            IF( ln_tile ) THEN 
     311               IF( ntile == 1 ) avm_k_n(:,:,:) = avm_k(:,:,:)     ! Preserve "now" avm_k for calculation of zsh2 
     312               CALL zdf_sh2( Kbb, Kmm, avm_k_n, &     ! <<== in 
     313                  &                     zsh2    )     ! ==>> out : shear production 
     314            ELSE 
     315               CALL zdf_sh2( Kbb, Kmm, avm_k,   &     ! <<== in 
     316                  &                     zsh2    )     ! ==>> out : shear production 
     317            ENDIF 
     318         ENDIF 
     319         ! 
     320         SELECT CASE ( nzdf_phy )                  !* Vertical eddy viscosity and diffusivity coefficients at w-points 
     321         CASE( np_RIC )   ;   CALL zdf_ric( kt,      Kmm, zsh2, avm_k, avt_k )    ! Richardson number dependent Kz 
     322         CASE( np_TKE )   ;   CALL zdf_tke( kt, Kbb, Kmm, zsh2, avm_k, avt_k )    ! TKE closure scheme for Kz 
     323         CASE( np_GLS )   ;   CALL zdf_gls( kt, Kbb, Kmm, zsh2, avm_k, avt_k )    ! GLS closure scheme for Kz 
     324         CASE( np_OSM )   ;   CALL zdf_osm( kt, Kbb, Kmm, Krhs, avm_k, avt_k )    ! OSMOSIS closure scheme for Kz 
     325   !     CASE( np_CST )                                  ! Constant Kz (reset avt, avm to the background value) 
     326   !         ! avt_k and avm_k set one for all at initialisation phase 
    289327!!gm         avt(2:jpim1,2:jpjm1,1:jpkm1) = rn_avt0 * wmask(2:jpim1,2:jpjm1,1:jpkm1) 
    290328!!gm         avm(2:jpim1,2:jpjm1,1:jpkm1) = rn_avm0 * wmask(2:jpim1,2:jpjm1,1:jpkm1) 
    291       END SELECT 
     329         END SELECT 
     330 
     331         IF( ln_tile .AND. .NOT. l_istiled ) CALL dom_tile_start( ldhold=.TRUE. ) 
     332      ENDIF 
    292333      ! 
    293334      !                          !==  ocean Kz  ==!   (avt, avs, avm) 
    294335      ! 
    295336      !                                         !* start from turbulent closure values 
    296       avt(:,:,2:jpkm1) = avt_k(:,:,2:jpkm1) 
    297       avm(:,:,2:jpkm1) = avm_k(:,:,2:jpkm1) 
     337      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
     338         avt(ji,jj,jk) = avt_k(ji,jj,jk) 
     339         avm(ji,jj,jk) = avm_k(ji,jj,jk) 
     340      END_3D 
    298341      ! 
    299342      IF( ln_rnf_mouth ) THEN                   !* increase diffusivity at rivers mouths 
    300          DO jk = 2, nkrnf 
    301             avt(:,:,jk) = avt(:,:,jk) + 2._wp * rn_avt_rnf * rnfmsk(:,:) * wmask(:,:,jk) 
    302          END DO 
     343         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, nkrnf ) 
     344            avt(ji,jj,jk) = avt(ji,jj,jk) + 2._wp * rn_avt_rnf * rnfmsk(ji,jj) * wmask(ji,jj,jk) 
     345         END_3D 
    303346      ENDIF 
    304347      ! 
     
    309352                        CALL zdf_ddm( kt, Kmm,  avm, avt, avs ) 
    310353      ELSE                                            ! same mixing on all tracers 
    311          avs(2:jpim1,2:jpjm1,1:jpkm1) = avt(2:jpim1,2:jpjm1,1:jpkm1) 
     354         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
     355            avs(ji,jj,jk) = avt(ji,jj,jk) 
     356         END_3D 
    312357      ENDIF 
    313358      ! 
     
    318363#if defined key_agrif 
    319364      ! interpolation parent grid => child grid for avm_k ( ex : at west border: update column 1 and 2) 
    320       IF( l_zdfsh2 )   CALL Agrif_avm 
     365      IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN                       ! Do only on the last tile 
     366         IF( l_zdfsh2 )   CALL Agrif_avm 
     367      ENDIF 
    321368#endif 
    322369 
    323370      !                                         !* Lateral boundary conditions (sign unchanged) 
    324       IF( l_zdfsh2 ) THEN 
    325          CALL lbc_lnk( 'zdfphy', avm_k, 'W', 1.0_wp , avt_k, 'W', 1.0_wp,   & 
    326             &                    avm  , 'W', 1.0_wp , avt  , 'W', 1.0_wp , avs , 'W', 1.0_wp ) 
    327       ELSE 
    328          CALL lbc_lnk( 'zdfphy', avm  , 'W', 1.0_wp , avt  , 'W', 1.0_wp , avs , 'W', 1.0_wp ) 
    329       ENDIF 
    330       ! 
    331       IF( l_zdfdrg ) THEN     ! drag  have been updated (non-linear cases) 
    332          IF( ln_isfcav ) THEN   ;  CALL lbc_lnk( 'zdfphy', rCdU_top, 'T', 1.0_wp , rCdU_bot, 'T', 1.0_wp )   ! top & bot drag 
    333          ELSE                   ;  CALL lbc_lnk( 'zdfphy', rCdU_bot, 'T', 1.0_wp )                       ! bottom drag only 
    334          ENDIF 
    335       ENDIF 
    336       ! 
    337       CALL zdf_mxl( kt, Kmm )                        !* mixed layer depth, and level 
    338       ! 
    339       IF( lrst_oce ) THEN                       !* write TKE, GLS or RIC fields in the restart file 
    340          IF( ln_zdftke )   CALL tke_rst( kt, 'WRITE' ) 
    341          IF( ln_zdfgls )   CALL gls_rst( kt, 'WRITE' ) 
    342          IF( ln_zdfric )   CALL ric_rst( kt, 'WRITE' ) 
    343          ! NB. OSMOSIS restart (osm_rst) will be called in step.F90 after ww has been updated 
     371      IF(nn_hls==1) THEN 
     372         IF( l_zdfsh2 ) THEN 
     373            CALL lbc_lnk( 'zdfphy', avm_k, 'W', 1.0_wp , avt_k, 'W', 1.0_wp,   & 
     374                  &                 avm  , 'W', 1.0_wp , avt  , 'W', 1.0_wp , avs , 'W', 1.0_wp ) 
     375         ELSE 
     376            CALL lbc_lnk( 'zdfphy', avm  , 'W', 1.0_wp , avt  , 'W', 1.0_wp , avs , 'W', 1.0_wp ) 
     377         ENDIF 
     378         ! 
     379         IF( l_zdfdrg ) THEN     ! drag  have been updated (non-linear cases) 
     380            IF( ln_isfcav ) THEN   ;  CALL lbc_lnk( 'zdfphy', rCdU_top, 'T', 1.0_wp , rCdU_bot, 'T', 1.0_wp )   ! top & bot drag 
     381            ELSE                   ;  CALL lbc_lnk( 'zdfphy', rCdU_bot, 'T', 1.0_wp )                           ! bottom drag only 
     382            ENDIF 
     383         ENDIF 
     384      ENDIF 
     385      ! 
     386      CALL zdf_mxl_turb( kt, Kmm )                   !* turbocline depth 
     387      ! 
     388      IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN                       ! Do only on the last tile 
     389         IF( lrst_oce ) THEN                       !* write TKE, GLS or RIC fields in the restart file 
     390            IF( ln_zdftke )   CALL tke_rst( kt, 'WRITE' ) 
     391            IF( ln_zdfgls )   CALL gls_rst( kt, 'WRITE' ) 
     392            IF( ln_zdfric )   CALL ric_rst( kt, 'WRITE' ) 
     393            ! NB. OSMOSIS restart (osm_rst) will be called in step.F90 after ww has been updated 
     394         ENDIF 
    344395      ENDIF 
    345396      ! 
  • NEMO/trunk/src/OCE/ZDF/zdfric.F90

    r14072 r14834  
    145145      !!              PFJ Lermusiaux 2001. 
    146146      !!---------------------------------------------------------------------- 
    147       INTEGER                   , INTENT(in   ) ::   kt             ! ocean time-step 
    148       INTEGER                   , INTENT(in   ) ::   Kmm            ! ocean time level index 
    149       REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   p_sh2          ! shear production term 
    150       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   p_avm, p_avt   ! momentum and tracer Kz (w-points) 
     147      INTEGER                             , INTENT(in   ) ::   kt             ! ocean time-step 
     148      INTEGER                             , INTENT(in   ) ::   Kmm            ! ocean time level index 
     149      REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(in   ) ::   p_sh2          ! shear production term 
     150      REAL(wp), DIMENSION(:,:,:)          , INTENT(inout) ::   p_avm, p_avt   ! momentum and tracer Kz (w-points) 
    151151      !! 
    152152      INTEGER  ::   ji, jj, jk                  ! dummy loop indices 
    153153      REAL(wp) ::   zcfRi, zav, zustar, zhek    ! local scalars 
    154       REAL(wp), DIMENSION(jpi,jpj) ::   zh_ekm  ! 2D workspace 
     154      REAL(wp), DIMENSION(A2D(nn_hls)) ::   zh_ekm  ! 2D workspace 
    155155      !!---------------------------------------------------------------------- 
    156156      ! 
    157157      !                       !==  avm and avt = F(Richardson number)  ==! 
    158       DO_3D( 1, 0, 1, 0, 2, jpkm1 )       ! coefficient = F(richardson number) (avm-weighted Ri) 
     158      DO_3D_OVR( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 2, jpkm1 )       ! coefficient = F(richardson number) (avm-weighted Ri) 
    159159         zcfRi = 1._wp / (  1._wp + rn_alp * MAX(  0._wp , avm(ji,jj,jk) * rn2(ji,jj,jk) / ( p_sh2(ji,jj,jk) + 1.e-20 ) )  ) 
    160160         zav   = rn_avmri * zcfRi**nn_ric 
     
    169169      IF( ln_mldw ) THEN      !==  set a minimum value in the Ekman layer  ==! 
    170170         ! 
    171          DO_2D( 0, 0, 0, 0 )             !* Ekman depth 
     171         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )  
    172172            zustar = SQRT( taum(ji,jj) * r1_rho0 ) 
    173173            zhek   = rn_ekmfc * zustar / ( ABS( ff_t(ji,jj) ) + rsmall )   ! Ekman depth 
    174174            zh_ekm(ji,jj) = MAX(  rn_mldmin , MIN( zhek , rn_mldmax )  )   ! set allowed range 
    175175         END_2D 
    176          DO_3D( 0, 0, 0, 0, 2, jpkm1 )   !* minimum mixing coeff. within the Ekman layer 
     176         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )   !* minimum mixing coeff. within the Ekman layer 
    177177            IF( gdept(ji,jj,jk,Kmm) < zh_ekm(ji,jj) ) THEN 
    178178               p_avm(ji,jj,jk) = MAX(  p_avm(ji,jj,jk), rn_wvmix  ) * wmask(ji,jj,jk) 
  • NEMO/trunk/src/OCE/ZDF/zdfsh2.F90

    r14072 r14834  
    5555      !! References :   Bruchard, OM 2002 
    5656      !! --------------------------------------------------------------------- 
    57       INTEGER                    , INTENT(in   ) ::   Kbb, Kmm             ! ocean time level indices 
    58       REAL(wp), DIMENSION(:,:,:) , INTENT(in   ) ::   p_avm                ! vertical eddy viscosity (w-points) 
    59       REAL(wp), DIMENSION(:,:,:) , INTENT(  out) ::   p_sh2                ! shear production of TKE (w-points) 
     57      INTEGER                              , INTENT(in   ) ::   Kbb, Kmm             ! ocean time level indices 
     58      REAL(wp), DIMENSION(:,:,:)           , INTENT(in   ) ::   p_avm                ! vertical eddy viscosity (w-points) 
     59      REAL(wp), DIMENSION(A2D(nn_hls),jpk) , INTENT(  out) ::   p_sh2                ! shear production of TKE (w-points) 
    6060      ! 
    6161      INTEGER  ::   ji, jj, jk   ! dummy loop arguments 
    62       REAL(wp), DIMENSION(jpi,jpj) ::   zsh2u, zsh2v   ! 2D workspace 
     62      REAL(wp), DIMENSION(A2D(nn_hls)) ::   zsh2u, zsh2v   ! 2D workspace 
    6363      !!-------------------------------------------------------------------- 
    6464      ! 
    6565      DO jk = 2, jpkm1                 !* Shear production at uw- and vw-points (energy conserving form) 
    6666         IF ( cpl_sdrftx .AND. ln_stshear )  THEN       ! Surface Stokes Drift available  ===>>>  shear + stokes drift contibution 
    67             DO_2D( 1, 0, 1, 0 ) 
     67            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    6868               zsh2u(ji,jj) = ( p_avm(ji+1,jj,jk) + p_avm(ji,jj,jk) )        & 
    6969                  &         * ( uu (ji,jj,jk-1,Kmm) -   uu (ji,jj,jk,Kmm)    & 
     
    7878            END_2D 
    7979         ELSE 
    80             DO_2D( 1, 0, 1, 0 )     !* 2 x shear production at uw- and vw-points (energy conserving form) 
     80            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )     !* 2 x shear production at uw- and vw-points (energy conserving form) 
    8181               zsh2u(ji,jj) = ( p_avm(ji+1,jj,jk) + p_avm(ji,jj,jk) ) & 
    8282                  &         * (   uu(ji,jj,jk-1,Kmm) -   uu(ji,jj,jk,Kmm) ) & 
     
    9191            END_2D 
    9292         ENDIF 
    93          DO_2D( 0, 0, 0, 0 )     !* shear production at w-point ! coast mask: =2 at the coast ; =1 otherwise (NB: wmask useless as zsh2 are masked) 
     93         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )     !* shear production at w-point ! coast mask: =2 at the coast ; =1 otherwise (NB: wmask useless as zsh2 are masked) 
    9494            p_sh2(ji,jj,jk) = 0.25 * (   ( zsh2u(ji-1,jj) + zsh2u(ji,jj) ) * ( 2. - umask(ji-1,jj,jk) * umask(ji,jj,jk) )   & 
    9595               &                       + ( zsh2v(ji,jj-1) + zsh2v(ji,jj) ) * ( 2. - vmask(ji,jj-1,jk) * vmask(ji,jj,jk) )   ) 
  • NEMO/trunk/src/OCE/ZDF/zdfswm.F90

    r13295 r14834  
    6363      ! 
    6464      zcoef = 1._wp * 0.353553_wp 
    65       DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     65      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    6666         zqb = zcoef * hsw(ji,jj) * tsd2d(ji,jj) * EXP( -3. * wnum(ji,jj) * gdepw(ji,jj,jk,Kmm) ) * wmask(ji,jj,jk) 
    6767         ! 
  • NEMO/trunk/src/OCE/ZDF/zdftke.F90

    r14072 r14834  
    168168      !!              Bruchard OM 2002 
    169169      !!---------------------------------------------------------------------- 
    170       INTEGER                   , INTENT(in   ) ::   kt             ! ocean time step 
    171       INTEGER                   , INTENT(in   ) ::   Kbb, Kmm       ! ocean time level indices 
    172       REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   p_sh2          ! shear production term 
    173       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   p_avm, p_avt   !  momentum and tracer Kz (w-points) 
     170      INTEGER                             , INTENT(in   ) ::   kt             ! ocean time step 
     171      INTEGER                             , INTENT(in   ) ::   Kbb, Kmm       ! ocean time level indices 
     172      REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(in   ) ::   p_sh2          ! shear production term 
     173      REAL(wp), DIMENSION(:,:,:)          , INTENT(inout) ::   p_avm, p_avt   !  momentum and tracer Kz (w-points) 
    174174      !!---------------------------------------------------------------------- 
    175175      ! 
     
    201201      USE zdf_oce , ONLY : en   ! ocean vertical physics 
    202202      !! 
    203       INTEGER                    , INTENT(in   ) ::   Kbb, Kmm       ! ocean time level indices 
    204       REAL(wp), DIMENSION(:,:,:) , INTENT(in   ) ::   p_sh2          ! shear production term 
    205       REAL(wp), DIMENSION(:,:,:) , INTENT(in   ) ::   p_avm, p_avt   ! vertical eddy viscosity & diffusivity (w-points) 
     203      INTEGER                              , INTENT(in   ) ::   Kbb, Kmm       ! ocean time level indices 
     204      REAL(wp), DIMENSION(A2D(nn_hls),jpk) , INTENT(in   ) ::   p_sh2          ! shear production term 
     205      REAL(wp), DIMENSION(:,:,:)           , INTENT(in   ) ::   p_avm, p_avt   ! vertical eddy viscosity & diffusivity (w-points) 
    206206      ! 
    207207      INTEGER ::   ji, jj, jk                  ! dummy loop arguments 
     
    216216      REAL(wp) ::   zzd_up, zzd_lw             !   -      - 
    217217      REAL(wp) ::   ztaui, ztauj, z1_norm 
    218       INTEGER , DIMENSION(jpi,jpj)     ::   imlc 
    219       REAL(wp), DIMENSION(jpi,jpj)     ::   zice_fra, zhlc, zus3, zWlc2 
    220       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zpelc, zdiag, zd_up, zd_lw 
     218      INTEGER , DIMENSION(A2D(nn_hls))     ::   imlc 
     219      REAL(wp), DIMENSION(A2D(nn_hls))     ::   zice_fra, zhlc, zus3, zWlc2 
     220      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zpelc, zdiag, zd_up, zd_lw 
    221221      !!-------------------------------------------------------------------- 
    222222      ! 
     
    232232      SELECT CASE ( nn_eice ) 
    233233      CASE( 0 )   ;   zice_fra(:,:) = 0._wp 
    234       CASE( 1 )   ;   zice_fra(:,:) =        TANH( fr_i(:,:) * 10._wp ) 
    235       CASE( 2 )   ;   zice_fra(:,:) =              fr_i(:,:) 
    236       CASE( 3 )   ;   zice_fra(:,:) = MIN( 4._wp * fr_i(:,:) , 1._wp ) 
     234      CASE( 1 )   ;   zice_fra(:,:) =        TANH( fr_i(A2D(nn_hls)) * 10._wp ) 
     235      CASE( 2 )   ;   zice_fra(:,:) =              fr_i(A2D(nn_hls)) 
     236      CASE( 3 )   ;   zice_fra(:,:) = MIN( 4._wp * fr_i(A2D(nn_hls)) , 1._wp ) 
    237237      END SELECT 
    238238      ! 
     
    241241      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    242242      ! 
    243       DO_2D( 0, 0, 0, 0 ) 
     243      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    244244         en(ji,jj,1) = MAX( rn_emin0, zbbrau * taum(ji,jj) ) 
    245245         zdiag(ji,jj,1) = 1._wp/en(ji,jj,1) 
     
    258258      IF( .NOT.ln_drg_OFF ) THEN    !== friction used as top/bottom boundary condition on TKE 
    259259         ! 
    260          DO_2D( 0, 0, 0, 0 )        ! bottom friction 
     260         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )        ! bottom friction 
    261261            zmsku = ( 2. - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) ) 
    262262            zmskv = ( 2. - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) ) 
     
    267267         END_2D 
    268268         IF( ln_isfcav ) THEN 
    269             DO_2D( 0, 0, 0, 0 )     ! top friction 
     269            DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )     ! top friction 
    270270               zmsku = ( 2. - umask(ji-1,jj,mikt(ji,jj)) * umask(ji,jj,mikt(ji,jj)) ) 
    271271               zmskv = ( 2. - vmask(ji,jj-1,mikt(ji,jj)) * vmask(ji,jj,mikt(ji,jj)) ) 
     
    294294!!gm  ! PS: currently we don't have neither the 2 stress components at t-point !nor the angle between u* and u_s 
    295295!!gm  ! so we will overestimate the LC velocity....   !!gm I will do the work if !LC have an effect ! 
    296             DO_2D( 0, 0, 0, 0 ) 
     296            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    297297!!XC                  zWlc2(ji,jj) = 0.5_wp * SQRT( taum(ji,jj) * r1_rho0 * ( ut0sd(ji,jj)**2 +vt0sd(ji,jj)**2 )  ) 
    298298                  zWlc2(ji,jj) = 0.5_wp *  ( ut0sd(ji,jj)**2 +vt0sd(ji,jj)**2 ) 
     
    301301!  Projection of Stokes drift in the wind stress direction 
    302302! 
    303             DO_2D( 0, 0, 0, 0 ) 
     303            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    304304                  ztaui   = 0.5_wp * ( utau(ji,jj) + utau(ji-1,jj) ) 
    305305                  ztauj   = 0.5_wp * ( vtau(ji,jj) + vtau(ji,jj-1) ) 
     
    307307                  zWlc2(ji,jj) = 0.5_wp * z1_norm * ( MAX( ut0sd(ji,jj)*ztaui + vt0sd(ji,jj)*ztauj, 0._wp ) )**2 
    308308            END_2D 
    309          CALL lbc_lnk      ( 'zdftke', zWlc2, 'T', 1. ) 
    310 ! 
    311309         ELSE                          ! Surface Stokes drift deduced from surface stress 
    312310            !                                ! Wlc = u_s   with u_s = 0.016*U_10m, the surface stokes drift  (Axell 2002, Eq.44) 
     
    315313            !                                ! 1/2 Wlc^2 = 0.5 * 0.016 * 0.016 |tau| /( rho_air Cdrag ) 
    316314            zcof = 0.5 * 0.016 * 0.016 / ( zrhoa * zcdrag )      ! to convert stress in 10m wind using a constant drag 
    317             DO_2D( 1, 1, 1, 1 ) 
     315            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    318316               zWlc2(ji,jj) = zcof * taum(ji,jj) 
    319317            END_2D 
     
    323321         !                       !* Depth of the LC circulation  (Axell 2002, Eq.47) 
    324322         !                             !- LHS of Eq.47 
    325          zpelc(:,:,1) =  MAX( rn2b(:,:,1), 0._wp ) * gdepw(:,:,1,Kmm) * e3w(:,:,1,Kmm) 
    326          DO jk = 2, jpk 
    327             zpelc(:,:,jk)  = zpelc(:,:,jk-1) +   & 
    328                &        MAX( rn2b(:,:,jk), 0._wp ) * gdepw(:,:,jk,Kmm) * e3w(:,:,jk,Kmm) 
    329          END DO 
     323         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     324            zpelc(ji,jj,1) =  MAX( rn2b(ji,jj,1), 0._wp ) * gdepw(ji,jj,1,Kmm) * e3w(ji,jj,1,Kmm) 
     325         END_2D 
     326         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpk ) 
     327            zpelc(ji,jj,jk)  = zpelc(ji,jj,jk-1) +   & 
     328               &          MAX( rn2b(ji,jj,jk), 0._wp ) * gdepw(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm) 
     329         END_3D 
    330330         ! 
    331331         !                             !- compare LHS to RHS of Eq.47 
    332          imlc(:,:) = mbkt(:,:) + 1       ! Initialization to the number of w ocean point (=2 over land) 
    333          DO_3DS( 1, 1, 1, 1, jpkm1, 2, -1 ) 
     332         imlc(:,:) = mbkt(A2D(nn_hls)) + 1       ! Initialization to the number of w ocean point (=2 over land) 
     333         DO_3DS( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpkm1, 2, -1 ) 
    334334            IF( zpelc(ji,jj,jk) > zWlc2(ji,jj) )   imlc(ji,jj) = jk 
    335335         END_3D 
    336336         !                               ! finite LC depth 
    337          DO_2D( 1, 1, 1, 1 ) 
     337         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    338338            zhlc(ji,jj) = gdepw(ji,jj,imlc(ji,jj),Kmm) 
    339339         END_2D 
    340340         ! 
    341341         zcof = 0.016 / SQRT( zrhoa * zcdrag ) 
    342          DO_2D( 0, 0, 0, 0 ) 
     342         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    343343            zus = SQRT( 2. * zWlc2(ji,jj) )             ! Stokes drift 
    344344            zus3(ji,jj) = MAX( 0._wp, 1._wp - zice_fra(ji,jj) ) * zus * zus * zus * tmask(ji,jj,1) ! zus > 0. ok 
    345345         END_2D 
    346          DO_3D( 0, 0, 0, 0, 2, jpkm1 )                  !* TKE Langmuir circulation source term added to en 
     346         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )                  !* TKE Langmuir circulation source term added to en 
    347347            IF ( zus3(ji,jj) /= 0._wp ) THEN 
    348348               IF ( gdepw(ji,jj,jk,Kmm) - zhlc(ji,jj) < 0 .AND. wmask(ji,jj,jk) /= 0. ) THEN 
     
    365365      ! 
    366366      IF( nn_pdl == 1 ) THEN          !* Prandtl number = F( Ri ) 
    367          DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     367         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    368368            !                             ! local Richardson number 
    369369            IF (rn2b(ji,jj,jk) <= 0.0_wp) then 
     
    377377      ENDIF 
    378378      ! 
    379       DO_3D( 0, 0, 0, 0, 2, jpkm1 )   !* Matrix and right hand side in en 
     379      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )   !* Matrix and right hand side in en 
    380380         zcof   = zfact1 * tmask(ji,jj,jk) 
    381381         !                                   ! A minimum of 2.e-5 m2/s is imposed on TKE vertical 
     
    406406 
    407407         CASE ( 0 ) ! Dirichlet BC 
    408             DO_2D( 0, 0, 0, 0 )    ! en(1)   = rn_ebb taum / rho0  (min value rn_emin0) 
     408            DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )    ! en(1)   = rn_ebb taum / rho0  (min value rn_emin0) 
    409409               IF ( phioc(ji,jj) < 0 )  phioc(ji,jj) = 0._wp 
    410410               en(ji,jj,1) = MAX( rn_emin0, .5 * ( 15.8 * phioc(ji,jj) / rho0 )**(2./3.) )  * tmask(ji,jj,1) 
     
    413413 
    414414         CASE ( 1 ) ! Neumann BC 
    415             DO_2D( 0, 0, 0, 0 ) 
     415            DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    416416               IF ( phioc(ji,jj) < 0 )  phioc(ji,jj) = 0._wp 
    417417               en(ji,jj,2)    = en(ji,jj,2) + ( rn_Dt * phioc(ji,jj) / rho0 ) /e3w(ji,jj,2,Kmm) 
     
    427427      ! 
    428428      !                          !* Matrix inversion from level 2 (tke prescribed at level 1) 
    429       DO_3D( 0, 0, 0, 0, 2, jpkm1 )                ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 
     429      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )                ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 
    430430         zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1) 
    431431      END_3D 
     
    434434!         zd_lw(ji,jj,2) = en(ji,jj,2) - zd_lw(ji,jj,2) * en(ji,jj,1)    ! Surface boudary conditions on tke 
    435435!      END_2D 
    436       DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     436      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    437437         zd_lw(ji,jj,jk) = en(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) *zd_lw(ji,jj,jk-1) 
    438438      END_3D 
    439       DO_2D( 0, 0, 0, 0 )                          ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 
     439      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )                          ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 
    440440         en(ji,jj,jpkm1) = zd_lw(ji,jj,jpkm1) / zdiag(ji,jj,jpkm1) 
    441441      END_2D 
    442       DO_3DS( 0, 0, 0, 0, jpk-2, 2, -1 ) 
     442      DO_3DS_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpk-2, 2, -1 ) 
    443443         en(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * en(ji,jj,jk+1) ) / zdiag(ji,jj,jk) 
    444444      END_3D 
    445       DO_3D( 0, 0, 0, 0, 2, jpkm1 )                ! set the minimum value of tke 
     445      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )                ! set the minimum value of tke 
    446446         en(ji,jj,jk) = MAX( en(ji,jj,jk), rn_emin ) * wmask(ji,jj,jk) 
    447447      END_3D 
     
    456456      ! 
    457457      IF( nn_etau == 1 ) THEN           !* penetration below the mixed layer (rn_efr fraction) 
    458          DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     458         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    459459            en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -gdepw(ji,jj,jk,Kmm) / htau(ji,jj) )   & 
    460460               &                                 * MAX( 0._wp, 1._wp - zice_fra(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 
    461461         END_3D 
    462462      ELSEIF( nn_etau == 2 ) THEN       !* act only at the base of the mixed layer (jk=nmln)  (rn_efr fraction) 
    463          DO_2D( 0, 0, 0, 0 ) 
     463         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    464464            jk = nmln(ji,jj) 
    465465            en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -gdepw(ji,jj,jk,Kmm) / htau(ji,jj) )   & 
     
    467467         END_2D 
    468468      ELSEIF( nn_etau == 3 ) THEN       !* penetration belox the mixed layer (HF variability) 
    469          DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     469         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    470470            ztx2 = utau(ji-1,jj  ) + utau(ji,jj) 
    471471            zty2 = vtau(ji  ,jj-1) + vtau(ji,jj) 
     
    524524      REAL(wp) ::   zdku,   zdkv, zsqen       !   -      - 
    525525      REAL(wp) ::   zemxl, zemlm, zemlp, zmaxice       !   -      - 
    526       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zmxlm, zmxld   ! 3D workspace 
     526      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zmxlm, zmxld   ! 3D workspace 
    527527      !!-------------------------------------------------------------------- 
    528528      ! 
     
    548548            zraug = vkarmn * 2.e5_wp / ( rho0 * grav ) 
    549549#if ! defined key_si3 && ! defined key_cice 
    550             DO_2D( 0, 0, 0, 0 )                  ! No sea-ice 
     550            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )                  ! No sea-ice 
    551551               zmxlm(ji,jj,1) =  zraug * taum(ji,jj) * tmask(ji,jj,1) 
    552552            END_2D 
     
    555555            ! 
    556556            CASE( 0 )                      ! No scaling under sea-ice 
    557                DO_2D( 0, 0, 0, 0 ) 
     557               DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    558558                  zmxlm(ji,jj,1) = zraug * taum(ji,jj) * tmask(ji,jj,1) 
    559559               END_2D 
    560560               ! 
    561561            CASE( 1 )                      ! scaling with constant sea-ice thickness 
    562                DO_2D( 0, 0, 0, 0 ) 
     562               DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    563563                  zmxlm(ji,jj,1) =  ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 
    564564                     &                          fr_i(ji,jj)   * rn_mxlice           ) * tmask(ji,jj,1) 
     
    566566               ! 
    567567            CASE( 2 )                      ! scaling with mean sea-ice thickness 
    568                DO_2D( 0, 0, 0, 0 ) 
     568               DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    569569#if defined key_si3 
    570570                  zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 
     
    578578               ! 
    579579            CASE( 3 )                      ! scaling with max sea-ice thickness 
    580                DO_2D( 0, 0, 0, 0 ) 
     580               DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    581581                  zmaxice = MAXVAL( h_i(ji,jj,:) ) 
    582582                  zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 
     
    587587#endif 
    588588            ! 
    589             DO_2D( 0, 0, 0, 0 ) 
     589            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    590590               zmxlm(ji,jj,1) = MAX( rn_mxl0, zmxlm(ji,jj,1) ) 
    591591            END_2D 
     
    596596      ENDIF 
    597597      ! 
    598       DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     598      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    599599         zrn2 = MAX( rn2(ji,jj,jk), rsmall ) 
    600600         zmxlm(ji,jj,jk) = MAX(  rmxl_min,  SQRT( 2._wp * en(ji,jj,jk) / zrn2 )  ) 
     
    611611      ! where wmask = 0 set zmxlm == e3w(:,:,:,Kmm) 
    612612      CASE ( 0 )           ! bounded by the distance to surface and bottom 
    613          DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     613         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    614614            zemxl = MIN( gdepw(ji,jj,jk,Kmm) - gdepw(ji,jj,mikt(ji,jj),Kmm), zmxlm(ji,jj,jk),   & 
    615615            &            gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) - gdepw(ji,jj,jk,Kmm) ) 
     
    622622         ! 
    623623      CASE ( 1 )           ! bounded by the vertical scale factor 
    624          DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     624         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    625625            zemxl = MIN( e3w(ji,jj,jk,Kmm), zmxlm(ji,jj,jk) ) 
    626626            zmxlm(ji,jj,jk) = zemxl 
     
    629629         ! 
    630630      CASE ( 2 )           ! |dk[xml]| bounded by e3t : 
    631          DO_3D( 0, 0, 0, 0, 2, jpkm1 )        ! from the surface to the bottom : 
     631         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )       ! from the surface to the bottom : 
    632632            zmxlm(ji,jj,jk) =   & 
    633633               &    MIN( zmxlm(ji,jj,jk-1) + e3t(ji,jj,jk-1,Kmm), zmxlm(ji,jj,jk) ) 
    634634         END_3D 
    635          DO_3DS( 0, 0, 0, 0, jpkm1, 2, -1 )   ! from the bottom to the surface : 
     635         DO_3DS( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpkm1, 2, -1 )   ! from the bottom to the surface : 
    636636            zemxl = MIN( zmxlm(ji,jj,jk+1) + e3t(ji,jj,jk+1,Kmm), zmxlm(ji,jj,jk) ) 
    637637            zmxlm(ji,jj,jk) = zemxl 
     
    640640         ! 
    641641      CASE ( 3 )           ! lup and ldown, |dk[xml]| bounded by e3t : 
    642          DO_3D( 0, 0, 0, 0, 2, jpkm1 )        ! from the surface to the bottom : lup 
     642         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )        ! from the surface to the bottom : lup 
    643643            zmxld(ji,jj,jk) =    & 
    644644               &    MIN( zmxld(ji,jj,jk-1) + e3t(ji,jj,jk-1,Kmm), zmxlm(ji,jj,jk) ) 
    645645         END_3D 
    646          DO_3DS( 0, 0, 0, 0, jpkm1, 2, -1 )   ! from the bottom to the surface : ldown 
     646         DO_3DS( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpkm1, 2, -1 )   ! from the bottom to the surface : ldown 
    647647            zmxlm(ji,jj,jk) =   & 
    648648               &    MIN( zmxlm(ji,jj,jk+1) + e3t(ji,jj,jk+1,Kmm), zmxlm(ji,jj,jk) ) 
    649649         END_3D 
    650          DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     650         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    651651            zemlm = MIN ( zmxld(ji,jj,jk),  zmxlm(ji,jj,jk) ) 
    652652            zemlp = SQRT( zmxld(ji,jj,jk) * zmxlm(ji,jj,jk) ) 
     
    660660      !                     !  Vertical eddy viscosity and diffusivity  (avm and avt) 
    661661      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    662       DO_3D( 0, 0, 0, 0, 1, jpkm1 )   !* vertical eddy viscosity & diffivity at w-points 
     662      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )   !* vertical eddy viscosity & diffivity at w-points 
    663663         zsqen = SQRT( en(ji,jj,jk) ) 
    664664         zav   = rn_ediff * zmxlm(ji,jj,jk) * zsqen 
     
    670670      ! 
    671671      IF( nn_pdl == 1 ) THEN          !* Prandtl number case: update avt 
    672          DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     672         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    673673            p_avt(ji,jj,jk)   = MAX( apdlr(ji,jj,jk) * p_avt(ji,jj,jk), avtb_2d(ji,jj) * avtb(jk) ) * wmask(ji,jj,jk) 
    674674         END_3D 
     
    786786      ! 
    787787      !                               !* Check of some namelist values 
    788       IF( nn_mxl  < 0   .OR.  nn_mxl  > 3 )   CALL ctl_stop( 'bad flag: nn_mxl is  0, 1 or 2 ' ) 
    789       IF( nn_pdl  < 0   .OR.  nn_pdl  > 1 )   CALL ctl_stop( 'bad flag: nn_pdl is  0 or 1    ' ) 
    790       IF( nn_htau < 0   .OR.  nn_htau > 1 )   CALL ctl_stop( 'bad flag: nn_htau is 0, 1 or 2 ' ) 
     788      IF( nn_mxl  < 0   .OR.  nn_mxl  > 3 )   CALL ctl_stop( 'bad flag: nn_mxl is  0, 1, 2 or 3' ) 
     789      IF( nn_pdl  < 0   .OR.  nn_pdl  > 1 )   CALL ctl_stop( 'bad flag: nn_pdl is  0 or 1' ) 
     790      IF( nn_htau < 0   .OR.  nn_htau > 1 )   CALL ctl_stop( 'bad flag: nn_htau is 0 or 1' ) 
    791791      IF( nn_etau == 3 .AND. .NOT. ln_cpl )   CALL ctl_stop( 'nn_etau == 3 : HF taum only known in coupled mode' ) 
    792792      ! 
     
    796796         rn_mxl0 = rmxl_min 
    797797      ENDIF 
    798  
    799       IF( nn_etau == 2  )   CALL zdf_mxl( nit000, Kmm )      ! Initialization of nmln 
    800  
    801798      !                               !* depth of penetration of surface tke 
    802799      IF( nn_etau /= 0 ) THEN 
Note: See TracChangeset for help on using the changeset viewer.