Ignore:
Timestamp:
2020-02-12T15:39:06+01:00 (12 months ago)
Author:
acc
Message:

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge —ignore-ancestry \

svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The —ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

Location:
NEMO/trunk
Files:
13 edited

Legend:

Unmodified
Added
Removed
  • NEMO/trunk

    • Property svn:externals
      •  

        old new  
        33^/utils/build/mk@HEAD         mk 
        44^/utils/tools@HEAD            tools 
        5 ^/vendors/AGRIF/dev@HEAD      ext/AGRIF 
         5^/vendors/AGRIF/dev_r11615_ENHANCE-04_namelists_as_internalfiles_agrif@HEAD      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
  • NEMO/trunk/src/OCE/ZDF/zdfddm.F90

    r10068 r12377  
    3030 
    3131   !! * Substitutions 
    32 #  include "vectopt_loop_substitute.h90" 
     32#  include "do_loop_substitute.h90" 
    3333   !!---------------------------------------------------------------------- 
    3434   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    3838CONTAINS 
    3939 
    40    SUBROUTINE zdf_ddm( kt, p_avm, p_avt, p_avs ) 
     40   SUBROUTINE zdf_ddm( kt, Kmm, p_avm, p_avt, p_avs ) 
    4141      !!---------------------------------------------------------------------- 
    4242      !!                  ***  ROUTINE zdf_ddm  *** 
     
    6868      !! References :   Merryfield et al., JPO, 29, 1124-1142, 1999. 
    6969      !!---------------------------------------------------------------------- 
    70       INTEGER, INTENT(in   ) ::   kt       ! ocean time-step indexocean time step 
     70      INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index 
     71      INTEGER, INTENT(in   ) ::   Kmm      ! ocean time level index 
    7172      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   p_avm   !  Kz on momentum    (w-points) 
    7273      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   p_avt   !  Kz on temperature (w-points) 
     
    9192!!gm                            and many acces in memory 
    9293          
    93          DO jj = 1, jpj                !==  R=zrau = (alpha / beta) (dk[t] / dk[s])  ==! 
    94             DO ji = 1, jpi 
    95                zrw =   ( gdepw_n(ji,jj,jk  ) - gdept_n(ji,jj,jk) )   & 
    96 !!gm please, use e3w_n below  
    97                   &  / ( gdept_n(ji,jj,jk-1) - gdept_n(ji,jj,jk) )  
    98                ! 
    99                zaw = (  rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem) * zrw  )  & 
    100                    &    * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) 
    101                zbw = (  rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal) * zrw  )  & 
    102                    &    * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) 
    103                ! 
    104                zdt = zaw * ( tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) ) 
    105                zds = zbw * ( tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) )  
    106                IF( ABS( zds) <= 1.e-20_wp )   zds = 1.e-20_wp 
    107                zrau(ji,jj) = MAX(  1.e-20, zdt / zds  )    ! only retains positive value of zrau 
    108             END DO 
    109          END DO 
     94         DO_2D_11_11 
     95            zrw =   ( gdepw(ji,jj,jk  ,Kmm) - gdept(ji,jj,jk,Kmm) )   & 
     96!!gm please, use e3w(:,:,:,Kmm) below  
     97               &  / ( gdept(ji,jj,jk-1,Kmm) - gdept(ji,jj,jk,Kmm) )  
     98            ! 
     99            zaw = (  rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem) * zrw  )  & 
     100                &    * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) 
     101            zbw = (  rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal) * zrw  )  & 
     102                &    * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) 
     103            ! 
     104            zdt = zaw * ( ts(ji,jj,jk-1,jp_tem,Kmm) - ts(ji,jj,jk,jp_tem,Kmm) ) 
     105            zds = zbw * ( ts(ji,jj,jk-1,jp_sal,Kmm) - ts(ji,jj,jk,jp_sal,Kmm) )  
     106            IF( ABS( zds) <= 1.e-20_wp )   zds = 1.e-20_wp 
     107            zrau(ji,jj) = MAX(  1.e-20, zdt / zds  )    ! only retains positive value of zrau 
     108         END_2D 
    110109 
    111          DO jj = 1, jpj                !==  indicators  ==! 
    112             DO ji = 1, jpi 
    113                ! stability indicator: msks=1 if rn2>0; 0 elsewhere 
    114                IF( rn2(ji,jj,jk) + 1.e-12  <= 0. ) THEN   ;   zmsks(ji,jj) = 0._wp 
    115                ELSE                                       ;   zmsks(ji,jj) = 1._wp 
    116                ENDIF 
    117                ! salt fingering indicator: msksf=1 if R>1; 0 elsewhere             
    118                IF( zrau(ji,jj) <= 1.             ) THEN   ;   zmskf(ji,jj) = 0._wp 
    119                ELSE                                       ;   zmskf(ji,jj) = 1._wp 
    120                ENDIF 
    121                ! diffusive layering indicators:  
    122                !     ! mskdl1=1 if 0< R <1; 0 elsewhere 
    123                IF( zrau(ji,jj) >= 1.             ) THEN   ;   zmskd1(ji,jj) = 0._wp 
    124                ELSE                                       ;   zmskd1(ji,jj) = 1._wp 
    125                ENDIF 
    126                !     ! mskdl2=1 if 0< R <0.5; 0 elsewhere 
    127                IF( zrau(ji,jj) >= 0.5            ) THEN   ;   zmskd2(ji,jj) = 0._wp 
    128                ELSE                                       ;   zmskd2(ji,jj) = 1._wp 
    129                ENDIF 
    130                !   mskdl3=1 if 0.5< R <1; 0 elsewhere 
    131                IF( zrau(ji,jj) <= 0.5 .OR. zrau(ji,jj) >= 1. ) THEN   ;   zmskd3(ji,jj) = 0._wp 
    132                ELSE                                                   ;   zmskd3(ji,jj) = 1._wp 
    133                ENDIF 
    134             END DO 
    135          END DO 
     110         DO_2D_11_11 
     111            ! stability indicator: msks=1 if rn2>0; 0 elsewhere 
     112            IF( rn2(ji,jj,jk) + 1.e-12  <= 0. ) THEN   ;   zmsks(ji,jj) = 0._wp 
     113            ELSE                                       ;   zmsks(ji,jj) = 1._wp 
     114            ENDIF 
     115            ! salt fingering indicator: msksf=1 if R>1; 0 elsewhere             
     116            IF( zrau(ji,jj) <= 1.             ) THEN   ;   zmskf(ji,jj) = 0._wp 
     117            ELSE                                       ;   zmskf(ji,jj) = 1._wp 
     118            ENDIF 
     119            ! diffusive layering indicators:  
     120            !     ! mskdl1=1 if 0< R <1; 0 elsewhere 
     121            IF( zrau(ji,jj) >= 1.             ) THEN   ;   zmskd1(ji,jj) = 0._wp 
     122            ELSE                                       ;   zmskd1(ji,jj) = 1._wp 
     123            ENDIF 
     124            !     ! mskdl2=1 if 0< R <0.5; 0 elsewhere 
     125            IF( zrau(ji,jj) >= 0.5            ) THEN   ;   zmskd2(ji,jj) = 0._wp 
     126            ELSE                                       ;   zmskd2(ji,jj) = 1._wp 
     127            ENDIF 
     128            !   mskdl3=1 if 0.5< R <1; 0 elsewhere 
     129            IF( zrau(ji,jj) <= 0.5 .OR. zrau(ji,jj) >= 1. ) THEN   ;   zmskd3(ji,jj) = 0._wp 
     130            ELSE                                                   ;   zmskd3(ji,jj) = 1._wp 
     131            ENDIF 
     132         END_2D 
    136133         ! mask zmsk in order to have avt and avs masked 
    137134         zmsks(:,:) = zmsks(:,:) * wmask(:,:,jk) 
     
    141138         ! ------------------ 
    142139         ! Constant eddy coefficient: reset to the background value 
    143          DO jj = 1, jpj 
    144             DO ji = 1, jpi 
    145                zinr = 1._wp / zrau(ji,jj) 
    146                ! salt fingering 
    147                zrr = zrau(ji,jj) / rn_hsbfr 
    148                zrr = zrr * zrr 
    149                zavfs = rn_avts / ( 1 + zrr*zrr*zrr ) * zmsks(ji,jj) * zmskf(ji,jj) 
    150                zavft = 0.7 * zavfs * zinr 
    151                ! diffusive layering 
    152                zavdt = 1.3635e-6 * EXP(  4.6 * EXP( -0.54*(zinr-1.) )  ) * zmsks(ji,jj) * zmskd1(ji,jj) 
    153                zavds = zavdt * zmsks(ji,jj) * (  ( 1.85 * zrau(ji,jj) - 0.85 ) * zmskd3(ji,jj)   & 
    154                   &                             +  0.15 * zrau(ji,jj)          * zmskd2(ji,jj)  ) 
    155                ! add to the eddy viscosity coef. previously computed 
    156                p_avs(ji,jj,jk) = p_avt(ji,jj,jk) + zavfs + zavds 
    157                p_avt(ji,jj,jk) = p_avt(ji,jj,jk) + zavft + zavdt 
    158                p_avm(ji,jj,jk) = p_avm(ji,jj,jk) + MAX( zavft + zavdt, zavfs + zavds ) 
    159             END DO 
    160          END DO 
     140         DO_2D_11_11 
     141            zinr = 1._wp / zrau(ji,jj) 
     142            ! salt fingering 
     143            zrr = zrau(ji,jj) / rn_hsbfr 
     144            zrr = zrr * zrr 
     145            zavfs = rn_avts / ( 1 + zrr*zrr*zrr ) * zmsks(ji,jj) * zmskf(ji,jj) 
     146            zavft = 0.7 * zavfs * zinr 
     147            ! diffusive layering 
     148            zavdt = 1.3635e-6 * EXP(  4.6 * EXP( -0.54*(zinr-1.) )  ) * zmsks(ji,jj) * zmskd1(ji,jj) 
     149            zavds = zavdt * zmsks(ji,jj) * (  ( 1.85 * zrau(ji,jj) - 0.85 ) * zmskd3(ji,jj)   & 
     150               &                             +  0.15 * zrau(ji,jj)          * zmskd2(ji,jj)  ) 
     151            ! add to the eddy viscosity coef. previously computed 
     152            p_avs(ji,jj,jk) = p_avt(ji,jj,jk) + zavfs + zavds 
     153            p_avt(ji,jj,jk) = p_avt(ji,jj,jk) + zavft + zavdt 
     154            p_avm(ji,jj,jk) = p_avm(ji,jj,jk) + MAX( zavft + zavdt, zavfs + zavds ) 
     155         END_2D 
    161156         !                                                ! =============== 
    162157      END DO                                              !   End of slab 
    163158      !                                                   ! =============== 
    164159      ! 
    165       IF(ln_ctl) THEN 
     160      IF(sn_cfctl%l_prtctl) THEN 
    166161         CALL prt_ctl(tab3d_1=avt , clinfo1=' ddm  - t: ', tab3d_2=avs , clinfo2=' s: ', kdim=jpk) 
    167162      ENDIF 
  • NEMO/trunk/src/OCE/ZDF/zdfdrg.F90

    r11536 r12377  
    7373 
    7474   !! * Substitutions 
    75 #  include "vectopt_loop_substitute.h90" 
     75#  include "do_loop_substitute.h90" 
    7676   !!---------------------------------------------------------------------- 
    7777   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    8181CONTAINS 
    8282 
    83    SUBROUTINE zdf_drg( kt, k_mk, pCdmin, pCdmax, pz0, pke0, pCd0,   &   ! <<== in  
     83   SUBROUTINE zdf_drg( kt, Kmm, k_mk, pCdmin, pCdmax, pz0, pke0, pCd0,   &   ! <<== in  
    8484      &                                                     pCdU )      ! ==>> out : bottom drag [m/s] 
    8585      !!---------------------------------------------------------------------- 
     
    9999      !!---------------------------------------------------------------------- 
    100100      INTEGER                 , INTENT(in   ) ::   kt       ! ocean time-step index 
     101      INTEGER                 , INTENT(in   ) ::   Kmm      ! ocean time level index 
    101102      !                       !               !!         !==  top or bottom variables  ==! 
    102103      INTEGER , DIMENSION(:,:), INTENT(in   ) ::   k_mk     ! wet level (1st or last) 
     
    114115      ! 
    115116      IF( l_log_not_linssh ) THEN     !==  "log layer"  ==!   compute Cd and -Cd*|U| 
    116          DO jj = 2, jpjm1 
    117             DO ji = 2, jpim1 
    118                imk = k_mk(ji,jj)          ! ocean bottom level at t-points 
    119                zut = un(ji,jj,imk) + un(ji-1,jj,imk)     ! 2 x velocity at t-point 
    120                zvt = vn(ji,jj,imk) + vn(ji,jj-1,imk) 
    121                zzz = 0.5_wp * e3t_n(ji,jj,imk)           ! altitude below/above (top/bottom) the boundary 
    122                ! 
     117         DO_2D_00_00 
     118            imk = k_mk(ji,jj)          ! ocean bottom level at t-points 
     119            zut = uu(ji,jj,imk,Kmm) + uu(ji-1,jj,imk,Kmm)     ! 2 x velocity at t-point 
     120            zvt = vv(ji,jj,imk,Kmm) + vv(ji,jj-1,imk,Kmm) 
     121            zzz = 0.5_wp * e3t(ji,jj,imk,Kmm)           ! altitude below/above (top/bottom) the boundary 
     122            ! 
    123123!!JC: possible WAD implementation should modify line below if layers vanish 
    124                zcd = (  vkarmn / LOG( zzz / pz0 )  )**2 
    125                zcd = pCd0(ji,jj) * MIN(  MAX( pCdmin , zcd ) , pCdmax  )   ! here pCd0 = mask*boost 
    126                pCdU(ji,jj) = - zcd * SQRT(  0.25 * ( zut*zut + zvt*zvt ) + pke0  ) 
    127             END DO 
    128          END DO 
     124            zcd = (  vkarmn / LOG( zzz / pz0 )  )**2 
     125            zcd = pCd0(ji,jj) * MIN(  MAX( pCdmin , zcd ) , pCdmax  )   ! here pCd0 = mask*boost 
     126            pCdU(ji,jj) = - zcd * SQRT(  0.25 * ( zut*zut + zvt*zvt ) + pke0  ) 
     127         END_2D 
    129128      ELSE                                            !==  standard Cd  ==! 
    130          DO jj = 2, jpjm1 
    131             DO ji = 2, jpim1 
    132                imk = k_mk(ji,jj)    ! ocean bottom level at t-points 
    133                zut = un(ji,jj,imk) + un(ji-1,jj,imk)     ! 2 x velocity at t-point 
    134                zvt = vn(ji,jj,imk) + vn(ji,jj-1,imk) 
    135                !                                                           ! here pCd0 = mask*boost * drag 
    136                pCdU(ji,jj) = - pCd0(ji,jj) * SQRT(  0.25 * ( zut*zut + zvt*zvt ) + pke0  ) 
    137             END DO 
    138          END DO 
    139       ENDIF 
    140       ! 
    141       IF(ln_ctl)   CALL prt_ctl( tab2d_1=pCdU, clinfo1=' Cd*U ') 
     129         DO_2D_00_00 
     130            imk = k_mk(ji,jj)    ! ocean bottom level at t-points 
     131            zut = uu(ji,jj,imk,Kmm) + uu(ji-1,jj,imk,Kmm)     ! 2 x velocity at t-point 
     132            zvt = vv(ji,jj,imk,Kmm) + vv(ji,jj-1,imk,Kmm) 
     133            !                                                           ! here pCd0 = mask*boost * drag 
     134            pCdU(ji,jj) = - pCd0(ji,jj) * SQRT(  0.25 * ( zut*zut + zvt*zvt ) + pke0  ) 
     135         END_2D 
     136      ENDIF 
     137      ! 
     138      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab2d_1=pCdU, clinfo1=' Cd*U ') 
    142139      ! 
    143140   END SUBROUTINE zdf_drg 
    144141 
    145142 
    146    SUBROUTINE zdf_drg_exp( kt, pub, pvb, pua, pva ) 
     143   SUBROUTINE zdf_drg_exp( kt, Kmm, pub, pvb, pua, pva ) 
    147144      !!---------------------------------------------------------------------- 
    148145      !!                  ***  ROUTINE zdf_drg_exp  *** 
     
    157154      !!--------------------------------------------------------------------- 
    158155      INTEGER                         , INTENT(in   ) ::   kt         ! ocean time-step index 
     156      INTEGER                         , INTENT(in   ) ::   Kmm        ! time level indices 
    159157      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pub, pvb   ! the two components of the before velocity 
    160158      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pua, pva   ! the two components of the velocity tendency 
     
    176174      ENDIF 
    177175 
    178       DO jj = 2, jpjm1 
    179          DO ji = 2, jpim1 
    180             ikbu = mbku(ji,jj)          ! deepest wet ocean u- & v-levels 
    181             ikbv = mbkv(ji,jj) 
     176      DO_2D_00_00 
     177         ikbu = mbku(ji,jj)          ! deepest wet ocean u- & v-levels 
     178         ikbv = mbkv(ji,jj) 
     179         ! 
     180         ! Apply stability criteria on absolute value  : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt) 
     181         zCdu = 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) / e3u(ji,jj,ikbu,Kmm) 
     182         zCdv = 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) / e3v(ji,jj,ikbv,Kmm) 
     183         ! 
     184         pua(ji,jj,ikbu) = pua(ji,jj,ikbu) + MAX(  zCdu , zm1_2dt  ) * pub(ji,jj,ikbu) 
     185         pva(ji,jj,ikbv) = pva(ji,jj,ikbv) + MAX(  zCdv , zm1_2dt  ) * pvb(ji,jj,ikbv) 
     186      END_2D 
     187      ! 
     188      IF( ln_isfcav ) THEN        ! ocean cavities 
     189         DO_2D_00_00 
     190            ikbu = miku(ji,jj)          ! first wet ocean u- & v-levels 
     191            ikbv = mikv(ji,jj) 
    182192            ! 
    183193            ! Apply stability criteria on absolute value  : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt) 
    184             zCdu = 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) / e3u_n(ji,jj,ikbu) 
    185             zCdv = 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) / e3v_n(ji,jj,ikbv) 
     194            zCdu = 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / e3u(ji,jj,ikbu,Kmm)    ! NB: Cdtop masked 
     195            zCdv = 0.5*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) / e3v(ji,jj,ikbv,Kmm) 
    186196            ! 
    187197            pua(ji,jj,ikbu) = pua(ji,jj,ikbu) + MAX(  zCdu , zm1_2dt  ) * pub(ji,jj,ikbu) 
    188198            pva(ji,jj,ikbv) = pva(ji,jj,ikbv) + MAX(  zCdv , zm1_2dt  ) * pvb(ji,jj,ikbv) 
    189          END DO 
    190       END DO 
    191       ! 
    192       IF( ln_isfcav ) THEN        ! ocean cavities 
    193          DO jj = 2, jpjm1 
    194             DO ji = 2, jpim1 
    195                ikbu = miku(ji,jj)          ! first wet ocean u- & v-levels 
    196                ikbv = mikv(ji,jj) 
    197                ! 
    198                ! Apply stability criteria on absolute value  : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt) 
    199                zCdu = 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / e3u_n(ji,jj,ikbu)    ! NB: Cdtop masked 
    200                zCdv = 0.5*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) / e3v_n(ji,jj,ikbv) 
    201                ! 
    202                pua(ji,jj,ikbu) = pua(ji,jj,ikbu) + MAX(  zCdu , zm1_2dt  ) * pub(ji,jj,ikbu) 
    203                pva(ji,jj,ikbv) = pva(ji,jj,ikbv) + MAX(  zCdv , zm1_2dt  ) * pvb(ji,jj,ikbv) 
    204            END DO 
    205          END DO 
     199         END_2D 
    206200      ENDIF 
    207201      ! 
     
    209203         ztrdu(:,:,:) = pua(:,:,:) - ztrdu(:,:,:) 
    210204         ztrdv(:,:,:) = pva(:,:,:) - ztrdv(:,:,:) 
    211          CALL trd_dyn( ztrdu(:,:,:), ztrdv(:,:,:), jpdyn_bfr, kt ) 
     205         CALL trd_dyn( ztrdu(:,:,:), ztrdv(:,:,:), jpdyn_bfr, kt, Kmm ) 
    212206         DEALLOCATE( ztrdu, ztrdv ) 
    213207      ENDIF 
    214208      !                                          ! print mean trends (used for debugging) 
    215       IF(ln_ctl)   CALL prt_ctl( tab3d_1=pua, clinfo1=' bfr  - Ua: ', mask1=umask,               & 
    216          &                       tab3d_2=pva, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     209      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pua, clinfo1=' bfr  - Ua: ', mask1=umask,               & 
     210         &                                  tab3d_2=pva, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    217211      ! 
    218212   END SUBROUTINE zdf_drg_exp 
     
    236230      !                     !==  drag nature  ==! 
    237231      ! 
    238       REWIND( numnam_ref )                   ! Namelist namdrg in reference namelist 
    239232      READ  ( numnam_ref, namdrg, IOSTAT = ios, ERR = 901) 
    240233901   IF( ios /= 0 )   CALL ctl_nam( ios , 'namdrg in reference namelist' ) 
    241       REWIND( numnam_cfg )                   ! Namelist namdrg in configuration namelist 
    242234      READ  ( numnam_cfg, namdrg, IOSTAT = ios, ERR = 902 ) 
    243235902   IF( ios >  0 )   CALL ctl_nam( ios , 'namdrg in configuration namelist' ) 
     
    335327      !                          !==  read namlist  ==! 
    336328      ! 
    337       REWIND( numnam_ref )                   ! Namelist cl_namdrg in reference namelist 
    338329      IF(ll_top)   READ  ( numnam_ref, namdrg_top, IOSTAT = ios, ERR = 901) 
    339330      IF(ll_bot)   READ  ( numnam_ref, namdrg_bot, IOSTAT = ios, ERR = 901) 
    340331901   IF( ios /= 0 )   CALL ctl_nam( ios , TRIM(cl_namref) ) 
    341       REWIND( numnam_cfg )                   ! Namelist cd_namdrg in configuration namelist 
    342332      IF(ll_top)   READ  ( numnam_cfg, namdrg_top, IOSTAT = ios, ERR = 902 ) 
    343333      IF(ll_bot)   READ  ( numnam_cfg, namdrg_bot, IOSTAT = ios, ERR = 902 ) 
     
    431421            l_log_not_linssh = .FALSE.    !- don't update Cd at each time step 
    432422            ! 
    433             DO jj = 1, jpj                   ! pCd0 = mask (and boosted) logarithmic drag coef.  
    434                DO ji = 1, jpi 
    435                   zzz =  0.5_wp * e3t_0(ji,jj,k_mk(ji,jj)) 
    436                   zcd = (  vkarmn / LOG( zzz / rn_z0 )  )**2 
    437                   pCd0(ji,jj) = zmsk_boost(ji,jj) * MIN(  MAX( rn_Cd0 , zcd ) , rn_Cdmax  )  ! rn_Cd0 < Cd0 < rn_Cdmax 
    438                END DO 
    439             END DO 
     423            DO_2D_11_11 
     424               zzz =  0.5_wp * e3t_0(ji,jj,k_mk(ji,jj)) 
     425               zcd = (  vkarmn / LOG( zzz / rn_z0 )  )**2 
     426               pCd0(ji,jj) = zmsk_boost(ji,jj) * MIN(  MAX( rn_Cd0 , zcd ) , rn_Cdmax  )  ! rn_Cd0 < Cd0 < rn_Cdmax 
     427            END_2D 
    440428         ELSE                       !* Cd updated at each time-step ==> pCd0 = mask * boost 
    441429            IF(lwp) WRITE(numout,*) 
  • NEMO/trunk/src/OCE/ZDF/zdfevd.F90

    r10068 r12377  
    3131   PUBLIC   zdf_evd    ! called by step.F90 
    3232 
     33   !! * Substitutions 
     34#  include "do_loop_substitute.h90" 
    3335   !!---------------------------------------------------------------------- 
    3436   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    3840CONTAINS 
    3941 
    40    SUBROUTINE zdf_evd( kt, p_avm, p_avt ) 
     42   SUBROUTINE zdf_evd( kt, Kmm, Krhs, p_avm, p_avt ) 
    4143      !!---------------------------------------------------------------------- 
    4244      !!                  ***  ROUTINE zdf_evd  *** 
     
    5658      !!---------------------------------------------------------------------- 
    5759      INTEGER                    , INTENT(in   ) ::   kt             ! ocean time-step indexocean time step 
     60      INTEGER                    , INTENT(in   ) ::   Kmm, Krhs      ! time level indices 
    5861      REAL(wp), DIMENSION(:,:,:) , INTENT(inout) ::   p_avm, p_avt   !  momentum and tracer Kz (w-points) 
    5962      ! 
     
    8487!         END WHERE 
    8588         ! 
    86          DO jk = 1, jpkm1  
    87             DO jj = 2, jpjm1 
    88                DO ji = 2, jpim1 
    89                   IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) THEN 
    90                      p_avt(ji,jj,jk) = rn_evd * wmask(ji,jj,jk) 
    91                      p_avm(ji,jj,jk) = rn_evd * wmask(ji,jj,jk) 
    92                   ENDIF 
    93                END DO 
    94             END DO 
    95          END DO  
     89         DO_3D_00_00( 1, jpkm1 ) 
     90            IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) THEN 
     91               p_avt(ji,jj,jk) = rn_evd * wmask(ji,jj,jk) 
     92               p_avm(ji,jj,jk) = rn_evd * wmask(ji,jj,jk) 
     93            ENDIF 
     94         END_3D 
    9695         ! 
    9796         zavm_evd(:,:,:) = p_avm(:,:,:) - zavm_evd(:,:,:)   ! change in avm due to evd 
     
    104103!         END WHERE 
    105104 
    106          DO jk = 1, jpkm1 
    107             DO jj = 2, jpjm1 
    108                DO ji = 2, jpim1 
    109                   IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 )   & 
    110                      p_avt(ji,jj,jk) = rn_evd * wmask(ji,jj,jk) 
    111                END DO 
    112             END DO 
    113          END DO 
     105         DO_3D_00_00( 1, jpkm1 ) 
     106            IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 )   & 
     107               p_avt(ji,jj,jk) = rn_evd * wmask(ji,jj,jk) 
     108         END_3D 
    114109         ! 
    115110      END SELECT  
     
    117112      zavt_evd(:,:,:) = p_avt(:,:,:) - zavt_evd(:,:,:)   ! change in avt due to evd 
    118113      CALL iom_put( "avt_evd", zavt_evd )              ! output this change 
    119       IF( l_trdtra ) CALL trd_tra( kt, 'TRA', jp_tem, jptra_evd, zavt_evd ) 
     114      IF( l_trdtra ) CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_evd, zavt_evd ) 
    120115      ! 
    121116   END SUBROUTINE zdf_evd 
  • NEMO/trunk/src/OCE/ZDF/zdfgls.F90

    r11536 r12377  
    104104 
    105105   !! * Substitutions 
    106 #  include "vectopt_loop_substitute.h90" 
     106#  include "do_loop_substitute.h90" 
    107107   !!---------------------------------------------------------------------- 
    108108   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    124124 
    125125 
    126    SUBROUTINE zdf_gls( kt, p_sh2, p_avm, p_avt ) 
     126   SUBROUTINE zdf_gls( kt, Kbb, Kmm, p_sh2, p_avm, p_avt ) 
    127127      !!---------------------------------------------------------------------- 
    128128      !!                   ***  ROUTINE zdf_gls  *** 
     
    134134      !! 
    135135      INTEGER                   , INTENT(in   ) ::   kt             ! ocean time step 
     136      INTEGER                   , INTENT(in   ) ::   Kbb, Kmm       ! ocean time level indices 
    136137      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   p_sh2          ! shear production term 
    137138      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   p_avm, p_avt   !  momentum and tracer Kz (w-points) 
     
    166167 
    167168      ! Compute surface, top and bottom friction at T-points 
    168       DO jj = 2, jpjm1           
    169          DO ji = fs_2, fs_jpim1   ! vector opt.          
    170             ! 
    171             ! surface friction 
    172             ustar2_surf(ji,jj) = r1_rau0 * taum(ji,jj) * tmask(ji,jj,1) 
    173             !    
     169      DO_2D_00_00 
     170         ! 
     171         ! surface friction 
     172         ustar2_surf(ji,jj) = r1_rau0 * taum(ji,jj) * tmask(ji,jj,1) 
     173         !    
    174174!!gm Rq we may add here r_ke0(_top/_bot) ?  ==>> think about that... 
    175           ! bottom friction (explicit before friction) 
    176           zmsku = ( 2._wp - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) ) 
    177           zmskv = ( 2._wp - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) )     ! (CAUTION: CdU<0) 
    178           ustar2_bot(ji,jj) = - rCdU_bot(ji,jj) * SQRT(  ( zmsku*( ub(ji,jj,mbkt(ji,jj))+ub(ji-1,jj,mbkt(ji,jj)) ) )**2  & 
    179              &                                         + ( zmskv*( vb(ji,jj,mbkt(ji,jj))+vb(ji,jj-1,mbkt(ji,jj)) ) )**2  ) 
    180          END DO 
    181       END DO 
     175       ! bottom friction (explicit before friction) 
     176       zmsku = ( 2._wp - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) ) 
     177       zmskv = ( 2._wp - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) )     ! (CAUTION: CdU<0) 
     178       ustar2_bot(ji,jj) = - rCdU_bot(ji,jj) * SQRT(  ( zmsku*( uu(ji,jj,mbkt(ji,jj),Kbb)+uu(ji-1,jj,mbkt(ji,jj),Kbb) ) )**2  & 
     179          &                                         + ( zmskv*( vv(ji,jj,mbkt(ji,jj),Kbb)+vv(ji,jj-1,mbkt(ji,jj),Kbb) ) )**2  ) 
     180      END_2D 
    182181      IF( ln_isfcav ) THEN       !top friction 
    183          DO jj = 2, jpjm1 
    184             DO ji = fs_2, fs_jpim1   ! vector opt. 
    185                zmsku = ( 2. - umask(ji-1,jj,mikt(ji,jj)) * umask(ji,jj,mikt(ji,jj)) ) 
    186                zmskv = ( 2. - vmask(ji,jj-1,mikt(ji,jj)) * vmask(ji,jj,mikt(ji,jj)) )     ! (CAUTION: CdU<0) 
    187                ustar2_top(ji,jj) = - rCdU_top(ji,jj) * SQRT(  ( zmsku*( ub(ji,jj,mikt(ji,jj))+ub(ji-1,jj,mikt(ji,jj)) ) )**2  & 
    188                   &                                         + ( zmskv*( vb(ji,jj,mikt(ji,jj))+vb(ji,jj-1,mikt(ji,jj)) ) )**2  ) 
    189             END DO 
    190          END DO 
     182         DO_2D_00_00 
     183            zmsku = ( 2. - umask(ji-1,jj,mikt(ji,jj)) * umask(ji,jj,mikt(ji,jj)) ) 
     184            zmskv = ( 2. - vmask(ji,jj-1,mikt(ji,jj)) * vmask(ji,jj,mikt(ji,jj)) )     ! (CAUTION: CdU<0) 
     185            ustar2_top(ji,jj) = - rCdU_top(ji,jj) * SQRT(  ( zmsku*( uu(ji,jj,mikt(ji,jj),Kbb)+uu(ji-1,jj,mikt(ji,jj),Kbb) ) )**2  & 
     186               &                                         + ( zmskv*( vv(ji,jj,mikt(ji,jj),Kbb)+vv(ji,jj-1,mikt(ji,jj),Kbb) ) )**2  ) 
     187         END_2D 
    191188      ENDIF 
    192189    
     
    206203      END SELECT 
    207204      ! 
    208       DO jk = 2, jpkm1              !==  Compute dissipation rate  ==! 
    209          DO jj = 1, jpjm1 
    210             DO ji = 1, jpim1 
    211                eps(ji,jj,jk)  = rc03 * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / hmxl_n(ji,jj,jk) 
    212             END DO 
    213          END DO 
    214       END DO 
     205      DO_3D_10_10( 2, jpkm1 ) 
     206         eps(ji,jj,jk)  = rc03 * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / hmxl_n(ji,jj,jk) 
     207      END_3D 
    215208 
    216209      ! Save tke at before time step 
     
    219212 
    220213      IF( nn_clos == 0 ) THEN    ! Mellor-Yamada 
    221          DO jk = 2, jpkm1 
    222             DO jj = 2, jpjm1  
    223                DO ji = fs_2, fs_jpim1   ! vector opt. 
    224                   zup   = hmxl_n(ji,jj,jk) * gdepw_n(ji,jj,mbkt(ji,jj)+1) 
    225                   zdown = vkarmn * gdepw_n(ji,jj,jk) * ( -gdepw_n(ji,jj,jk) + gdepw_n(ji,jj,mbkt(ji,jj)+1) ) 
    226                   zcoef = ( zup / MAX( zdown, rsmall ) ) 
    227                   zwall (ji,jj,jk) = ( 1._wp + re2 * zcoef*zcoef ) * tmask(ji,jj,jk) 
    228                END DO 
    229             END DO 
    230          END DO 
     214         DO_3D_00_00( 2, jpkm1 ) 
     215            zup   = hmxl_n(ji,jj,jk) * gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) 
     216            zdown = vkarmn * gdepw(ji,jj,jk,Kmm) * ( -gdepw(ji,jj,jk,Kmm) + gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) ) 
     217            zcoef = ( zup / MAX( zdown, rsmall ) ) 
     218            zwall (ji,jj,jk) = ( 1._wp + re2 * zcoef*zcoef ) * tmask(ji,jj,jk) 
     219         END_3D 
    231220      ENDIF 
    232221 
     
    244233      ! Warning : after this step, en : right hand side of the matrix 
    245234 
    246       DO jk = 2, jpkm1 
    247          DO jj = 2, jpjm1 
    248             DO ji = 2, jpim1 
    249                ! 
    250                buoy = - p_avt(ji,jj,jk) * rn2(ji,jj,jk)     ! stratif. destruction 
    251                ! 
    252                diss = eps(ji,jj,jk)                         ! dissipation 
    253                ! 
    254                zdir = 0.5_wp + SIGN( 0.5_wp, p_sh2(ji,jj,jk) + buoy )   ! zdir =1(=0) if shear(ji,jj,jk)+buoy >0(<0) 
    255                ! 
    256                zesh2 = zdir*(p_sh2(ji,jj,jk)+buoy)+(1._wp-zdir)*p_sh2(ji,jj,jk)          ! production term 
    257                zdiss = zdir*(diss/en(ji,jj,jk))   +(1._wp-zdir)*(diss-buoy)/en(ji,jj,jk) ! dissipation term 
     235      DO_3D_00_00( 2, jpkm1 ) 
     236         ! 
     237         buoy = - p_avt(ji,jj,jk) * rn2(ji,jj,jk)     ! stratif. destruction 
     238         ! 
     239         diss = eps(ji,jj,jk)                         ! dissipation 
     240         ! 
     241         zdir = 0.5_wp + SIGN( 0.5_wp, p_sh2(ji,jj,jk) + buoy )   ! zdir =1(=0) if shear(ji,jj,jk)+buoy >0(<0) 
     242         ! 
     243         zesh2 = zdir*(p_sh2(ji,jj,jk)+buoy)+(1._wp-zdir)*p_sh2(ji,jj,jk)          ! production term 
     244         zdiss = zdir*(diss/en(ji,jj,jk))   +(1._wp-zdir)*(diss-buoy)/en(ji,jj,jk) ! dissipation term 
    258245!!gm better coding, identical results 
    259246!               zesh2 =   p_sh2(ji,jj,jk) + zdir*buoy               ! production term 
    260247!               zdiss = ( diss - (1._wp-zdir)*buoy ) / en(ji,jj,jk) ! dissipation term 
    261248!!gm 
    262                ! 
    263                ! Compute a wall function from 1. to rsc_psi*zwall/rsc_psi0 
    264                ! Note that as long that Dirichlet boundary conditions are NOT set at the first and last levels (GOTM style) 
    265                ! there is no need to set a boundary condition for zwall_psi at the top and bottom boundaries. 
    266                ! Otherwise, this should be rsc_psi/rsc_psi0 
    267                IF( ln_sigpsi ) THEN 
    268                   zsigpsi = MIN( 1._wp, zesh2 / eps(ji,jj,jk) )     ! 0. <= zsigpsi <= 1. 
    269                   zwall_psi(ji,jj,jk) = rsc_psi /   &  
    270                      &     (  zsigpsi * rsc_psi + (1._wp-zsigpsi) * rsc_psi0 / MAX( zwall(ji,jj,jk), 1._wp )  ) 
    271                ELSE 
    272                   zwall_psi(ji,jj,jk) = 1._wp 
    273                ENDIF 
    274                ! 
    275                ! building the matrix 
    276                zcof = rfact_tke * tmask(ji,jj,jk) 
    277                !                                        ! lower diagonal, in fact not used for jk = 2 (see surface conditions) 
    278                zd_lw(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk  ) + p_avm(ji,jj,jk-1) ) / ( e3t_n(ji,jj,jk-1) * e3w_n(ji,jj,jk) ) 
    279                !                                        ! upper diagonal, in fact not used for jk = ibotm1 (see bottom conditions) 
    280                zd_up(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk+1) + p_avm(ji,jj,jk  ) ) / ( e3t_n(ji,jj,jk  ) * e3w_n(ji,jj,jk) ) 
    281                !                                        ! diagonal 
    282                zdiag(ji,jj,jk) = 1._wp - zd_lw(ji,jj,jk) - zd_up(ji,jj,jk)  + rdt * zdiss * wmask(ji,jj,jk)  
    283                !                                        ! right hand side in en 
    284                en(ji,jj,jk) = en(ji,jj,jk) + rdt * zesh2 * wmask(ji,jj,jk) 
    285             END DO 
    286          END DO 
    287       END DO 
     249         ! 
     250         ! Compute a wall function from 1. to rsc_psi*zwall/rsc_psi0 
     251         ! Note that as long that Dirichlet boundary conditions are NOT set at the first and last levels (GOTM style) 
     252         ! there is no need to set a boundary condition for zwall_psi at the top and bottom boundaries. 
     253         ! Otherwise, this should be rsc_psi/rsc_psi0 
     254         IF( ln_sigpsi ) THEN 
     255            zsigpsi = MIN( 1._wp, zesh2 / eps(ji,jj,jk) )     ! 0. <= zsigpsi <= 1. 
     256            zwall_psi(ji,jj,jk) = rsc_psi /   &  
     257               &     (  zsigpsi * rsc_psi + (1._wp-zsigpsi) * rsc_psi0 / MAX( zwall(ji,jj,jk), 1._wp )  ) 
     258         ELSE 
     259            zwall_psi(ji,jj,jk) = 1._wp 
     260         ENDIF 
     261         ! 
     262         ! building the matrix 
     263         zcof = rfact_tke * tmask(ji,jj,jk) 
     264         !                                        ! lower diagonal, in fact not used for jk = 2 (see surface conditions) 
     265         zd_lw(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk  ) + p_avm(ji,jj,jk-1) ) / ( e3t(ji,jj,jk-1,Kmm) * e3w(ji,jj,jk,Kmm) ) 
     266         !                                        ! upper diagonal, in fact not used for jk = ibotm1 (see bottom conditions) 
     267         zd_up(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk+1) + p_avm(ji,jj,jk  ) ) / ( e3t(ji,jj,jk  ,Kmm) * e3w(ji,jj,jk,Kmm) ) 
     268         !                                        ! diagonal 
     269         zdiag(ji,jj,jk) = 1._wp - zd_lw(ji,jj,jk) - zd_up(ji,jj,jk)  + rdt * zdiss * wmask(ji,jj,jk)  
     270         !                                        ! right hand side in en 
     271         en(ji,jj,jk) = en(ji,jj,jk) + rdt * zesh2 * wmask(ji,jj,jk) 
     272      END_3D 
    288273      ! 
    289274      zdiag(:,:,jpk) = 1._wp 
     
    306291      !  
    307292      ! One level below 
    308       en   (:,:,2) =  MAX(  rc02r * ustar2_surf(:,:) * (  1._wp + rsbc_tke1 * ((zhsro(:,:)+gdepw_n(:,:,2))   & 
     293      en   (:,:,2) =  MAX(  rc02r * ustar2_surf(:,:) * (  1._wp + rsbc_tke1 * ((zhsro(:,:)+gdepw(:,:,2,Kmm))   & 
    309294         &                 / zhsro(:,:) )**(1.5_wp*ra_sf)  )**(2._wp/3._wp)                      , rn_emin   ) 
    310295      zd_lw(:,:,2) = 0._wp  
     
    325310      zdiag(:,:,2) = zdiag(:,:,2) +  zd_lw(:,:,2) ! Remove zd_lw from zdiag 
    326311      zd_lw(:,:,2) = 0._wp 
    327       zkar (:,:)   = (rl_sf + (vkarmn-rl_sf)*(1.-EXP(-rtrans*gdept_n(:,:,1)/zhsro(:,:)) )) 
     312      zkar (:,:)   = (rl_sf + (vkarmn-rl_sf)*(1.-EXP(-rtrans*gdept(:,:,1,Kmm)/zhsro(:,:)) )) 
    328313      zflxs(:,:)   = rsbc_tke2 * ustar2_surf(:,:)**1.5_wp * zkar(:,:) & 
    329           &                    * (  ( zhsro(:,:)+gdept_n(:,:,1) ) / zhsro(:,:)  )**(1.5_wp*ra_sf) 
    330 !!gm why not   :                        * ( 1._wp + gdept_n(:,:,1) / zhsro(:,:) )**(1.5_wp*ra_sf) 
    331       en(:,:,2) = en(:,:,2) + zflxs(:,:) / e3w_n(:,:,2) 
     314          &                    * (  ( zhsro(:,:)+gdept(:,:,1,Kmm) ) / zhsro(:,:)  )**(1.5_wp*ra_sf) 
     315!!gm why not   :                        * ( 1._wp + gdept(:,:,1,Kmm) / zhsro(:,:) )**(1.5_wp*ra_sf) 
     316      en(:,:,2) = en(:,:,2) + zflxs(:,:) / e3w(:,:,2,Kmm) 
    332317      ! 
    333318      ! 
     
    342327         !                      ! en(ibot) = u*^2 / Co2 and hmxl_n(ibot) = rn_lmin 
    343328         !                      ! Balance between the production and the dissipation terms 
    344          DO jj = 2, jpjm1 
    345             DO ji = fs_2, fs_jpim1   ! vector opt. 
     329         DO_2D_00_00 
    346330!!gm This means that bottom and ocean w-level above have a specified "en" value.   Sure ???? 
    347331!!   With thick deep ocean level thickness, this may be quite large, no ??? 
    348332!!   in particular in ocean cavities where top stratification can be large... 
    349                ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point 
    350                ibotm1 = mbkt(ji,jj)          ! k-1 bottom level of w-point but >=1 
     333            ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point 
     334            ibotm1 = mbkt(ji,jj)          ! k-1 bottom level of w-point but >=1 
     335            ! 
     336            z_en =  MAX( rc02r * ustar2_bot(ji,jj), rn_emin ) 
     337            ! 
     338            ! Dirichlet condition applied at:  
     339            !     Bottom level (ibot)      &      Just above it (ibotm1)    
     340            zd_lw(ji,jj,ibot) = 0._wp   ;   zd_lw(ji,jj,ibotm1) = 0._wp 
     341            zd_up(ji,jj,ibot) = 0._wp   ;   zd_up(ji,jj,ibotm1) = 0._wp 
     342            zdiag(ji,jj,ibot) = 1._wp   ;   zdiag(ji,jj,ibotm1) = 1._wp 
     343            en   (ji,jj,ibot) = z_en    ;   en   (ji,jj,ibotm1) = z_en 
     344         END_2D 
     345         ! 
     346         IF( ln_isfcav) THEN     ! top boundary   (ocean cavity) 
     347            DO_2D_00_00 
     348               itop   = mikt(ji,jj)       ! k   top w-point 
     349               itopp1 = mikt(ji,jj) + 1   ! k+1 1st w-point below the top one 
     350               !                                                ! mask at the ocean surface points 
     351               z_en = MAX( rc02r * ustar2_top(ji,jj), rn_emin ) * ( 1._wp - tmask(ji,jj,1) ) 
    351352               ! 
    352                z_en =  MAX( rc02r * ustar2_bot(ji,jj), rn_emin ) 
    353                ! 
     353 !!gm TO BE VERIFIED !!! 
    354354               ! Dirichlet condition applied at:  
    355                !     Bottom level (ibot)      &      Just above it (ibotm1)    
    356                zd_lw(ji,jj,ibot) = 0._wp   ;   zd_lw(ji,jj,ibotm1) = 0._wp 
    357                zd_up(ji,jj,ibot) = 0._wp   ;   zd_up(ji,jj,ibotm1) = 0._wp 
    358                zdiag(ji,jj,ibot) = 1._wp   ;   zdiag(ji,jj,ibotm1) = 1._wp 
    359                en   (ji,jj,ibot) = z_en    ;   en   (ji,jj,ibotm1) = z_en 
    360             END DO 
    361          END DO 
    362          ! 
    363          IF( ln_isfcav) THEN     ! top boundary   (ocean cavity) 
    364             DO jj = 2, jpjm1 
    365                DO ji = fs_2, fs_jpim1   ! vector opt. 
    366                   itop   = mikt(ji,jj)       ! k   top w-point 
    367                   itopp1 = mikt(ji,jj) + 1   ! k+1 1st w-point below the top one 
    368                   !                                                ! mask at the ocean surface points 
    369                   z_en = MAX( rc02r * ustar2_top(ji,jj), rn_emin ) * ( 1._wp - tmask(ji,jj,1) ) 
    370                   ! 
    371  !!gm TO BE VERIFIED !!! 
    372                   ! Dirichlet condition applied at:  
    373                   !     top level (itop)         &      Just below it (itopp1)    
    374                   zd_lw(ji,jj,itop) = 0._wp   ;   zd_lw(ji,jj,itopp1) = 0._wp 
    375                   zd_up(ji,jj,itop) = 0._wp   ;   zd_up(ji,jj,itopp1) = 0._wp 
    376                   zdiag(ji,jj,itop) = 1._wp   ;   zdiag(ji,jj,itopp1) = 1._wp 
    377                   en   (ji,jj,itop) = z_en    ;   en   (ji,jj,itopp1) = z_en 
    378                END DO 
    379             END DO 
     355               !     top level (itop)         &      Just below it (itopp1)    
     356               zd_lw(ji,jj,itop) = 0._wp   ;   zd_lw(ji,jj,itopp1) = 0._wp 
     357               zd_up(ji,jj,itop) = 0._wp   ;   zd_up(ji,jj,itopp1) = 0._wp 
     358               zdiag(ji,jj,itop) = 1._wp   ;   zdiag(ji,jj,itopp1) = 1._wp 
     359               en   (ji,jj,itop) = z_en    ;   en   (ji,jj,itopp1) = z_en 
     360            END_2D 
    380361         ENDIF 
    381362         ! 
    382363      CASE ( 1 )             ! Neumman boundary condition 
    383364         !                       
    384          DO jj = 2, jpjm1 
    385             DO ji = fs_2, fs_jpim1   ! vector opt. 
    386                ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point 
    387                ibotm1 = mbkt(ji,jj)          ! k-1 bottom level of w-point but >=1 
    388                ! 
    389                z_en =  MAX( rc02r * ustar2_bot(ji,jj), rn_emin ) 
     365         DO_2D_00_00 
     366            ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point 
     367            ibotm1 = mbkt(ji,jj)          ! k-1 bottom level of w-point but >=1 
     368            ! 
     369            z_en =  MAX( rc02r * ustar2_bot(ji,jj), rn_emin ) 
     370            ! 
     371            ! Bottom level Dirichlet condition: 
     372            !     Bottom level (ibot)      &      Just above it (ibotm1)    
     373            !         Dirichlet            !         Neumann 
     374            zd_lw(ji,jj,ibot) = 0._wp   !   ! Remove zd_up from zdiag 
     375            zdiag(ji,jj,ibot) = 1._wp   ;   zdiag(ji,jj,ibotm1) = zdiag(ji,jj,ibotm1) + zd_up(ji,jj,ibotm1) 
     376            zd_up(ji,jj,ibot) = 0._wp   ;   zd_up(ji,jj,ibotm1) = 0._wp 
     377         END_2D 
     378         IF( ln_isfcav) THEN     ! top boundary   (ocean cavity) 
     379            DO_2D_00_00 
     380               itop   = mikt(ji,jj)       ! k   top w-point 
     381               itopp1 = mikt(ji,jj) + 1   ! k+1 1st w-point below the top one 
     382               !                                                ! mask at the ocean surface points 
     383               z_en = MAX( rc02r * ustar2_top(ji,jj), rn_emin ) * ( 1._wp - tmask(ji,jj,1) ) 
    390384               ! 
    391385               ! Bottom level Dirichlet condition: 
    392386               !     Bottom level (ibot)      &      Just above it (ibotm1)    
    393387               !         Dirichlet            !         Neumann 
    394                zd_lw(ji,jj,ibot) = 0._wp   !   ! Remove zd_up from zdiag 
    395                zdiag(ji,jj,ibot) = 1._wp   ;   zdiag(ji,jj,ibotm1) = zdiag(ji,jj,ibotm1) + zd_up(ji,jj,ibotm1) 
    396                zd_up(ji,jj,ibot) = 0._wp   ;   zd_up(ji,jj,ibotm1) = 0._wp 
    397             END DO 
    398          END DO 
    399          IF( ln_isfcav) THEN     ! top boundary   (ocean cavity) 
    400             DO jj = 2, jpjm1 
    401                DO ji = fs_2, fs_jpim1   ! vector opt. 
    402                   itop   = mikt(ji,jj)       ! k   top w-point 
    403                   itopp1 = mikt(ji,jj) + 1   ! k+1 1st w-point below the top one 
    404                   !                                                ! mask at the ocean surface points 
    405                   z_en = MAX( rc02r * ustar2_top(ji,jj), rn_emin ) * ( 1._wp - tmask(ji,jj,1) ) 
    406                   ! 
    407                   ! Bottom level Dirichlet condition: 
    408                   !     Bottom level (ibot)      &      Just above it (ibotm1)    
    409                   !         Dirichlet            !         Neumann 
    410                   zd_lw(ji,jj,itop) = 0._wp   !   ! Remove zd_up from zdiag 
    411                   zdiag(ji,jj,itop) = 1._wp   ;   zdiag(ji,jj,itopp1) = zdiag(ji,jj,itopp1) + zd_up(ji,jj,itopp1) 
    412                   zd_up(ji,jj,itop) = 0._wp   ;   zd_up(ji,jj,itopp1) = 0._wp 
    413                END DO 
    414             END DO 
     388               zd_lw(ji,jj,itop) = 0._wp   !   ! Remove zd_up from zdiag 
     389               zdiag(ji,jj,itop) = 1._wp   ;   zdiag(ji,jj,itopp1) = zdiag(ji,jj,itopp1) + zd_up(ji,jj,itopp1) 
     390               zd_up(ji,jj,itop) = 0._wp   ;   zd_up(ji,jj,itopp1) = 0._wp 
     391            END_2D 
    415392         ENDIF 
    416393         ! 
     
    420397      ! ---------------------------------------------------------- 
    421398      ! 
    422       DO jk = 2, jpkm1                             ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 
    423          DO jj = 2, jpjm1 
    424             DO ji = fs_2, fs_jpim1    ! vector opt. 
    425                zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1) 
    426             END DO 
    427          END DO 
    428       END DO 
    429       DO jk = 2, jpk                               ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 
    430          DO jj = 2, jpjm1 
    431             DO ji = fs_2, fs_jpim1    ! vector opt. 
    432                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) 
    433             END DO 
    434          END DO 
    435       END DO 
    436       DO jk = jpk-1, 2, -1                         ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 
    437          DO jj = 2, jpjm1 
    438             DO ji = fs_2, fs_jpim1    ! vector opt. 
    439                en(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * en(ji,jj,jk+1) ) / zdiag(ji,jj,jk) 
    440             END DO 
    441          END DO 
    442       END DO 
     399      DO_3D_00_00( 2, jpkm1 ) 
     400         zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1) 
     401      END_3D 
     402      DO_3D_00_00( 2, jpk ) 
     403         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) 
     404      END_3D 
     405      DO_3DS_00_00( jpk-1, 2, -1 ) 
     406         en(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * en(ji,jj,jk+1) ) / zdiag(ji,jj,jk) 
     407      END_3D 
    443408      !                                            ! set the minimum value of tke  
    444409      en(:,:,:) = MAX( en(:,:,:), rn_emin ) 
     
    453418      ! 
    454419      CASE( 0 )               ! k-kl  (Mellor-Yamada) 
    455          DO jk = 2, jpkm1 
    456             DO jj = 2, jpjm1 
    457                DO ji = fs_2, fs_jpim1   ! vector opt. 
    458                   psi(ji,jj,jk)  = eb(ji,jj,jk) * hmxl_b(ji,jj,jk) 
    459                END DO 
    460             END DO 
    461          END DO 
     420         DO_3D_00_00( 2, jpkm1 ) 
     421            psi(ji,jj,jk)  = eb(ji,jj,jk) * hmxl_b(ji,jj,jk) 
     422         END_3D 
    462423         ! 
    463424      CASE( 1 )               ! k-eps 
    464          DO jk = 2, jpkm1 
    465             DO jj = 2, jpjm1 
    466                DO ji = fs_2, fs_jpim1   ! vector opt. 
    467                   psi(ji,jj,jk)  = eps(ji,jj,jk) 
    468                END DO 
    469             END DO 
    470          END DO 
     425         DO_3D_00_00( 2, jpkm1 ) 
     426            psi(ji,jj,jk)  = eps(ji,jj,jk) 
     427         END_3D 
    471428         ! 
    472429      CASE( 2 )               ! k-w 
    473          DO jk = 2, jpkm1 
    474             DO jj = 2, jpjm1 
    475                DO ji = fs_2, fs_jpim1   ! vector opt. 
    476                   psi(ji,jj,jk)  = SQRT( eb(ji,jj,jk) ) / ( rc0 * hmxl_b(ji,jj,jk) ) 
    477                END DO 
    478             END DO 
    479          END DO 
     430         DO_3D_00_00( 2, jpkm1 ) 
     431            psi(ji,jj,jk)  = SQRT( eb(ji,jj,jk) ) / ( rc0 * hmxl_b(ji,jj,jk) ) 
     432         END_3D 
    480433         ! 
    481434      CASE( 3 )               ! generic 
    482          DO jk = 2, jpkm1 
    483             DO jj = 2, jpjm1 
    484                DO ji = fs_2, fs_jpim1   ! vector opt. 
    485                   psi(ji,jj,jk)  = rc02 * eb(ji,jj,jk) * hmxl_b(ji,jj,jk)**rnn  
    486                END DO 
    487             END DO 
    488          END DO 
     435         DO_3D_00_00( 2, jpkm1 ) 
     436            psi(ji,jj,jk)  = rc02 * eb(ji,jj,jk) * hmxl_b(ji,jj,jk)**rnn  
     437         END_3D 
    489438         ! 
    490439      END SELECT 
     
    497446      ! Warning : after this step, en : right hand side of the matrix 
    498447 
    499       DO jk = 2, jpkm1 
    500          DO jj = 2, jpjm1 
    501             DO ji = fs_2, fs_jpim1   ! vector opt. 
    502                ! 
    503                ! psi / k 
    504                zratio = psi(ji,jj,jk) / eb(ji,jj,jk)  
    505                ! 
    506                ! psi3+ : stable : B=-KhN²<0 => N²>0 if rn2>0 zdir = 1 (stable) otherwise zdir = 0 (unstable) 
    507                zdir = 0.5_wp + SIGN( 0.5_wp, rn2(ji,jj,jk) ) 
    508                ! 
    509                rpsi3 = zdir * rpsi3m + ( 1._wp - zdir ) * rpsi3p 
    510                ! 
    511                ! shear prod. - stratif. destruction 
    512                prod = rpsi1 * zratio * p_sh2(ji,jj,jk) 
    513                ! 
    514                ! stratif. destruction 
    515                buoy = rpsi3 * zratio * (- p_avt(ji,jj,jk) * rn2(ji,jj,jk) ) 
    516                ! 
    517                ! shear prod. - stratif. destruction 
    518                diss = rpsi2 * zratio * zwall(ji,jj,jk) * eps(ji,jj,jk) 
    519                ! 
    520                zdir = 0.5_wp + SIGN( 0.5_wp, prod + buoy )     ! zdir =1(=0) if shear(ji,jj,jk)+buoy >0(<0) 
    521                ! 
    522                zesh2 = zdir * ( prod + buoy )          + (1._wp - zdir ) * prod                        ! production term 
    523                zdiss = zdir * ( diss / psi(ji,jj,jk) ) + (1._wp - zdir ) * (diss-buoy) / psi(ji,jj,jk) ! dissipation term 
    524                !                                                         
    525                ! building the matrix 
    526                zcof = rfact_psi * zwall_psi(ji,jj,jk) * tmask(ji,jj,jk) 
    527                !                                               ! lower diagonal 
    528                zd_lw(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk  ) + p_avm(ji,jj,jk-1) ) / ( e3t_n(ji,jj,jk-1) * e3w_n(ji,jj,jk) ) 
    529                !                                               ! upper diagonal 
    530                zd_up(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk+1) + p_avm(ji,jj,jk  ) ) / ( e3t_n(ji,jj,jk  ) * e3w_n(ji,jj,jk) ) 
    531                !                                               ! diagonal 
    532                zdiag(ji,jj,jk) = 1._wp - zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) + rdt * zdiss * wmask(ji,jj,jk) 
    533                !                                               ! right hand side in psi 
    534                psi(ji,jj,jk) = psi(ji,jj,jk) + rdt * zesh2 * wmask(ji,jj,jk) 
    535             END DO 
    536          END DO 
    537       END DO 
     448      DO_3D_00_00( 2, jpkm1 ) 
     449         ! 
     450         ! psi / k 
     451         zratio = psi(ji,jj,jk) / eb(ji,jj,jk)  
     452         ! 
     453         ! psi3+ : stable : B=-KhN²<0 => N²>0 if rn2>0 zdir = 1 (stable) otherwise zdir = 0 (unstable) 
     454         zdir = 0.5_wp + SIGN( 0.5_wp, rn2(ji,jj,jk) ) 
     455         ! 
     456         rpsi3 = zdir * rpsi3m + ( 1._wp - zdir ) * rpsi3p 
     457         ! 
     458         ! shear prod. - stratif. destruction 
     459         prod = rpsi1 * zratio * p_sh2(ji,jj,jk) 
     460         ! 
     461         ! stratif. destruction 
     462         buoy = rpsi3 * zratio * (- p_avt(ji,jj,jk) * rn2(ji,jj,jk) ) 
     463         ! 
     464         ! shear prod. - stratif. destruction 
     465         diss = rpsi2 * zratio * zwall(ji,jj,jk) * eps(ji,jj,jk) 
     466         ! 
     467         zdir = 0.5_wp + SIGN( 0.5_wp, prod + buoy )     ! zdir =1(=0) if shear(ji,jj,jk)+buoy >0(<0) 
     468         ! 
     469         zesh2 = zdir * ( prod + buoy )          + (1._wp - zdir ) * prod                        ! production term 
     470         zdiss = zdir * ( diss / psi(ji,jj,jk) ) + (1._wp - zdir ) * (diss-buoy) / psi(ji,jj,jk) ! dissipation term 
     471         !                                                         
     472         ! building the matrix 
     473         zcof = rfact_psi * zwall_psi(ji,jj,jk) * tmask(ji,jj,jk) 
     474         !                                               ! lower diagonal 
     475         zd_lw(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk  ) + p_avm(ji,jj,jk-1) ) / ( e3t(ji,jj,jk-1,Kmm) * e3w(ji,jj,jk,Kmm) ) 
     476         !                                               ! upper diagonal 
     477         zd_up(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk+1) + p_avm(ji,jj,jk  ) ) / ( e3t(ji,jj,jk  ,Kmm) * e3w(ji,jj,jk,Kmm) ) 
     478         !                                               ! diagonal 
     479         zdiag(ji,jj,jk) = 1._wp - zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) + rdt * zdiss * wmask(ji,jj,jk) 
     480         !                                               ! right hand side in psi 
     481         psi(ji,jj,jk) = psi(ji,jj,jk) + rdt * zesh2 * wmask(ji,jj,jk) 
     482      END_3D 
    538483      ! 
    539484      zdiag(:,:,jpk) = 1._wp 
     
    554499         ! 
    555500         ! One level below 
    556          zkar    (:,:)   = (rl_sf + (vkarmn-rl_sf)*(1._wp-EXP(-rtrans*gdepw_n(:,:,2)/zhsro(:,:) ))) 
    557          zdep    (:,:)   = (zhsro(:,:) + gdepw_n(:,:,2)) * zkar(:,:) 
     501         zkar    (:,:)   = (rl_sf + (vkarmn-rl_sf)*(1._wp-EXP(-rtrans*gdepw(:,:,2,Kmm)/zhsro(:,:) ))) 
     502         zdep    (:,:)   = (zhsro(:,:) + gdepw(:,:,2,Kmm)) * zkar(:,:) 
    558503         psi     (:,:,2) = rc0**rpp * en(:,:,2)**rmm * zdep(:,:)**rnn * tmask(:,:,1) 
    559504         zd_lw(:,:,2) = 0._wp 
     
    575520         ! 
    576521         ! Set psi vertical flux at the surface: 
    577          zkar (:,:)   = rl_sf + (vkarmn-rl_sf)*(1._wp-EXP(-rtrans*gdept_n(:,:,1)/zhsro(:,:) )) ! Lengh scale slope 
    578          zdep (:,:)   = ((zhsro(:,:) + gdept_n(:,:,1)) / zhsro(:,:))**(rmm*ra_sf) 
     522         zkar (:,:)   = rl_sf + (vkarmn-rl_sf)*(1._wp-EXP(-rtrans*gdept(:,:,1,Kmm)/zhsro(:,:) )) ! Lengh scale slope 
     523         zdep (:,:)   = ((zhsro(:,:) + gdept(:,:,1,Kmm)) / zhsro(:,:))**(rmm*ra_sf) 
    579524         zflxs(:,:)   = (rnn + rsbc_tke1 * (rnn + rmm*ra_sf) * zdep(:,:))*(1._wp + rsbc_tke1*zdep(:,:))**(2._wp*rmm/3._wp-1_wp) 
    580525         zdep (:,:)   = rsbc_psi1 * (zwall_psi(:,:,1)*p_avm(:,:,1)+zwall_psi(:,:,2)*p_avm(:,:,2)) * & 
    581             &           ustar2_surf(:,:)**rmm * zkar(:,:)**rnn * (zhsro(:,:) + gdept_n(:,:,1))**(rnn-1.) 
     526            &           ustar2_surf(:,:)**rmm * zkar(:,:)**rnn * (zhsro(:,:) + gdept(:,:,1,Kmm))**(rnn-1.) 
    582527         zflxs(:,:)   = zdep(:,:) * zflxs(:,:) 
    583          psi  (:,:,2) = psi(:,:,2) + zflxs(:,:) / e3w_n(:,:,2) 
     528         psi  (:,:,2) = psi(:,:,2) + zflxs(:,:) / e3w(:,:,2,Kmm) 
    584529         ! 
    585530      END SELECT 
     
    596541         !                      ! en(ibot) = u*^2 / Co2 and hmxl_n(ibot) = vkarmn * r_z0_bot 
    597542         !                      ! Balance between the production and the dissipation terms 
    598          DO jj = 2, jpjm1 
    599             DO ji = fs_2, fs_jpim1   ! vector opt. 
    600                ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point 
    601                ibotm1 = mbkt(ji,jj)          ! k-1 bottom level of w-point but >=1 
    602                zdep(ji,jj) = vkarmn * r_z0_bot 
    603                psi (ji,jj,ibot) = rc0**rpp * en(ji,jj,ibot)**rmm * zdep(ji,jj)**rnn 
    604                zd_lw(ji,jj,ibot) = 0._wp 
    605                zd_up(ji,jj,ibot) = 0._wp 
    606                zdiag(ji,jj,ibot) = 1._wp 
    607                ! 
    608                ! Just above last level, Dirichlet condition again (GOTM like) 
    609                zdep(ji,jj) = vkarmn * ( r_z0_bot + e3t_n(ji,jj,ibotm1) ) 
    610                psi (ji,jj,ibotm1) = rc0**rpp * en(ji,jj,ibot  )**rmm * zdep(ji,jj)**rnn 
    611                zd_lw(ji,jj,ibotm1) = 0._wp 
    612                zd_up(ji,jj,ibotm1) = 0._wp 
    613                zdiag(ji,jj,ibotm1) = 1._wp 
    614             END DO 
    615          END DO 
     543         DO_2D_00_00 
     544            ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point 
     545            ibotm1 = mbkt(ji,jj)          ! k-1 bottom level of w-point but >=1 
     546            zdep(ji,jj) = vkarmn * r_z0_bot 
     547            psi (ji,jj,ibot) = rc0**rpp * en(ji,jj,ibot)**rmm * zdep(ji,jj)**rnn 
     548            zd_lw(ji,jj,ibot) = 0._wp 
     549            zd_up(ji,jj,ibot) = 0._wp 
     550            zdiag(ji,jj,ibot) = 1._wp 
     551            ! 
     552            ! Just above last level, Dirichlet condition again (GOTM like) 
     553            zdep(ji,jj) = vkarmn * ( r_z0_bot + e3t(ji,jj,ibotm1,Kmm) ) 
     554            psi (ji,jj,ibotm1) = rc0**rpp * en(ji,jj,ibot  )**rmm * zdep(ji,jj)**rnn 
     555            zd_lw(ji,jj,ibotm1) = 0._wp 
     556            zd_up(ji,jj,ibotm1) = 0._wp 
     557            zdiag(ji,jj,ibotm1) = 1._wp 
     558         END_2D 
    616559         ! 
    617560      CASE ( 1 )             ! Neumman boundary condition 
    618561         !                       
    619          DO jj = 2, jpjm1 
    620             DO ji = fs_2, fs_jpim1   ! vector opt. 
    621                ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point 
    622                ibotm1 = mbkt(ji,jj)          ! k-1 bottom level of w-point but >=1 
    623                ! 
    624                ! Bottom level Dirichlet condition: 
    625                zdep(ji,jj) = vkarmn * r_z0_bot 
    626                psi (ji,jj,ibot) = rc0**rpp * en(ji,jj,ibot)**rmm * zdep(ji,jj)**rnn 
    627                ! 
    628                zd_lw(ji,jj,ibot) = 0._wp 
    629                zd_up(ji,jj,ibot) = 0._wp 
    630                zdiag(ji,jj,ibot) = 1._wp 
    631                ! 
    632                ! Just above last level: Neumann condition with flux injection 
    633                zdiag(ji,jj,ibotm1) = zdiag(ji,jj,ibotm1) + zd_up(ji,jj,ibotm1) ! Remove zd_up from zdiag 
    634                zd_up(ji,jj,ibotm1) = 0. 
    635                ! 
    636                ! Set psi vertical flux at the bottom: 
    637                zdep(ji,jj) = r_z0_bot + 0.5_wp*e3t_n(ji,jj,ibotm1) 
    638                zflxb = rsbc_psi2 * ( p_avm(ji,jj,ibot) + p_avm(ji,jj,ibotm1) )   & 
    639                   &  * (0.5_wp*(en(ji,jj,ibot)+en(ji,jj,ibotm1)))**rmm * zdep(ji,jj)**(rnn-1._wp) 
    640                psi(ji,jj,ibotm1) = psi(ji,jj,ibotm1) + zflxb / e3w_n(ji,jj,ibotm1) 
    641             END DO 
    642          END DO 
     562         DO_2D_00_00 
     563            ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point 
     564            ibotm1 = mbkt(ji,jj)          ! k-1 bottom level of w-point but >=1 
     565            ! 
     566            ! Bottom level Dirichlet condition: 
     567            zdep(ji,jj) = vkarmn * r_z0_bot 
     568            psi (ji,jj,ibot) = rc0**rpp * en(ji,jj,ibot)**rmm * zdep(ji,jj)**rnn 
     569            ! 
     570            zd_lw(ji,jj,ibot) = 0._wp 
     571            zd_up(ji,jj,ibot) = 0._wp 
     572            zdiag(ji,jj,ibot) = 1._wp 
     573            ! 
     574            ! Just above last level: Neumann condition with flux injection 
     575            zdiag(ji,jj,ibotm1) = zdiag(ji,jj,ibotm1) + zd_up(ji,jj,ibotm1) ! Remove zd_up from zdiag 
     576            zd_up(ji,jj,ibotm1) = 0. 
     577            ! 
     578            ! Set psi vertical flux at the bottom: 
     579            zdep(ji,jj) = r_z0_bot + 0.5_wp*e3t(ji,jj,ibotm1,Kmm) 
     580            zflxb = rsbc_psi2 * ( p_avm(ji,jj,ibot) + p_avm(ji,jj,ibotm1) )   & 
     581               &  * (0.5_wp*(en(ji,jj,ibot)+en(ji,jj,ibotm1)))**rmm * zdep(ji,jj)**(rnn-1._wp) 
     582            psi(ji,jj,ibotm1) = psi(ji,jj,ibotm1) + zflxb / e3w(ji,jj,ibotm1,Kmm) 
     583         END_2D 
    643584         ! 
    644585      END SELECT 
     
    647588      ! ---------------- 
    648589      ! 
    649       DO jk = 2, jpkm1                             ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 
    650          DO jj = 2, jpjm1 
    651             DO ji = fs_2, fs_jpim1    ! vector opt. 
    652                zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1) 
    653             END DO 
    654          END DO 
    655       END DO 
    656       DO jk = 2, jpk                               ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 
    657          DO jj = 2, jpjm1 
    658             DO ji = fs_2, fs_jpim1    ! vector opt. 
    659                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) 
    660             END DO 
    661          END DO 
    662       END DO 
    663       DO jk = jpk-1, 2, -1                         ! Third recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 
    664          DO jj = 2, jpjm1 
    665             DO ji = fs_2, fs_jpim1    ! vector opt. 
    666                psi(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * psi(ji,jj,jk+1) ) / zdiag(ji,jj,jk) 
    667             END DO 
    668          END DO 
    669       END DO 
     590      DO_3D_00_00( 2, jpkm1 ) 
     591         zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1) 
     592      END_3D 
     593      DO_3D_00_00( 2, jpk ) 
     594         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) 
     595      END_3D 
     596      DO_3DS_00_00( jpk-1, 2, -1 ) 
     597         psi(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * psi(ji,jj,jk+1) ) / zdiag(ji,jj,jk) 
     598      END_3D 
    670599 
    671600      ! Set dissipation 
     
    675604      ! 
    676605      CASE( 0 )               ! k-kl  (Mellor-Yamada) 
    677          DO jk = 1, jpkm1 
    678             DO jj = 2, jpjm1 
    679                DO ji = fs_2, fs_jpim1   ! vector opt. 
    680                   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) 
    681                END DO 
    682             END DO 
    683          END DO 
     606         DO_3D_00_00( 1, jpkm1 ) 
     607            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) 
     608         END_3D 
    684609         ! 
    685610      CASE( 1 )               ! k-eps 
    686          DO jk = 1, jpkm1 
    687             DO jj = 2, jpjm1 
    688                DO ji = fs_2, fs_jpim1   ! vector opt. 
    689                   eps(ji,jj,jk) = psi(ji,jj,jk) 
    690                END DO 
    691             END DO 
    692          END DO 
     611         DO_3D_00_00( 1, jpkm1 ) 
     612            eps(ji,jj,jk) = psi(ji,jj,jk) 
     613         END_3D 
    693614         ! 
    694615      CASE( 2 )               ! k-w 
    695          DO jk = 1, jpkm1 
    696             DO jj = 2, jpjm1 
    697                DO ji = fs_2, fs_jpim1   ! vector opt. 
    698                   eps(ji,jj,jk) = rc04 * en(ji,jj,jk) * psi(ji,jj,jk)  
    699                END DO 
    700             END DO 
    701          END DO 
     616         DO_3D_00_00( 1, jpkm1 ) 
     617            eps(ji,jj,jk) = rc04 * en(ji,jj,jk) * psi(ji,jj,jk)  
     618         END_3D 
    702619         ! 
    703620      CASE( 3 )               ! generic 
     
    705622         zex1  =      ( 1.5_wp + rmm/rnn ) 
    706623         zex2  = -1._wp / rnn 
    707          DO jk = 1, jpkm1 
    708             DO jj = 2, jpjm1 
    709                DO ji = fs_2, fs_jpim1   ! vector opt. 
    710                   eps(ji,jj,jk) = zcoef * en(ji,jj,jk)**zex1 * psi(ji,jj,jk)**zex2 
    711                END DO 
    712             END DO 
    713          END DO 
     624         DO_3D_00_00( 1, jpkm1 ) 
     625            eps(ji,jj,jk) = zcoef * en(ji,jj,jk)**zex1 * psi(ji,jj,jk)**zex2 
     626         END_3D 
    714627         ! 
    715628      END SELECT 
     
    717630      ! Limit dissipation rate under stable stratification 
    718631      ! -------------------------------------------------- 
    719       DO jk = 1, jpkm1 ! Note that this set boundary conditions on hmxl_n at the same time 
    720          DO jj = 2, jpjm1 
    721             DO ji = fs_2, fs_jpim1    ! vector opt. 
    722                ! limitation 
    723                eps   (ji,jj,jk)  = MAX( eps(ji,jj,jk), rn_epsmin ) 
    724                hmxl_n(ji,jj,jk)  = rc03 * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / eps(ji,jj,jk) 
    725                ! Galperin criterium (NOTE : Not required if the proper value of C3 in stable cases is calculated)  
    726                zrn2 = MAX( rn2(ji,jj,jk), rsmall ) 
    727                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) ) 
    728             END DO 
    729          END DO 
    730       END DO  
     632      DO_3D_00_00( 1, jpkm1 ) 
     633         ! limitation 
     634         eps   (ji,jj,jk)  = MAX( eps(ji,jj,jk), rn_epsmin ) 
     635         hmxl_n(ji,jj,jk)  = rc03 * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / eps(ji,jj,jk) 
     636         ! Galperin criterium (NOTE : Not required if the proper value of C3 in stable cases is calculated)  
     637         zrn2 = MAX( rn2(ji,jj,jk), rsmall ) 
     638         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) ) 
     639      END_3D 
    731640 
    732641      ! 
     
    737646      ! 
    738647      CASE ( 0 , 1 )             ! Galperin or Kantha-Clayson stability functions 
    739          DO jk = 2, jpkm1 
    740             DO jj = 2, jpjm1 
    741                DO ji = fs_2, fs_jpim1   ! vector opt. 
    742                   ! zcof =  l²/q² 
    743                   zcof = hmxl_b(ji,jj,jk) * hmxl_b(ji,jj,jk) / ( 2._wp*eb(ji,jj,jk) ) 
    744                   ! Gh = -N²l²/q² 
    745                   gh = - rn2(ji,jj,jk) * zcof 
    746                   gh = MIN( gh, rgh0   ) 
    747                   gh = MAX( gh, rghmin ) 
    748                   ! Stability functions from Kantha and Clayson (if C2=C3=0 => Galperin) 
    749                   sh = ra2*( 1._wp-6._wp*ra1/rb1 ) / ( 1.-3.*ra2*gh*(6.*ra1+rb2*( 1._wp-rc3 ) ) ) 
    750                   sm = ( rb1**(-1._wp/3._wp) + ( 18._wp*ra1*ra1 + 9._wp*ra1*ra2*(1._wp-rc2) )*sh*gh ) / (1._wp-9._wp*ra1*ra2*gh) 
    751                   ! 
    752                   ! Store stability function in zstt and zstm 
    753                   zstt(ji,jj,jk) = rc_diff * sh * tmask(ji,jj,jk) 
    754                   zstm(ji,jj,jk) = rc_diff * sm * tmask(ji,jj,jk) 
    755                END DO 
    756             END DO 
    757          END DO 
     648         DO_3D_00_00( 2, jpkm1 ) 
     649            ! zcof =  l²/q² 
     650            zcof = hmxl_b(ji,jj,jk) * hmxl_b(ji,jj,jk) / ( 2._wp*eb(ji,jj,jk) ) 
     651            ! Gh = -N²l²/q² 
     652            gh = - rn2(ji,jj,jk) * zcof 
     653            gh = MIN( gh, rgh0   ) 
     654            gh = MAX( gh, rghmin ) 
     655            ! Stability functions from Kantha and Clayson (if C2=C3=0 => Galperin) 
     656            sh = ra2*( 1._wp-6._wp*ra1/rb1 ) / ( 1.-3.*ra2*gh*(6.*ra1+rb2*( 1._wp-rc3 ) ) ) 
     657            sm = ( rb1**(-1._wp/3._wp) + ( 18._wp*ra1*ra1 + 9._wp*ra1*ra2*(1._wp-rc2) )*sh*gh ) / (1._wp-9._wp*ra1*ra2*gh) 
     658            ! 
     659            ! Store stability function in zstt and zstm 
     660            zstt(ji,jj,jk) = rc_diff * sh * tmask(ji,jj,jk) 
     661            zstm(ji,jj,jk) = rc_diff * sm * tmask(ji,jj,jk) 
     662         END_3D 
    758663         ! 
    759664      CASE ( 2, 3 )               ! Canuto stability functions 
    760          DO jk = 2, jpkm1 
    761             DO jj = 2, jpjm1 
    762                DO ji = fs_2, fs_jpim1   ! vector opt. 
    763                   ! zcof =  l²/q² 
    764                   zcof = hmxl_b(ji,jj,jk)*hmxl_b(ji,jj,jk) / ( 2._wp * eb(ji,jj,jk) ) 
    765                   ! Gh = -N²l²/q² 
    766                   gh = - rn2(ji,jj,jk) * zcof 
    767                   gh = MIN( gh, rgh0   ) 
    768                   gh = MAX( gh, rghmin ) 
    769                   gh = gh * rf6 
    770                   ! Gm =  M²l²/q² Shear number 
    771                   shr = p_sh2(ji,jj,jk) / MAX( p_avm(ji,jj,jk), rsmall ) 
    772                   gm = MAX( shr * zcof , 1.e-10 ) 
    773                   gm = gm * rf6 
    774                   gm = MIN ( (rd0 - rd1*gh + rd3*gh*gh) / (rd2-rd4*gh) , gm ) 
    775                   ! Stability functions from Canuto 
    776                   rcff = rd0 - rd1*gh +rd2*gm + rd3*gh*gh - rd4*gh*gm + rd5*gm*gm 
    777                   sm = (rs0 - rs1*gh + rs2*gm) / rcff 
    778                   sh = (rs4 - rs5*gh + rs6*gm) / rcff 
    779                   ! 
    780                   ! Store stability function in zstt and zstm 
    781                   zstt(ji,jj,jk) = rc_diff * sh * tmask(ji,jj,jk) 
    782                   zstm(ji,jj,jk) = rc_diff * sm * tmask(ji,jj,jk) 
    783                END DO 
    784             END DO 
    785          END DO 
     665         DO_3D_00_00( 2, jpkm1 ) 
     666            ! zcof =  l²/q² 
     667            zcof = hmxl_b(ji,jj,jk)*hmxl_b(ji,jj,jk) / ( 2._wp * eb(ji,jj,jk) ) 
     668            ! Gh = -N²l²/q² 
     669            gh = - rn2(ji,jj,jk) * zcof 
     670            gh = MIN( gh, rgh0   ) 
     671            gh = MAX( gh, rghmin ) 
     672            gh = gh * rf6 
     673            ! Gm =  M²l²/q² Shear number 
     674            shr = p_sh2(ji,jj,jk) / MAX( p_avm(ji,jj,jk), rsmall ) 
     675            gm = MAX( shr * zcof , 1.e-10 ) 
     676            gm = gm * rf6 
     677            gm = MIN ( (rd0 - rd1*gh + rd3*gh*gh) / (rd2-rd4*gh) , gm ) 
     678            ! Stability functions from Canuto 
     679            rcff = rd0 - rd1*gh +rd2*gm + rd3*gh*gh - rd4*gh*gm + rd5*gm*gm 
     680            sm = (rs0 - rs1*gh + rs2*gm) / rcff 
     681            sh = (rs4 - rs5*gh + rs6*gm) / rcff 
     682            ! 
     683            ! Store stability function in zstt and zstm 
     684            zstt(ji,jj,jk) = rc_diff * sh * tmask(ji,jj,jk) 
     685            zstm(ji,jj,jk) = rc_diff * sm * tmask(ji,jj,jk) 
     686         END_3D 
    786687         ! 
    787688      END SELECT 
     
    794695      ! default value, in case jpk > mbkt(ji,jj)+1. Not needed but avoid a bug when looking for undefined values (-fpe0) 
    795696      zstm(:,:,jpk) = 0.   
    796       DO jj = 2, jpjm1                ! update bottom with good values 
    797          DO ji = fs_2, fs_jpim1   ! vector opt. 
    798             zstm(ji,jj,mbkt(ji,jj)+1) = zstm(ji,jj,mbkt(ji,jj)) 
    799          END DO 
    800       END DO 
     697      DO_2D_00_00 
     698         zstm(ji,jj,mbkt(ji,jj)+1) = zstm(ji,jj,mbkt(ji,jj)) 
     699      END_2D 
    801700 
    802701      zstt(:,:,  1) = wmask(:,:,  1)  ! default value not needed but avoid a bug when looking for undefined values (-fpe0) 
     
    811710      !     later overwritten by surface/bottom boundaries conditions, so we don't really care of p_avm(:,:1) and p_avm(:,:jpk) 
    812711      !     for zd_lw and zd_up but they have to be defined to avoid a bug when looking for undefined values (-fpe0) 
    813       DO jk = 1, jpk 
    814          DO jj = 2, jpjm1 
    815             DO ji = fs_2, fs_jpim1   ! vector opt. 
    816                zsqen = SQRT( 2._wp * en(ji,jj,jk) ) * hmxl_n(ji,jj,jk) 
    817                zavt  = zsqen * zstt(ji,jj,jk) 
    818                zavm  = zsqen * zstm(ji,jj,jk) 
    819                p_avt(ji,jj,jk) = MAX( zavt, avtb(jk) ) * wmask(ji,jj,jk) ! apply mask for zdfmxl routine 
    820                p_avm(ji,jj,jk) = MAX( zavm, avmb(jk) )                   ! Note that avm is not masked at the surface and the bottom 
    821             END DO 
    822          END DO 
    823       END DO 
     712      DO_3D_00_00( 1, jpk ) 
     713         zsqen = SQRT( 2._wp * en(ji,jj,jk) ) * hmxl_n(ji,jj,jk) 
     714         zavt  = zsqen * zstt(ji,jj,jk) 
     715         zavm  = zsqen * zstm(ji,jj,jk) 
     716         p_avt(ji,jj,jk) = MAX( zavt, avtb(jk) ) * wmask(ji,jj,jk) ! apply mask for zdfmxl routine 
     717         p_avm(ji,jj,jk) = MAX( zavm, avmb(jk) )                   ! Note that avm is not masked at the surface and the bottom 
     718      END_3D 
    824719      p_avt(:,:,1) = 0._wp 
    825720      ! 
    826       IF(ln_ctl) THEN 
     721      IF(sn_cfctl%l_prtctl) THEN 
    827722         CALL prt_ctl( tab3d_1=en   , clinfo1=' gls  - e: ', tab3d_2=p_avt, clinfo2=' t: ', kdim=jpk) 
    828723         CALL prt_ctl( tab3d_1=p_avm, clinfo1=' gls  - m: ', kdim=jpk ) 
     
    857752      !!---------------------------------------------------------- 
    858753      ! 
    859       REWIND( numnam_ref )              ! Namelist namzdf_gls in reference namelist : Vertical eddy diffivity and viscosity using gls turbulent closure scheme 
    860754      READ  ( numnam_ref, namzdf_gls, IOSTAT = ios, ERR = 901) 
    861755901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namzdf_gls in reference namelist' ) 
    862756 
    863       REWIND( numnam_cfg )              ! Namelist namzdf_gls in configuration namelist : Vertical eddy diffivity and viscosity using gls turbulent closure scheme 
    864757      READ  ( numnam_cfg, namzdf_gls, IOSTAT = ios, ERR = 902 ) 
    865758902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namzdf_gls in configuration namelist' ) 
  • NEMO/trunk/src/OCE/ZDF/zdfiwm.F90

    r11536 r12377  
    4949 
    5050   !! * Substitutions 
    51 #  include "vectopt_loop_substitute.h90" 
     51#  include "do_loop_substitute.h90" 
    5252   !!---------------------------------------------------------------------- 
    5353   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    6969 
    7070 
    71    SUBROUTINE zdf_iwm( kt, p_avm, p_avt, p_avs ) 
     71   SUBROUTINE zdf_iwm( kt, Kmm, p_avm, p_avt, p_avs ) 
    7272      !!---------------------------------------------------------------------- 
    7373      !!                  ***  ROUTINE zdf_iwm  *** 
     
    118118      !!---------------------------------------------------------------------- 
    119119      INTEGER                    , INTENT(in   ) ::   kt             ! ocean time step 
     120      INTEGER                    , INTENT(in   ) ::   Kmm            ! time level index 
    120121      REAL(wp), DIMENSION(:,:,:) , INTENT(inout) ::   p_avm          ! momentum Kz (w-points) 
    121122      REAL(wp), DIMENSION(:,:,:) , INTENT(inout) ::   p_avt, p_avs   ! tracer   Kz (w-points) 
     
    148149      !                       !* Critical slope mixing: distribute energy over the time-varying ocean depth, 
    149150      !                                                 using an exponential decay from the seafloor. 
    150       DO jj = 1, jpj                ! part independent of the level 
    151          DO ji = 1, jpi 
    152             zhdep(ji,jj) = gdepw_0(ji,jj,mbkt(ji,jj)+1)       ! depth of the ocean 
    153             zfact(ji,jj) = rau0 * (  1._wp - EXP( -zhdep(ji,jj) / hcri_iwm(ji,jj) )  ) 
    154             IF( zfact(ji,jj) /= 0._wp )   zfact(ji,jj) = ecri_iwm(ji,jj) / zfact(ji,jj) 
    155          END DO 
    156       END DO 
    157 !!gm gde3w ==>>>  check for ssh taken into account.... seem OK gde3w_n=gdept_n - sshn 
    158       DO jk = 2, jpkm1              ! complete with the level-dependent part 
    159          DO jj = 1, jpj              
    160             DO ji = 1, jpi 
    161                IF ( zfact(ji,jj) == 0._wp .OR. wmask(ji,jj,jk) == 0._wp ) THEN   ! optimization 
    162                   zemx_iwm(ji,jj,jk) = 0._wp 
    163                ELSE 
    164                   zemx_iwm(ji,jj,jk) = zfact(ji,jj) * (  EXP( ( gde3w_n(ji,jj,jk  ) - zhdep(ji,jj) ) / hcri_iwm(ji,jj) )     & 
    165                        &                               - EXP( ( gde3w_n(ji,jj,jk-1) - zhdep(ji,jj) ) / hcri_iwm(ji,jj) ) )   & 
    166                        &                            / ( gde3w_n(ji,jj,jk) - gde3w_n(ji,jj,jk-1) ) 
    167                ENDIF 
    168             END DO 
    169          END DO 
    170 !!gm delta(gde3w_n) = e3t_n  !!  Please verify the grid-point position w versus t-point 
     151      DO_2D_11_11 
     152         zhdep(ji,jj) = gdepw_0(ji,jj,mbkt(ji,jj)+1)       ! depth of the ocean 
     153         zfact(ji,jj) = rau0 * (  1._wp - EXP( -zhdep(ji,jj) / hcri_iwm(ji,jj) )  ) 
     154         IF( zfact(ji,jj) /= 0._wp )   zfact(ji,jj) = ecri_iwm(ji,jj) / zfact(ji,jj) 
     155      END_2D 
     156!!gm gde3w ==>>>  check for ssh taken into account.... seem OK gde3w_n=gdept(:,:,:,Kmm) - ssh(:,:,Kmm) 
     157      DO_3D_11_11( 2, jpkm1 ) 
     158         IF ( zfact(ji,jj) == 0._wp .OR. wmask(ji,jj,jk) == 0._wp ) THEN   ! optimization 
     159            zemx_iwm(ji,jj,jk) = 0._wp 
     160         ELSE 
     161            zemx_iwm(ji,jj,jk) = zfact(ji,jj) * (  EXP( ( gde3w(ji,jj,jk  ) - zhdep(ji,jj) ) / hcri_iwm(ji,jj) )     & 
     162                 &                               - EXP( ( gde3w(ji,jj,jk-1) - zhdep(ji,jj) ) / hcri_iwm(ji,jj) ) )   & 
     163                 &                            / ( gde3w(ji,jj,jk) - gde3w(ji,jj,jk-1) ) 
     164         ENDIF 
     165      END_3D 
     166!!gm delta(gde3w) = e3t(:,:,:,Kmm)  !!  Please verify the grid-point position w versus t-point 
    171167!!gm it seems to me that only 1/hcri_iwm  is used ==>  compute it one for all 
    172168 
    173       END DO 
    174169 
    175170      !                        !* Pycnocline-intensified mixing: distribute energy over the time-varying  
     
    182177         zfact(:,:) = 0._wp 
    183178         DO jk = 2, jpkm1              ! part independent of the level 
    184             zfact(:,:) = zfact(:,:) + e3w_n(:,:,jk) * SQRT(  MAX( 0._wp, rn2(:,:,jk) )  ) * wmask(:,:,jk) 
    185          END DO 
    186          ! 
    187          DO jj = 1, jpj 
    188             DO ji = 1, jpi 
    189                IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = epyc_iwm(ji,jj) / ( rau0 * zfact(ji,jj) ) 
    190             END DO 
    191          END DO 
     179            zfact(:,:) = zfact(:,:) + e3w(:,:,jk,Kmm) * SQRT(  MAX( 0._wp, rn2(:,:,jk) )  ) * wmask(:,:,jk) 
     180         END DO 
     181         ! 
     182         DO_2D_11_11 
     183            IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = epyc_iwm(ji,jj) / ( rau0 * zfact(ji,jj) ) 
     184         END_2D 
    192185         ! 
    193186         DO jk = 2, jpkm1              ! complete with the level-dependent part 
     
    199192         zfact(:,:) = 0._wp 
    200193         DO jk = 2, jpkm1              ! part independent of the level 
    201             zfact(:,:) = zfact(:,:) + e3w_n(:,:,jk) * MAX( 0._wp, rn2(:,:,jk) ) * wmask(:,:,jk) 
    202          END DO 
    203          ! 
    204          DO jj= 1, jpj 
    205             DO ji = 1, jpi 
    206                IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = epyc_iwm(ji,jj) / ( rau0 * zfact(ji,jj) ) 
    207             END DO 
    208          END DO 
     194            zfact(:,:) = zfact(:,:) + e3w(:,:,jk,Kmm) * MAX( 0._wp, rn2(:,:,jk) ) * wmask(:,:,jk) 
     195         END DO 
     196         ! 
     197         DO_2D_11_11 
     198            IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = epyc_iwm(ji,jj) / ( rau0 * zfact(ji,jj) ) 
     199         END_2D 
    209200         ! 
    210201         DO jk = 2, jpkm1              ! complete with the level-dependent part 
     
    220211      zfact(:,:)   = 0._wp 
    221212      DO jk = 2, jpkm1 
    222          zfact(:,:) = zfact(:,:) + e3w_n(:,:,jk) * SQRT(  MAX( 0._wp, rn2(:,:,jk) )  ) * wmask(:,:,jk) 
     213         zfact(:,:) = zfact(:,:) + e3w(:,:,jk,Kmm) * SQRT(  MAX( 0._wp, rn2(:,:,jk) )  ) * wmask(:,:,jk) 
    223214         zwkb(:,:,jk) = zfact(:,:) 
    224215      END DO 
    225216!!gm even better: 
    226217!      DO jk = 2, jpkm1 
    227 !         zwkb(:,:) = zwkb(:,:) + e3w_n(:,:,jk) * SQRT(  MAX( 0._wp, rn2(:,:,jk) )  ) 
     218!         zwkb(:,:) = zwkb(:,:) + e3w(:,:,jk,Kmm) * SQRT(  MAX( 0._wp, rn2(:,:,jk) )  ) 
    228219!      END DO 
    229220!      zfact(:,:) = zwkb(:,:,jpkm1) 
     
    231222!!gm 
    232223      ! 
    233       DO jk = 2, jpkm1 
    234          DO jj = 1, jpj 
    235             DO ji = 1, jpi 
    236                IF( zfact(ji,jj) /= 0 )   zwkb(ji,jj,jk) = zhdep(ji,jj) * ( zfact(ji,jj) - zwkb(ji,jj,jk) )   & 
    237                   &                                     * wmask(ji,jj,jk) / zfact(ji,jj) 
    238             END DO 
    239          END DO 
    240       END DO 
     224      DO_3D_11_11( 2, jpkm1 ) 
     225         IF( zfact(ji,jj) /= 0 )   zwkb(ji,jj,jk) = zhdep(ji,jj) * ( zfact(ji,jj) - zwkb(ji,jj,jk) )   & 
     226            &                                     * wmask(ji,jj,jk) / zfact(ji,jj) 
     227      END_3D 
    241228      zwkb(:,:,1) = zhdep(:,:) * wmask(:,:,1) 
    242229      ! 
    243       DO jk = 2, jpkm1 
    244          DO jj = 1, jpj 
    245             DO ji = 1, jpi 
    246                IF ( rn2(ji,jj,jk) <= 0._wp .OR. wmask(ji,jj,jk) == 0._wp ) THEN   ! optimization 
    247                   zweight(ji,jj,jk) = 0._wp 
    248                ELSE 
    249                   zweight(ji,jj,jk) = rn2(ji,jj,jk) * hbot_iwm(ji,jj)    & 
    250                      &   * (  EXP( -zwkb(ji,jj,jk) / hbot_iwm(ji,jj) ) - EXP( -zwkb(ji,jj,jk-1) / hbot_iwm(ji,jj) )  ) 
    251                ENDIF 
    252             END DO 
    253          END DO 
    254       END DO 
     230      DO_3D_11_11( 2, jpkm1 ) 
     231         IF ( rn2(ji,jj,jk) <= 0._wp .OR. wmask(ji,jj,jk) == 0._wp ) THEN   ! optimization 
     232            zweight(ji,jj,jk) = 0._wp 
     233         ELSE 
     234            zweight(ji,jj,jk) = rn2(ji,jj,jk) * hbot_iwm(ji,jj)    & 
     235               &   * (  EXP( -zwkb(ji,jj,jk) / hbot_iwm(ji,jj) ) - EXP( -zwkb(ji,jj,jk-1) / hbot_iwm(ji,jj) )  ) 
     236         ENDIF 
     237      END_3D 
    255238      ! 
    256239      zfact(:,:) = 0._wp 
     
    259242      END DO 
    260243      ! 
    261       DO jj = 1, jpj 
    262          DO ji = 1, jpi 
    263             IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = ebot_iwm(ji,jj) / ( rau0 * zfact(ji,jj) ) 
    264          END DO 
    265       END DO 
     244      DO_2D_11_11 
     245         IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = ebot_iwm(ji,jj) / ( rau0 * zfact(ji,jj) ) 
     246      END_2D 
    266247      ! 
    267248      DO jk = 2, jpkm1              ! complete with the level-dependent part 
    268249         zemx_iwm(:,:,jk) = zemx_iwm(:,:,jk) + zweight(:,:,jk) * zfact(:,:) * wmask(:,:,jk)   & 
    269             &                                / ( gde3w_n(:,:,jk) - gde3w_n(:,:,jk-1) ) 
    270 !!gm  use of e3t_n just above? 
     250            &                                / ( gde3w(:,:,jk) - gde3w(:,:,jk-1) ) 
     251!!gm  use of e3t(:,:,:,Kmm) just above? 
    271252      END DO 
    272253      ! 
    273254!!gm  this is to be replaced by just a constant value znu=1.e-6 m2/s 
    274255      ! Calculate molecular kinematic viscosity 
    275       znu_t(:,:,:) = 1.e-4_wp * (  17.91_wp - 0.53810_wp * tsn(:,:,:,jp_tem) + 0.00694_wp * tsn(:,:,:,jp_tem) * tsn(:,:,:,jp_tem)  & 
    276          &                                  + 0.02305_wp * tsn(:,:,:,jp_sal)  ) * tmask(:,:,:) * r1_rau0 
     256      znu_t(:,:,:) = 1.e-4_wp * (  17.91_wp - 0.53810_wp * ts(:,:,:,jp_tem,Kmm) + 0.00694_wp * ts(:,:,:,jp_tem,Kmm) * ts(:,:,:,jp_tem,Kmm)  & 
     257         &                                  + 0.02305_wp * ts(:,:,:,jp_sal,Kmm)  ) * tmask(:,:,:) * r1_rau0 
    277258      DO jk = 2, jpkm1 
    278259         znu_w(:,:,jk) = 0.5_wp * ( znu_t(:,:,jk-1) + znu_t(:,:,jk) ) * wmask(:,:,jk) 
     
    291272      ! 
    292273      IF( ln_mevar ) THEN              ! Variable mixing efficiency case : modify zav_wave in the 
    293          DO jk = 2, jpkm1              ! energetic (Reb > 480) and buoyancy-controlled (Reb <10.224 ) regimes 
    294             DO jj = 1, jpj 
    295                DO ji = 1, jpi 
    296                   IF( zReb(ji,jj,jk) > 480.00_wp ) THEN 
    297                      zav_wave(ji,jj,jk) = 3.6515_wp * znu_w(ji,jj,jk) * SQRT( zReb(ji,jj,jk) ) 
    298                   ELSEIF( zReb(ji,jj,jk) < 10.224_wp ) THEN 
    299                      zav_wave(ji,jj,jk) = 0.052125_wp * znu_w(ji,jj,jk) * zReb(ji,jj,jk) * SQRT( zReb(ji,jj,jk) ) 
    300                   ENDIF 
    301                END DO 
    302             END DO 
    303          END DO 
     274         DO_3D_11_11( 2, jpkm1 ) 
     275            IF( zReb(ji,jj,jk) > 480.00_wp ) THEN 
     276               zav_wave(ji,jj,jk) = 3.6515_wp * znu_w(ji,jj,jk) * SQRT( zReb(ji,jj,jk) ) 
     277            ELSEIF( zReb(ji,jj,jk) < 10.224_wp ) THEN 
     278               zav_wave(ji,jj,jk) = 0.052125_wp * znu_w(ji,jj,jk) * zReb(ji,jj,jk) * SQRT( zReb(ji,jj,jk) ) 
     279            ENDIF 
     280         END_3D 
    304281      ENDIF 
    305282      ! 
     
    311288         zztmp = 0._wp 
    312289!!gm used of glosum 3D.... 
    313          DO jk = 2, jpkm1 
    314             DO jj = 1, jpj 
    315                DO ji = 1, jpi 
    316                   zztmp = zztmp + e3w_n(ji,jj,jk) * e1e2t(ji,jj)   & 
    317                      &          * MAX( 0._wp, rn2(ji,jj,jk) ) * zav_wave(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj) 
    318                END DO 
    319             END DO 
    320          END DO 
     290         DO_3D_11_11( 2, jpkm1 ) 
     291            zztmp = zztmp + e3w(ji,jj,jk,Kmm) * e1e2t(ji,jj)   & 
     292               &          * MAX( 0._wp, rn2(ji,jj,jk) ) * zav_wave(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj) 
     293         END_3D 
    321294         CALL mpp_sum( 'zdfiwm', zztmp ) 
    322295         zztmp = rau0 * zztmp ! Global integral of rauo * Kz * N^2 = power contributing to mixing  
     
    337310      IF( ln_tsdiff ) THEN          !* Option for differential mixing of salinity and temperature 
    338311         ztmp1 = 0.505_wp + 0.495_wp * TANH( 0.92_wp * ( LOG10( 1.e-20_wp ) - 0.60_wp ) ) 
    339          DO jk = 2, jpkm1              ! Calculate S/T diffusivity ratio as a function of Reb 
    340             DO jj = 1, jpj 
    341                DO ji = 1, jpi 
    342                   ztmp2 = zReb(ji,jj,jk) * 5._wp * r1_6 
    343                   IF ( ztmp2 > 1.e-20_wp .AND. wmask(ji,jj,jk) == 1._wp ) THEN 
    344                      zav_ratio(ji,jj,jk) = 0.505_wp + 0.495_wp * TANH( 0.92_wp * ( LOG10(ztmp2) - 0.60_wp ) ) 
    345                   ELSE 
    346                      zav_ratio(ji,jj,jk) = ztmp1 * wmask(ji,jj,jk) 
    347                   ENDIF 
    348                END DO 
    349             END DO 
    350          END DO 
     312         DO_3D_11_11( 2, jpkm1 ) 
     313            ztmp2 = zReb(ji,jj,jk) * 5._wp * r1_6 
     314            IF ( ztmp2 > 1.e-20_wp .AND. wmask(ji,jj,jk) == 1._wp ) THEN 
     315               zav_ratio(ji,jj,jk) = 0.505_wp + 0.495_wp * TANH( 0.92_wp * ( LOG10(ztmp2) - 0.60_wp ) ) 
     316            ELSE 
     317               zav_ratio(ji,jj,jk) = ztmp1 * wmask(ji,jj,jk) 
     318            ENDIF 
     319         END_3D 
    351320         CALL iom_put( "av_ratio", zav_ratio ) 
    352321         DO jk = 2, jpkm1           !* update momentum & tracer diffusivity with wave-driven mixing 
     
    374343         z2d(:,:) = 0._wp 
    375344         DO jk = 2, jpkm1 
    376             z2d(:,:) = z2d(:,:) + e3w_n(:,:,jk) * z3d(:,:,jk) * wmask(:,:,jk) 
     345            z2d(:,:) = z2d(:,:) + e3w(:,:,jk,Kmm) * z3d(:,:,jk) * wmask(:,:,jk) 
    377346         END DO 
    378347         z2d(:,:) = rau0 * z2d(:,:) 
     
    383352      CALL iom_put( "emix_iwm", zemx_iwm ) 
    384353       
    385       IF(ln_ctl)   CALL prt_ctl(tab3d_1=zav_wave , clinfo1=' iwm - av_wave: ', tab3d_2=avt, clinfo2=' avt: ', kdim=jpk) 
     354      IF(sn_cfctl%l_prtctl)   CALL prt_ctl(tab3d_1=zav_wave , clinfo1=' iwm - av_wave: ', tab3d_2=avt, clinfo2=' avt: ', kdim=jpk) 
    386355      ! 
    387356   END SUBROUTINE zdf_iwm 
     
    414383      !!              de Lavergne et al. in prep., 2017 
    415384      !!---------------------------------------------------------------------- 
    416       INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    417385      INTEGER  ::   inum         ! local integer 
    418386      INTEGER  ::   ios 
     
    422390      !!---------------------------------------------------------------------- 
    423391      ! 
    424       REWIND( numnam_ref )              ! Namelist namzdf_iwm in reference namelist : Wave-driven mixing 
    425392      READ  ( numnam_ref, namzdf_iwm, IOSTAT = ios, ERR = 901) 
    426393901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namzdf_iwm in reference namelist' ) 
    427394      ! 
    428       REWIND( numnam_cfg )              ! Namelist namzdf_iwm in configuration namelist : Wave-driven mixing 
    429395      READ  ( numnam_cfg, namzdf_iwm, IOSTAT = ios, ERR = 902 ) 
    430396902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namzdf_iwm in configuration namelist' ) 
  • NEMO/trunk/src/OCE/ZDF/zdfmxl.F90

    r10425 r12377  
    1212   !!---------------------------------------------------------------------- 
    1313   USE oce            ! ocean dynamics and tracers variables 
     14   USE isf_oce        ! ice shelf 
    1415   USE dom_oce        ! ocean space and time domain variables 
    1516   USE trc_oce  , ONLY: l_offline         ! ocean space and time domain variables 
     
    3536   REAL(wp), PUBLIC ::   avt_c = 5.e-4_wp   ! Kz criterion for the turbocline depth 
    3637 
     38   !! * Substitutions 
     39#  include "do_loop_substitute.h90" 
    3740   !!---------------------------------------------------------------------- 
    3841   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    5760 
    5861 
    59    SUBROUTINE zdf_mxl( kt ) 
     62   SUBROUTINE zdf_mxl( kt, Kmm ) 
    6063      !!---------------------------------------------------------------------- 
    6164      !!                  ***  ROUTINE zdfmxl  *** 
     
    7578      !!---------------------------------------------------------------------- 
    7679      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     80      INTEGER, INTENT(in) ::   Kmm  ! ocean time level index 
    7781      ! 
    7882      INTEGER  ::   ji, jj, jk      ! dummy loop indices 
     
    9498      hmlp(:,:)  = 0._wp               ! here hmlp used as a dummy variable, integrating vertically N^2 
    9599      zN2_c = grav * rho_c * r1_rau0   ! convert density criteria into N^2 criteria 
    96       DO jk = nlb10, jpkm1 
    97          DO jj = 1, jpj                ! Mixed layer level: w-level  
    98             DO ji = 1, jpi 
    99                ikt = mbkt(ji,jj) 
    100                hmlp(ji,jj) = hmlp(ji,jj) + MAX( rn2b(ji,jj,jk) , 0._wp ) * e3w_n(ji,jj,jk) 
    101                IF( hmlp(ji,jj) < zN2_c )   nmln(ji,jj) = MIN( jk , ikt ) + 1   ! Mixed layer level 
    102             END DO 
    103          END DO 
    104       END DO 
     100      DO_3D_11_11( nlb10, jpkm1 ) 
     101         ikt = mbkt(ji,jj) 
     102         hmlp(ji,jj) = hmlp(ji,jj) + MAX( rn2b(ji,jj,jk) , 0._wp ) * e3w(ji,jj,jk,Kmm) 
     103         IF( hmlp(ji,jj) < zN2_c )   nmln(ji,jj) = MIN( jk , ikt ) + 1   ! Mixed layer level 
     104      END_3D 
    105105      ! 
    106106      ! w-level of the turbocline and mixing layer (iom_use) 
    107107      imld(:,:) = mbkt(:,:) + 1        ! Initialization to the number of w ocean point 
    108       DO jk = jpkm1, nlb10, -1         ! from the bottom to nlb10  
    109          DO jj = 1, jpj 
    110             DO ji = 1, jpi 
    111                IF( avt (ji,jj,jk) < avt_c * wmask(ji,jj,jk) )   imld(ji,jj) = jk      ! Turbocline  
    112             END DO 
    113          END DO 
    114       END DO 
     108      DO_3DS_11_11( jpkm1, nlb10, -1 ) 
     109         IF( avt (ji,jj,jk) < avt_c * wmask(ji,jj,jk) )   imld(ji,jj) = jk      ! Turbocline  
     110      END_3D 
    115111      ! depth of the mixing and mixed layers 
    116       DO jj = 1, jpj 
    117          DO ji = 1, jpi 
    118             iiki = imld(ji,jj) 
    119             iikn = nmln(ji,jj) 
    120             hmld (ji,jj) = gdepw_n(ji,jj,iiki  ) * ssmask(ji,jj)    ! Turbocline depth  
    121             hmlp (ji,jj) = gdepw_n(ji,jj,iikn  ) * ssmask(ji,jj)    ! Mixed layer depth 
    122             hmlpt(ji,jj) = gdept_n(ji,jj,iikn-1) * ssmask(ji,jj)    ! depth of the last T-point inside the mixed layer 
    123          END DO 
    124       END DO 
     112      DO_2D_11_11 
     113         iiki = imld(ji,jj) 
     114         iikn = nmln(ji,jj) 
     115         hmld (ji,jj) = gdepw(ji,jj,iiki  ,Kmm) * ssmask(ji,jj)    ! Turbocline depth  
     116         hmlp (ji,jj) = gdepw(ji,jj,iikn  ,Kmm) * ssmask(ji,jj)    ! Mixed layer depth 
     117         hmlpt(ji,jj) = gdept(ji,jj,iikn-1,Kmm) * ssmask(ji,jj)    ! depth of the last T-point inside the mixed layer 
     118      END_2D 
    125119      ! 
    126120      IF( .NOT.l_offline ) THEN 
     
    137131      ENDIF 
    138132      ! 
    139       IF(ln_ctl)   CALL prt_ctl( tab2d_1=REAL(nmln,wp), clinfo1=' nmln : ', tab2d_2=hmlp, clinfo2=' hmlp : ' ) 
     133      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab2d_1=REAL(nmln,wp), clinfo1=' nmln : ', tab2d_2=hmlp, clinfo2=' hmlp : ' ) 
    140134      ! 
    141135   END SUBROUTINE zdf_mxl 
  • NEMO/trunk/src/OCE/ZDF/zdfosm.F90

    r11536 r12377  
    4242   !!---------------------------------------------------------------------- 
    4343   USE oce            ! ocean dynamics and active tracers 
    44                       ! uses wn from previous time step (which is now wb) to calculate hbl 
     44                      ! uses ww from previous time step (which is now wb) to calculate hbl 
    4545   USE dom_oce        ! ocean space and time domain 
    4646   USE zdf_oce        ! ocean vertical physics 
     
    103103   INTEGER :: idebug = 236 
    104104   INTEGER :: jdebug = 228 
     105   !! * Substitutions 
     106#  include "do_loop_substitute.h90" 
    105107   !!---------------------------------------------------------------------- 
    106108   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    122124 
    123125 
    124    SUBROUTINE zdf_osm( kt, p_avm, p_avt ) 
     126   SUBROUTINE zdf_osm( kt, Kbb, Kmm, Krhs, p_avm, p_avt ) 
    125127      !!---------------------------------------------------------------------- 
    126128      !!                   ***  ROUTINE zdf_osm  *** 
     
    157159      !!         the equation number. (LMD94, here after) 
    158160      !!---------------------------------------------------------------------- 
    159       INTEGER                   , INTENT(in   ) ::   kt            ! ocean time step 
     161      INTEGER                   , INTENT(in   ) ::  kt             ! ocean time step 
     162      INTEGER                   , INTENT(in   ) ::  Kbb, Kmm, Krhs ! ocean time level indices 
    160163      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::  p_avm, p_avt   ! momentum and tracer Kz (w-points) 
    161164      !! 
     
    295298     zz0 =       rn_abs       ! surface equi-partition in 2-bands 
    296299     zz1 =  1. - rn_abs 
    297      DO jj = 2, jpjm1 
    298         DO ji = 2, jpim1 
    299            ! Surface downward irradiance (so always +ve) 
    300            zrad0(ji,jj) = qsr(ji,jj) * r1_rau0_rcp 
    301            ! Downwards irradiance at base of boundary layer 
    302            zradh(ji,jj) = zrad0(ji,jj) * ( zz0 * EXP( -hbl(ji,jj)/rn_si0 ) + zz1 * EXP( -hbl(ji,jj)/rn_si1) ) 
    303            ! Downwards irradiance averaged over depth of the OSBL 
    304            zradav(ji,jj) = zrad0(ji,jj) * ( zz0 * ( 1.0 - EXP( -hbl(ji,jj)/rn_si0 ) )*rn_si0 & 
    305                  &                         + zz1 * ( 1.0 - EXP( -hbl(ji,jj)/rn_si1 ) )*rn_si1 ) / hbl(ji,jj) 
    306         END DO 
    307      END DO 
     300     DO_2D_00_00 
     301        ! Surface downward irradiance (so always +ve) 
     302        zrad0(ji,jj) = qsr(ji,jj) * r1_rau0_rcp 
     303        ! Downwards irradiance at base of boundary layer 
     304        zradh(ji,jj) = zrad0(ji,jj) * ( zz0 * EXP( -hbl(ji,jj)/rn_si0 ) + zz1 * EXP( -hbl(ji,jj)/rn_si1) ) 
     305        ! Downwards irradiance averaged over depth of the OSBL 
     306        zradav(ji,jj) = zrad0(ji,jj) * ( zz0 * ( 1.0 - EXP( -hbl(ji,jj)/rn_si0 ) )*rn_si0 & 
     307              &                         + zz1 * ( 1.0 - EXP( -hbl(ji,jj)/rn_si1 ) )*rn_si1 ) / hbl(ji,jj) 
     308     END_2D 
    308309     ! Turbulent surface fluxes and fluxes averaged over depth of the OSBL 
    309      DO jj = 2, jpjm1 
    310         DO ji = 2, jpim1 
    311            zthermal = rab_n(ji,jj,1,jp_tem) 
    312            zbeta    = rab_n(ji,jj,1,jp_sal) 
    313            ! Upwards surface Temperature flux for non-local term 
    314            zwth0(ji,jj) = - qns(ji,jj) * r1_rau0_rcp * tmask(ji,jj,1) 
    315            ! Upwards surface salinity flux for non-local term 
    316            zws0(ji,jj) = - ( ( emp(ji,jj)-rnf(ji,jj) ) * tsn(ji,jj,1,jp_sal)  + sfx(ji,jj) ) * r1_rau0 * tmask(ji,jj,1) 
    317            ! Non radiative upwards surface buoyancy flux 
    318            zwb0(ji,jj) = grav * zthermal * zwth0(ji,jj) -  grav * zbeta * zws0(ji,jj) 
    319            ! turbulent heat flux averaged over depth of OSBL 
    320            zwthav(ji,jj) = 0.5 * zwth0(ji,jj) - ( 0.5*( zrad0(ji,jj) + zradh(ji,jj) ) - zradav(ji,jj) ) 
    321            ! turbulent salinity flux averaged over depth of the OBSL 
    322            zwsav(ji,jj) = 0.5 * zws0(ji,jj) 
    323            ! turbulent buoyancy flux averaged over the depth of the OBSBL 
    324            zwbav(ji,jj) = grav  * zthermal * zwthav(ji,jj) - grav  * zbeta * zwsav(ji,jj) 
    325            ! Surface upward velocity fluxes 
    326            zuw0(ji,jj) = -utau(ji,jj) * r1_rau0 * tmask(ji,jj,1) 
    327            zvw0(ji,jj) = -vtau(ji,jj) * r1_rau0 * tmask(ji,jj,1) 
    328            ! Friction velocity (zustar), at T-point : LMD94 eq. 2 
    329            zustar(ji,jj) = MAX( SQRT( SQRT( zuw0(ji,jj) * zuw0(ji,jj) + zvw0(ji,jj) * zvw0(ji,jj) ) ), 1.0e-8 ) 
    330            zcos_wind(ji,jj) = -zuw0(ji,jj) / ( zustar(ji,jj) * zustar(ji,jj) ) 
    331            zsin_wind(ji,jj) = -zvw0(ji,jj) / ( zustar(ji,jj) * zustar(ji,jj) ) 
    332         END DO 
    333      END DO 
     310     DO_2D_00_00 
     311        zthermal = rab_n(ji,jj,1,jp_tem) 
     312        zbeta    = rab_n(ji,jj,1,jp_sal) 
     313        ! Upwards surface Temperature flux for non-local term 
     314        zwth0(ji,jj) = - qns(ji,jj) * r1_rau0_rcp * tmask(ji,jj,1) 
     315        ! Upwards surface salinity flux for non-local term 
     316        zws0(ji,jj) = - ( ( emp(ji,jj)-rnf(ji,jj) ) * ts(ji,jj,1,jp_sal,Kmm)  + sfx(ji,jj) ) * r1_rau0 * tmask(ji,jj,1) 
     317        ! Non radiative upwards surface buoyancy flux 
     318        zwb0(ji,jj) = grav * zthermal * zwth0(ji,jj) -  grav * zbeta * zws0(ji,jj) 
     319        ! turbulent heat flux averaged over depth of OSBL 
     320        zwthav(ji,jj) = 0.5 * zwth0(ji,jj) - ( 0.5*( zrad0(ji,jj) + zradh(ji,jj) ) - zradav(ji,jj) ) 
     321        ! turbulent salinity flux averaged over depth of the OBSL 
     322        zwsav(ji,jj) = 0.5 * zws0(ji,jj) 
     323        ! turbulent buoyancy flux averaged over the depth of the OBSBL 
     324        zwbav(ji,jj) = grav  * zthermal * zwthav(ji,jj) - grav  * zbeta * zwsav(ji,jj) 
     325        ! Surface upward velocity fluxes 
     326        zuw0(ji,jj) = -utau(ji,jj) * r1_rau0 * tmask(ji,jj,1) 
     327        zvw0(ji,jj) = -vtau(ji,jj) * r1_rau0 * tmask(ji,jj,1) 
     328        ! Friction velocity (zustar), at T-point : LMD94 eq. 2 
     329        zustar(ji,jj) = MAX( SQRT( SQRT( zuw0(ji,jj) * zuw0(ji,jj) + zvw0(ji,jj) * zvw0(ji,jj) ) ), 1.0e-8 ) 
     330        zcos_wind(ji,jj) = -zuw0(ji,jj) / ( zustar(ji,jj) * zustar(ji,jj) ) 
     331        zsin_wind(ji,jj) = -zvw0(ji,jj) / ( zustar(ji,jj) * zustar(ji,jj) ) 
     332     END_2D 
    334333     ! Calculate Stokes drift in direction of wind (zustke) and Stokes penetration depth (dstokes) 
    335334     SELECT CASE (nn_osm_wave) 
    336335     ! Assume constant La#=0.3 
    337336     CASE(0) 
    338         DO jj = 2, jpjm1 
    339            DO ji = 2, jpim1 
    340               zus_x = zcos_wind(ji,jj) * zustar(ji,jj) / 0.3**2 
    341               zus_y = zsin_wind(ji,jj) * zustar(ji,jj) / 0.3**2 
    342               zustke(ji,jj) = MAX ( SQRT( zus_x*zus_x + zus_y*zus_y), 1.0e-8 ) 
    343               ! dstokes(ji,jj) set to constant value rn_osm_dstokes from namelist in zdf_osm_init 
    344            END DO 
    345         END DO 
     337        DO_2D_00_00 
     338           zus_x = zcos_wind(ji,jj) * zustar(ji,jj) / 0.3**2 
     339           zus_y = zsin_wind(ji,jj) * zustar(ji,jj) / 0.3**2 
     340           zustke(ji,jj) = MAX ( SQRT( zus_x*zus_x + zus_y*zus_y), 1.0e-8 ) 
     341           ! dstokes(ji,jj) set to constant value rn_osm_dstokes from namelist in zdf_osm_init 
     342        END_2D 
    346343     ! Assume Pierson-Moskovitz wind-wave spectrum 
    347344     CASE(1) 
    348         DO jj = 2, jpjm1 
    349            DO ji = 2, jpim1 
    350               ! Use wind speed wndm included in sbc_oce module 
    351               zustke(ji,jj) = MAX ( 0.016 * wndm(ji,jj), 1.0e-8 ) 
    352               dstokes(ji,jj) = 0.12 * wndm(ji,jj)**2 / grav 
    353            END DO 
    354         END DO 
     345        DO_2D_00_00 
     346           ! Use wind speed wndm included in sbc_oce module 
     347           zustke(ji,jj) = MAX ( 0.016 * wndm(ji,jj), 1.0e-8 ) 
     348           dstokes(ji,jj) = 0.12 * wndm(ji,jj)**2 / grav 
     349        END_2D 
    355350     ! Use ECMWF wave fields as output from SBCWAVE 
    356351     CASE(2) 
    357352        zfac =  2.0_wp * rpi / 16.0_wp 
    358         DO jj = 2, jpjm1 
    359            DO ji = 2, jpim1 
    360               ! The Langmur number from the ECMWF model appears to give La<0.3 for wind-driven seas. 
    361               !    The coefficient 0.8 gives La=0.3  in this situation. 
    362               ! It could represent the effects of the spread of wave directions 
    363               ! around the mean wind. The effect of this adjustment needs to be tested. 
    364               zustke(ji,jj) = MAX ( 1.0 * ( zcos_wind(ji,jj) * ut0sd(ji,jj ) + zsin_wind(ji,jj)  * vt0sd(ji,jj) ), & 
    365                    &                zustar(ji,jj) / ( 0.45 * 0.45 )                                                  ) 
    366               dstokes(ji,jj) = MAX(zfac * hsw(ji,jj)*hsw(ji,jj) / ( MAX(zustke(ji,jj)*wmp(ji,jj), 1.0e-7 ) ), 5.0e-1) !rn_osm_dstokes ! 
    367            END DO 
    368         END DO 
     353        DO_2D_00_00 
     354           ! The Langmur number from the ECMWF model appears to give La<0.3 for wind-driven seas. 
     355           !    The coefficient 0.8 gives La=0.3  in this situation. 
     356           ! It could represent the effects of the spread of wave directions 
     357           ! around the mean wind. The effect of this adjustment needs to be tested. 
     358           zustke(ji,jj) = MAX ( 1.0 * ( zcos_wind(ji,jj) * ut0sd(ji,jj ) + zsin_wind(ji,jj)  * vt0sd(ji,jj) ), & 
     359                &                zustar(ji,jj) / ( 0.45 * 0.45 )                                                  ) 
     360           dstokes(ji,jj) = MAX(zfac * hsw(ji,jj)*hsw(ji,jj) / ( MAX(zustke(ji,jj)*wmp(ji,jj), 1.0e-7 ) ), 5.0e-1) !rn_osm_dstokes ! 
     361        END_2D 
    369362     END SELECT 
    370363 
    371364     ! Langmuir velocity scale (zwstrl), La # (zla) 
    372365     ! mixed scale (zvstr), convective velocity scale (zwstrc) 
    373      DO jj = 2, jpjm1 
    374         DO ji = 2, jpim1 
    375            ! Langmuir velocity scale (zwstrl), at T-point 
    376            zwstrl(ji,jj) = ( zustar(ji,jj) * zustar(ji,jj) * zustke(ji,jj) )**pthird 
    377            ! Modify zwstrl to allow for small and large values of dstokes/hbl. 
    378            ! Intended as a possible test. Doesn't affect LES results for entrainment, 
    379            !  but hasn't been shown to be correct as dstokes/h becomes large or small. 
    380            zwstrl(ji,jj) = zwstrl(ji,jj) *  & 
    381                 & (1.12 * ( 1.0 - ( 1.0 - EXP( -hbl(ji,jj) / dstokes(ji,jj) ) ) * dstokes(ji,jj) / hbl(ji,jj) ))**pthird * & 
    382                 & ( 1.0 - EXP( -15.0 * dstokes(ji,jj) / hbl(ji,jj) )) 
    383            ! define La this way so effects of Stokes penetration depth on velocity scale are included 
    384            zla(ji,jj) = SQRT ( zustar(ji,jj) / zwstrl(ji,jj) )**3 
    385            ! Velocity scale that tends to zustar for large Langmuir numbers 
    386            zvstr(ji,jj) = ( zwstrl(ji,jj)**3  + & 
    387                 & ( 1.0 - EXP( -0.5 * zla(ji,jj)**2 ) ) * zustar(ji,jj) * zustar(ji,jj) * zustar(ji,jj) )**pthird 
    388  
    389            ! limit maximum value of Langmuir number as approximate treatment for shear turbulence. 
    390            ! Note zustke and zwstrl are not amended. 
    391            IF ( zla(ji,jj) >= 0.45 ) zla(ji,jj) = 0.45 
    392            ! 
    393            ! get convective velocity (zwstrc), stabilty scale (zhol) and logical conection flag lconv 
    394            IF ( zwbav(ji,jj) > 0.0) THEN 
    395               zwstrc(ji,jj) = ( 2.0 * zwbav(ji,jj) * 0.9 * hbl(ji,jj) )**pthird 
    396               zhol(ji,jj) = -0.9 * hbl(ji,jj) * 2.0 * zwbav(ji,jj) / (zvstr(ji,jj)**3 + epsln ) 
    397               lconv(ji,jj) = .TRUE. 
    398            ELSE 
    399               zhol(ji,jj) = -hbl(ji,jj) *  2.0 * zwbav(ji,jj)/ (zvstr(ji,jj)**3  + epsln ) 
    400               lconv(ji,jj) = .FALSE. 
    401            ENDIF 
    402         END DO 
    403      END DO 
     366     DO_2D_00_00 
     367        ! Langmuir velocity scale (zwstrl), at T-point 
     368        zwstrl(ji,jj) = ( zustar(ji,jj) * zustar(ji,jj) * zustke(ji,jj) )**pthird 
     369        ! Modify zwstrl to allow for small and large values of dstokes/hbl. 
     370        ! Intended as a possible test. Doesn't affect LES results for entrainment, 
     371        !  but hasn't been shown to be correct as dstokes/h becomes large or small. 
     372        zwstrl(ji,jj) = zwstrl(ji,jj) *  & 
     373             & (1.12 * ( 1.0 - ( 1.0 - EXP( -hbl(ji,jj) / dstokes(ji,jj) ) ) * dstokes(ji,jj) / hbl(ji,jj) ))**pthird * & 
     374             & ( 1.0 - EXP( -15.0 * dstokes(ji,jj) / hbl(ji,jj) )) 
     375        ! define La this way so effects of Stokes penetration depth on velocity scale are included 
     376        zla(ji,jj) = SQRT ( zustar(ji,jj) / zwstrl(ji,jj) )**3 
     377        ! Velocity scale that tends to zustar for large Langmuir numbers 
     378        zvstr(ji,jj) = ( zwstrl(ji,jj)**3  + & 
     379             & ( 1.0 - EXP( -0.5 * zla(ji,jj)**2 ) ) * zustar(ji,jj) * zustar(ji,jj) * zustar(ji,jj) )**pthird 
     380 
     381        ! limit maximum value of Langmuir number as approximate treatment for shear turbulence. 
     382        ! Note zustke and zwstrl are not amended. 
     383        IF ( zla(ji,jj) >= 0.45 ) zla(ji,jj) = 0.45 
     384        ! 
     385        ! get convective velocity (zwstrc), stabilty scale (zhol) and logical conection flag lconv 
     386        IF ( zwbav(ji,jj) > 0.0) THEN 
     387           zwstrc(ji,jj) = ( 2.0 * zwbav(ji,jj) * 0.9 * hbl(ji,jj) )**pthird 
     388           zhol(ji,jj) = -0.9 * hbl(ji,jj) * 2.0 * zwbav(ji,jj) / (zvstr(ji,jj)**3 + epsln ) 
     389           lconv(ji,jj) = .TRUE. 
     390        ELSE 
     391           zhol(ji,jj) = -hbl(ji,jj) *  2.0 * zwbav(ji,jj)/ (zvstr(ji,jj)**3  + epsln ) 
     392           lconv(ji,jj) = .FALSE. 
     393        ENDIF 
     394     END_2D 
    404395 
    405396     !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     
    407398     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    408399     ! BL must be always 2 levels deep. 
    409       hbl(:,:) = MAX(hbl(:,:), gdepw_n(:,:,3) ) 
     400      hbl(:,:) = MAX(hbl(:,:), gdepw(:,:,3,Kmm) ) 
    410401      ibld(:,:) = 3 
    411       DO jk = 4, jpkm1 
    412          DO jj = 2, jpjm1 
    413             DO ji = 2, jpim1 
    414                IF ( hbl(ji,jj) >= gdepw_n(ji,jj,jk) ) THEN 
    415                   ibld(ji,jj) = MIN(mbkt(ji,jj), jk) 
    416                ENDIF 
     402      DO_3D_00_00( 4, jpkm1 ) 
     403         IF ( hbl(ji,jj) >= gdepw(ji,jj,jk,Kmm) ) THEN 
     404            ibld(ji,jj) = MIN(mbkt(ji,jj), jk) 
     405         ENDIF 
     406      END_3D 
     407 
     408      DO_2D_00_00 
     409            zthermal = rab_n(ji,jj,1,jp_tem) !ideally use ibld not 1?? 
     410            zbeta    = rab_n(ji,jj,1,jp_sal) 
     411            zt   = 0._wp 
     412            zs   = 0._wp 
     413            zu   = 0._wp 
     414            zv   = 0._wp 
     415            ! average over depth of boundary layer 
     416            zthick=0._wp 
     417            DO jm = 2, ibld(ji,jj) 
     418               zthick=zthick+e3t(ji,jj,jm,Kmm) 
     419               zt   = zt  + e3t(ji,jj,jm,Kmm) * ts(ji,jj,jm,jp_tem,Kmm) 
     420               zs   = zs  + e3t(ji,jj,jm,Kmm) * ts(ji,jj,jm,jp_sal,Kmm) 
     421               zu   = zu  + e3t(ji,jj,jm,Kmm) & 
     422                  &            * ( uu(ji,jj,jm,Kbb) + uu(ji - 1,jj,jm,Kbb) ) & 
     423                  &            / MAX( 1. , umask(ji,jj,jm) + umask(ji - 1,jj,jm) ) 
     424               zv   = zv  + e3t(ji,jj,jm,Kmm) & 
     425                  &            * ( vv(ji,jj,jm,Kbb) + vv(ji,jj - 1,jm,Kbb) ) & 
     426                  &            / MAX( 1. , vmask(ji,jj,jm) + vmask(ji,jj - 1,jm) ) 
    417427            END DO 
    418          END DO 
    419       END DO 
    420  
    421       DO jj = 2, jpjm1                                 !  Vertical slab 
    422          DO ji = 2, jpim1 
    423                zthermal = rab_n(ji,jj,1,jp_tem) !ideally use ibld not 1?? 
    424                zbeta    = rab_n(ji,jj,1,jp_sal) 
    425                zt   = 0._wp 
    426                zs   = 0._wp 
    427                zu   = 0._wp 
    428                zv   = 0._wp 
    429                ! average over depth of boundary layer 
    430                zthick=0._wp 
    431                DO jm = 2, ibld(ji,jj) 
    432                   zthick=zthick+e3t_n(ji,jj,jm) 
    433                   zt   = zt  + e3t_n(ji,jj,jm) * tsn(ji,jj,jm,jp_tem) 
    434                   zs   = zs  + e3t_n(ji,jj,jm) * tsn(ji,jj,jm,jp_sal) 
    435                   zu   = zu  + e3t_n(ji,jj,jm) & 
    436                      &            * ( ub(ji,jj,jm) + ub(ji - 1,jj,jm) ) & 
    437                      &            / MAX( 1. , umask(ji,jj,jm) + umask(ji - 1,jj,jm) ) 
    438                   zv   = zv  + e3t_n(ji,jj,jm) & 
    439                      &            * ( vb(ji,jj,jm) + vb(ji,jj - 1,jm) ) & 
    440                      &            / MAX( 1. , vmask(ji,jj,jm) + vmask(ji,jj - 1,jm) ) 
    441                END DO 
    442                zt_bl(ji,jj) = zt / zthick 
    443                zs_bl(ji,jj) = zs / zthick 
    444                zu_bl(ji,jj) = zu / zthick 
    445                zv_bl(ji,jj) = zv / zthick 
    446                zdt_bl(ji,jj) = zt_bl(ji,jj) - tsn(ji,jj,ibld(ji,jj),jp_tem) 
    447                zds_bl(ji,jj) = zs_bl(ji,jj) - tsn(ji,jj,ibld(ji,jj),jp_sal) 
    448                zdu_bl(ji,jj) = zu_bl(ji,jj) - ( ub(ji,jj,ibld(ji,jj)) + ub(ji-1,jj,ibld(ji,jj) ) ) & 
    449                      &    / MAX(1. , umask(ji,jj,ibld(ji,jj) ) + umask(ji-1,jj,ibld(ji,jj) ) ) 
    450                zdv_bl(ji,jj) = zv_bl(ji,jj) - ( vb(ji,jj,ibld(ji,jj)) + vb(ji,jj-1,ibld(ji,jj) ) ) & 
    451                      &   / MAX(1. , vmask(ji,jj,ibld(ji,jj) ) + vmask(ji,jj-1,ibld(ji,jj) ) ) 
    452                zdb_bl(ji,jj) = grav * zthermal * zdt_bl(ji,jj) - grav * zbeta * zds_bl(ji,jj) 
    453                IF ( lconv(ji,jj) ) THEN    ! Convective 
    454                       zwb_ent(ji,jj) = -( 2.0 * 0.2 * zwbav(ji,jj) & 
    455                            &            + 0.135 * zla(ji,jj) * zwstrl(ji,jj)**3/hbl(ji,jj) ) 
    456  
    457                       zvel_max =  - ( 1.0 + 1.0 * ( zwstrl(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * rn_rdt / hbl(ji,jj) ) & 
    458                            &   * zwb_ent(ji,jj) / ( zwstrl(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird 
     428            zt_bl(ji,jj) = zt / zthick 
     429            zs_bl(ji,jj) = zs / zthick 
     430            zu_bl(ji,jj) = zu / zthick 
     431            zv_bl(ji,jj) = zv / zthick 
     432            zdt_bl(ji,jj) = zt_bl(ji,jj) - ts(ji,jj,ibld(ji,jj),jp_tem,Kmm) 
     433            zds_bl(ji,jj) = zs_bl(ji,jj) - ts(ji,jj,ibld(ji,jj),jp_sal,Kmm) 
     434            zdu_bl(ji,jj) = zu_bl(ji,jj) - ( uu(ji,jj,ibld(ji,jj),Kbb) + uu(ji-1,jj,ibld(ji,jj) ,Kbb) ) & 
     435                  &    / MAX(1. , umask(ji,jj,ibld(ji,jj) ) + umask(ji-1,jj,ibld(ji,jj) ) ) 
     436            zdv_bl(ji,jj) = zv_bl(ji,jj) - ( vv(ji,jj,ibld(ji,jj),Kbb) + vv(ji,jj-1,ibld(ji,jj) ,Kbb) ) & 
     437                  &   / MAX(1. , vmask(ji,jj,ibld(ji,jj) ) + vmask(ji,jj-1,ibld(ji,jj) ) ) 
     438            zdb_bl(ji,jj) = grav * zthermal * zdt_bl(ji,jj) - grav * zbeta * zds_bl(ji,jj) 
     439            IF ( lconv(ji,jj) ) THEN    ! Convective 
     440                   zwb_ent(ji,jj) = -( 2.0 * 0.2 * zwbav(ji,jj) & 
     441                        &            + 0.135 * zla(ji,jj) * zwstrl(ji,jj)**3/hbl(ji,jj) ) 
     442 
     443                   zvel_max =  - ( 1.0 + 1.0 * ( zwstrl(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * rn_rdt / hbl(ji,jj) ) & 
     444                        &   * zwb_ent(ji,jj) / ( zwstrl(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird 
    459445! Entrainment including component due to shear turbulence. Modified Langmuir component, but gives same result for La=0.3 For testing uncomment. 
    460446!                      zwb_ent(ji,jj) = -( 2.0 * 0.2 * zwbav(ji,jj) & 
     
    463449!                      zvel_max = - ( 1.0 + 1.0 * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * rn_rdt / zhbl(ji,jj) ) * zwb_ent(ji,jj) / & 
    464450!                           &       ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird 
    465                       zzdhdt = - zwb_ent(ji,jj) / ( zvel_max + MAX(zdb_bl(ji,jj),0.0) ) 
    466                ELSE                        ! Stable 
    467                       zzdhdt = 0.32 * ( hbli(ji,jj) / hbl(ji,jj) -1.0 ) * zwstrl(ji,jj)**3 / hbli(ji,jj) & 
    468                            &   + ( ( 0.32 / 3.0 ) * exp ( -2.5 * ( hbli(ji,jj) / hbl(ji,jj) - 1.0 ) ) & 
    469                            & - ( 0.32 / 3.0 - 0.135 * zla(ji,jj) ) * exp ( -12.5 * ( hbli(ji,jj) / hbl(ji,jj) ) ) ) & 
    470                            &  * zwstrl(ji,jj)**3 / hbli(ji,jj) 
    471                       zzdhdt = zzdhdt + zwbav(ji,jj) 
    472                       IF ( zzdhdt < 0._wp ) THEN 
    473                       ! For long timsteps factor in brackets slows the rapid collapse of the OSBL 
    474                          zpert   = 2.0 * ( 1.0 + 2.0 * zwstrl(ji,jj) * rn_rdt / hbl(ji,jj) ) * zwstrl(ji,jj)**2 / hbl(ji,jj) 
    475                       ELSE 
    476                          zpert   = 2.0 * ( 1.0 + 2.0 * zwstrl(ji,jj) * rn_rdt / hbl(ji,jj) ) * zwstrl(ji,jj)**2 / hbl(ji,jj) & 
    477                               &  + MAX( zdb_bl(ji,jj), 0.0 ) 
    478                       ENDIF 
    479                       zzdhdt = 2.0 * zzdhdt / zpert 
    480                ENDIF 
    481                zdhdt(ji,jj) = zzdhdt 
    482            END DO 
    483       END DO 
     451                   zzdhdt = - zwb_ent(ji,jj) / ( zvel_max + MAX(zdb_bl(ji,jj),0.0) ) 
     452            ELSE                        ! Stable 
     453                   zzdhdt = 0.32 * ( hbli(ji,jj) / hbl(ji,jj) -1.0 ) * zwstrl(ji,jj)**3 / hbli(ji,jj) & 
     454                        &   + ( ( 0.32 / 3.0 ) * exp ( -2.5 * ( hbli(ji,jj) / hbl(ji,jj) - 1.0 ) ) & 
     455                        & - ( 0.32 / 3.0 - 0.135 * zla(ji,jj) ) * exp ( -12.5 * ( hbli(ji,jj) / hbl(ji,jj) ) ) ) & 
     456                        &  * zwstrl(ji,jj)**3 / hbli(ji,jj) 
     457                   zzdhdt = zzdhdt + zwbav(ji,jj) 
     458                   IF ( zzdhdt < 0._wp ) THEN 
     459                   ! For long timsteps factor in brackets slows the rapid collapse of the OSBL 
     460                      zpert   = 2.0 * ( 1.0 + 2.0 * zwstrl(ji,jj) * rn_rdt / hbl(ji,jj) ) * zwstrl(ji,jj)**2 / hbl(ji,jj) 
     461                   ELSE 
     462                      zpert   = 2.0 * ( 1.0 + 2.0 * zwstrl(ji,jj) * rn_rdt / hbl(ji,jj) ) * zwstrl(ji,jj)**2 / hbl(ji,jj) & 
     463                           &  + MAX( zdb_bl(ji,jj), 0.0 ) 
     464                   ENDIF 
     465                   zzdhdt = 2.0 * zzdhdt / zpert 
     466            ENDIF 
     467            zdhdt(ji,jj) = zzdhdt 
     468      END_2D 
    484469 
    485470      ! Calculate averages over depth of boundary layer 
     
    487472      ibld(:,:) = 3 
    488473 
    489       zhbl_t(:,:) = hbl(:,:) + (zdhdt(:,:) - wn(ji,jj,ibld(ji,jj)))* rn_rdt ! certainly need wb here, so subtract it 
    490       zhbl_t(:,:) = MIN(zhbl_t(:,:), ht_n(:,:)) 
    491       zdhdt(:,:) = MIN(zdhdt(:,:), (zhbl_t(:,:) - hbl(:,:))/rn_rdt + wn(ji,jj,ibld(ji,jj))) ! adjustment to represent limiting by ocean bottom 
    492  
    493       DO jk = 4, jpkm1 
    494          DO jj = 2, jpjm1 
    495             DO ji = 2, jpim1 
    496                IF ( zhbl_t(ji,jj) >= gdepw_n(ji,jj,jk) ) THEN 
    497                   ibld(ji,jj) =  MIN(mbkt(ji,jj), jk) 
    498                ENDIF 
    499             END DO 
    500          END DO 
    501       END DO 
     474      zhbl_t(:,:) = hbl(:,:) + (zdhdt(:,:) - ww(ji,jj,ibld(ji,jj)))* rn_rdt ! certainly need wb here, so subtract it 
     475      zhbl_t(:,:) = MIN(zhbl_t(:,:), ht(:,:)) 
     476      zdhdt(:,:) = MIN(zdhdt(:,:), (zhbl_t(:,:) - hbl(:,:))/rn_rdt + ww(ji,jj,ibld(ji,jj))) ! adjustment to represent limiting by ocean bottom 
     477 
     478      DO_3D_00_00( 4, jpkm1 ) 
     479         IF ( zhbl_t(ji,jj) >= gdepw(ji,jj,jk,Kmm) ) THEN 
     480            ibld(ji,jj) =  MIN(mbkt(ji,jj), jk) 
     481         ENDIF 
     482      END_3D 
    502483 
    503484! 
    504485! Step through model levels taking account of buoyancy change to determine the effect on dhdt 
    505486! 
    506       DO jj = 2, jpjm1 
    507          DO ji = 2, jpim1 
    508             IF ( ibld(ji,jj) - imld(ji,jj) > 1 ) THEN 
     487      DO_2D_00_00 
     488         IF ( ibld(ji,jj) - imld(ji,jj) > 1 ) THEN 
    509489! 
    510490! If boundary layer changes by more than one level, need to check for stable layers between initial and final depths. 
    511491! 
    512                zhbl_s = hbl(ji,jj) 
    513                jm = imld(ji,jj) 
    514                zthermal = rab_n(ji,jj,1,jp_tem) 
    515                zbeta = rab_n(ji,jj,1,jp_sal) 
    516                IF ( lconv(ji,jj) ) THEN 
     492            zhbl_s = hbl(ji,jj) 
     493            jm = imld(ji,jj) 
     494            zthermal = rab_n(ji,jj,1,jp_tem) 
     495            zbeta = rab_n(ji,jj,1,jp_sal) 
     496            IF ( lconv(ji,jj) ) THEN 
    517497!unstable 
    518                   zvel_max =  - ( 1.0 + 1.0 * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * rn_rdt / hbl(ji,jj) ) & 
    519                        &   * zwb_ent(ji,jj) / ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird 
    520  
    521                   DO jk = imld(ji,jj), ibld(ji,jj) 
    522                      zdb = MAX( grav * ( zthermal * ( zt_bl(ji,jj) - tsn(ji,jj,jm,jp_tem) ) & 
    523                           & - zbeta * ( zs_bl(ji,jj) - tsn(ji,jj,jm,jp_sal) ) ), 0.0 ) + zvel_max 
    524  
    525                      zhbl_s = zhbl_s + MIN( - zwb_ent(ji,jj) / zdb * rn_rdt / FLOAT(ibld(ji,jj)-imld(ji,jj) ), e3w_n(ji,jj,jk) ) 
    526                      zhbl_s = MIN(zhbl_s, ht_n(ji,jj)) 
    527  
    528                      IF ( zhbl_s >= gdepw_n(ji,jj,jm+1) ) jm = jm + 1 
    529                   END DO 
    530                   hbl(ji,jj) = zhbl_s 
    531                   ibld(ji,jj) = jm 
    532                   hbli(ji,jj) = hbl(ji,jj) 
    533                ELSE 
     498               zvel_max =  - ( 1.0 + 1.0 * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * rn_rdt / hbl(ji,jj) ) & 
     499                    &   * zwb_ent(ji,jj) / ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird 
     500 
     501               DO jk = imld(ji,jj), ibld(ji,jj) 
     502                  zdb = MAX( grav * ( zthermal * ( zt_bl(ji,jj) - ts(ji,jj,jm,jp_tem,Kmm) ) & 
     503                       & - zbeta * ( zs_bl(ji,jj) - ts(ji,jj,jm,jp_sal,Kmm) ) ), 0.0 ) + zvel_max 
     504 
     505                  zhbl_s = zhbl_s + MIN( - zwb_ent(ji,jj) / zdb * rn_rdt / FLOAT(ibld(ji,jj)-imld(ji,jj) ), e3w(ji,jj,jk,Kmm) ) 
     506                  zhbl_s = MIN(zhbl_s, ht(ji,jj)) 
     507 
     508                  IF ( zhbl_s >= gdepw(ji,jj,jm+1,Kmm) ) jm = jm + 1 
     509               END DO 
     510               hbl(ji,jj) = zhbl_s 
     511               ibld(ji,jj) = jm 
     512               hbli(ji,jj) = hbl(ji,jj) 
     513            ELSE 
    534514! stable 
    535                   DO jk = imld(ji,jj), ibld(ji,jj) 
    536                      zdb = MAX( grav * ( zthermal * ( zt_bl(ji,jj) - tsn(ji,jj,jm,jp_tem) )          & 
    537                           &               - zbeta * ( zs_bl(ji,jj) - tsn(ji,jj,jm,jp_sal) ) ), 0.0 ) & 
    538                           & + 2.0 * zwstrl(ji,jj)**2 / zhbl_s 
    539  
    540                      zhbl_s = zhbl_s +  (                                                                                & 
    541                           &                     0.32         *                         ( hbli(ji,jj) / zhbl_s -1.0 )     & 
    542                           &               * zwstrl(ji,jj)**3 / hbli(ji,jj)                                               & 
    543                           &               + ( ( 0.32 / 3.0 )           * EXP( -  2.5 * ( hbli(ji,jj) / zhbl_s -1.0 ) )   & 
    544                           &               -   ( 0.32 / 3.0  - 0.0485 ) * EXP( - 12.5 * ( hbli(ji,jj) / zhbl_s      ) ) ) & 
    545                           &          * zwstrl(ji,jj)**3 / hbli(ji,jj) ) / zdb * e3w_n(ji,jj,jk) / zdhdt(ji,jj)  ! ALMG to investigate whether need to include wn here 
    546  
    547                      zhbl_s = MIN(zhbl_s, ht_n(ji,jj)) 
    548                      IF ( zhbl_s >= gdepw_n(ji,jj,jm) ) jm = jm + 1 
    549                   END DO 
    550                   hbl(ji,jj) = MAX(zhbl_s, gdepw_n(ji,jj,3) ) 
    551                   ibld(ji,jj) = MAX(jm, 3 ) 
    552                   IF ( hbl(ji,jj) > hbli(ji,jj) ) hbli(ji,jj) = hbl(ji,jj) 
    553                ENDIF   ! IF ( lconv ) 
     515               DO jk = imld(ji,jj), ibld(ji,jj) 
     516                  zdb = MAX( grav * ( zthermal * ( zt_bl(ji,jj) - ts(ji,jj,jm,jp_tem,Kmm) )          & 
     517                       &               - zbeta * ( zs_bl(ji,jj) - ts(ji,jj,jm,jp_sal,Kmm) ) ), 0.0 ) & 
     518                       & + 2.0 * zwstrl(ji,jj)**2 / zhbl_s 
     519 
     520                  zhbl_s = zhbl_s +  (                                                                                & 
     521                       &                     0.32         *                         ( hbli(ji,jj) / zhbl_s -1.0 )     & 
     522                       &               * zwstrl(ji,jj)**3 / hbli(ji,jj)                                               & 
     523                       &               + ( ( 0.32 / 3.0 )           * EXP( -  2.5 * ( hbli(ji,jj) / zhbl_s -1.0 ) )   & 
     524                       &               -   ( 0.32 / 3.0  - 0.0485 ) * EXP( - 12.5 * ( hbli(ji,jj) / zhbl_s      ) ) ) & 
     525                       &          * zwstrl(ji,jj)**3 / hbli(ji,jj) ) / zdb * e3w(ji,jj,jk,Kmm) / zdhdt(ji,jj)  ! ALMG to investigate whether need to include ww here 
     526 
     527                  zhbl_s = MIN(zhbl_s, ht(ji,jj)) 
     528                  IF ( zhbl_s >= gdepw(ji,jj,jm,Kmm) ) jm = jm + 1 
     529               END DO 
     530               hbl(ji,jj) = MAX(zhbl_s, gdepw(ji,jj,3,Kmm) ) 
     531               ibld(ji,jj) = MAX(jm, 3 ) 
     532               IF ( hbl(ji,jj) > hbli(ji,jj) ) hbli(ji,jj) = hbl(ji,jj) 
     533            ENDIF   ! IF ( lconv ) 
     534         ELSE 
     535! change zero or one model level. 
     536            hbl(ji,jj) = zhbl_t(ji,jj) 
     537            IF ( lconv(ji,jj) ) THEN 
     538               hbli(ji,jj) = hbl(ji,jj) 
    554539            ELSE 
    555 ! change zero or one model level. 
    556                hbl(ji,jj) = zhbl_t(ji,jj) 
    557                IF ( lconv(ji,jj) ) THEN 
    558                   hbli(ji,jj) = hbl(ji,jj) 
    559                ELSE 
    560                   hbl(ji,jj) = MAX(hbl(ji,jj), gdepw_n(ji,jj,3) ) 
    561                   IF ( hbl(ji,jj) > hbli(ji,jj) ) hbli(ji,jj) = hbl(ji,jj) 
    562                ENDIF 
     540               hbl(ji,jj) = MAX(hbl(ji,jj), gdepw(ji,jj,3,Kmm) ) 
     541               IF ( hbl(ji,jj) > hbli(ji,jj) ) hbli(ji,jj) = hbl(ji,jj) 
    563542            ENDIF 
    564             zhbl(ji,jj) = gdepw_n(ji,jj,ibld(ji,jj)) 
    565          END DO 
    566       END DO 
     543         ENDIF 
     544         zhbl(ji,jj) = gdepw(ji,jj,ibld(ji,jj),Kmm) 
     545      END_2D 
    567546      dstokes(:,:) = MIN ( dstokes(:,:), hbl(:,:)/3. )  !  Limit delta for shallow boundary layers for calculating flux-gradient terms. 
    568547 
     
    570549     ! Consider later  combining this into the loop above and looking for columns 
    571550     ! where the index for base of the boundary layer have changed 
    572       DO jj = 2, jpjm1                                 !  Vertical slab 
    573          DO ji = 2, jpim1 
    574                zthermal = rab_n(ji,jj,1,jp_tem) !ideally use ibld not 1?? 
    575                zbeta    = rab_n(ji,jj,1,jp_sal) 
    576                zt   = 0._wp 
    577                zs   = 0._wp 
    578                zu   = 0._wp 
    579                zv   = 0._wp 
    580                ! average over depth of boundary layer 
    581                zthick=0._wp 
    582                DO jm = 2, ibld(ji,jj) 
    583                   zthick=zthick+e3t_n(ji,jj,jm) 
    584                   zt   = zt  + e3t_n(ji,jj,jm) * tsn(ji,jj,jm,jp_tem) 
    585                   zs   = zs  + e3t_n(ji,jj,jm) * tsn(ji,jj,jm,jp_sal) 
    586                   zu   = zu  + e3t_n(ji,jj,jm) & 
    587                      &            * ( ub(ji,jj,jm) + ub(ji - 1,jj,jm) ) & 
    588                      &            / MAX( 1. , umask(ji,jj,jm) + umask(ji - 1,jj,jm) ) 
    589                   zv   = zv  + e3t_n(ji,jj,jm) & 
    590                      &            * ( vb(ji,jj,jm) + vb(ji,jj - 1,jm) ) & 
    591                      &            / MAX( 1. , vmask(ji,jj,jm) + vmask(ji,jj - 1,jm) ) 
    592                END DO 
    593                zt_bl(ji,jj) = zt / zthick 
    594                zs_bl(ji,jj) = zs / zthick 
    595                zu_bl(ji,jj) = zu / zthick 
    596                zv_bl(ji,jj) = zv / zthick 
    597                zdt_bl(ji,jj) = zt_bl(ji,jj) - tsn(ji,jj,ibld(ji,jj),jp_tem) 
    598                zds_bl(ji,jj) = zs_bl(ji,jj) - tsn(ji,jj,ibld(ji,jj),jp_sal) 
    599                zdu_bl(ji,jj) = zu_bl(ji,jj) - ( ub(ji,jj,ibld(ji,jj)) + ub(ji-1,jj,ibld(ji,jj) ) ) & 
    600                       &   / MAX(1. , umask(ji,jj,ibld(ji,jj) ) + umask(ji-1,jj,ibld(ji,jj) ) ) 
    601                zdv_bl(ji,jj) = zv_bl(ji,jj) - ( vb(ji,jj,ibld(ji,jj)) + vb(ji,jj-1,ibld(ji,jj) ) ) & 
    602                       &  / MAX(1. , vmask(ji,jj,ibld(ji,jj) ) + vmask(ji,jj-1,ibld(ji,jj) ) ) 
    603                zdb_bl(ji,jj) = grav * zthermal * zdt_bl(ji,jj) - grav * zbeta * zds_bl(ji,jj) 
    604                zhbl(ji,jj) = gdepw_n(ji,jj,ibld(ji,jj)) 
    605                IF ( lconv(ji,jj) ) THEN 
    606                   IF ( zdb_bl(ji,jj) > 0._wp )THEN 
    607                      IF ( ( zwstrc(ji,jj) / zvstr(ji,jj) )**3 <= 0.5 ) THEN  ! near neutral stability 
    608                            zari = 4.5 * ( zvstr(ji,jj)**2 ) & 
    609                              & / ( zdb_bl(ji,jj) * zhbl(ji,jj) ) + 0.01 
    610                      ELSE                                                     ! unstable 
    611                            zari = 4.5 * ( zwstrc(ji,jj)**2 ) & 
    612                              & / ( zdb_bl(ji,jj) * zhbl(ji,jj) ) + 0.01 
    613                      ENDIF 
    614                      IF ( zari > 0.2 ) THEN                                                ! This test checks for weakly stratified pycnocline 
    615                         zari = 0.2 
    616                         zwb_ent(ji,jj) = 0._wp 
    617                      ENDIF 
    618                      inhml = MAX( INT( zari * zhbl(ji,jj) / e3t_n(ji,jj,ibld(ji,jj)) ) , 1 ) 
     551      DO_2D_00_00 
     552            zthermal = rab_n(ji,jj,1,jp_tem) !ideally use ibld not 1?? 
     553            zbeta    = rab_n(ji,jj,1,jp_sal) 
     554            zt   = 0._wp 
     555            zs   = 0._wp 
     556            zu   = 0._wp 
     557            zv   = 0._wp 
     558            ! average over depth of boundary layer 
     559            zthick=0._wp 
     560            DO jm = 2, ibld(ji,jj) 
     561               zthick=zthick+e3t(ji,jj,jm,Kmm) 
     562               zt   = zt  + e3t(ji,jj,jm,Kmm) * ts(ji,jj,jm,jp_tem,Kmm) 
     563               zs   = zs  + e3t(ji,jj,jm,Kmm) * ts(ji,jj,jm,jp_sal,Kmm) 
     564               zu   = zu  + e3t(ji,jj,jm,Kmm) & 
     565                  &            * ( uu(ji,jj,jm,Kbb) + uu(ji - 1,jj,jm,Kbb) ) & 
     566                  &            / MAX( 1. , umask(ji,jj,jm) + umask(ji - 1,jj,jm) ) 
     567               zv   = zv  + e3t(ji,jj,jm,Kmm) & 
     568                  &            * ( vv(ji,jj,jm,Kbb) + vv(ji,jj - 1,jm,Kbb) ) & 
     569                  &            / MAX( 1. , vmask(ji,jj,jm) + vmask(ji,jj - 1,jm) ) 
     570            END DO 
     571            zt_bl(ji,jj) = zt / zthick 
     572            zs_bl(ji,jj) = zs / zthick 
     573            zu_bl(ji,jj) = zu / zthick 
     574            zv_bl(ji,jj) = zv / zthick 
     575            zdt_bl(ji,jj) = zt_bl(ji,jj) - ts(ji,jj,ibld(ji,jj),jp_tem,Kmm) 
     576            zds_bl(ji,jj) = zs_bl(ji,jj) - ts(ji,jj,ibld(ji,jj),jp_sal,Kmm) 
     577            zdu_bl(ji,jj) = zu_bl(ji,jj) - ( uu(ji,jj,ibld(ji,jj),Kbb) + uu(ji-1,jj,ibld(ji,jj) ,Kbb) ) & 
     578                   &   / MAX(1. , umask(ji,jj,ibld(ji,jj) ) + umask(ji-1,jj,ibld(ji,jj) ) ) 
     579            zdv_bl(ji,jj) = zv_bl(ji,jj) - ( vv(ji,jj,ibld(ji,jj),Kbb) + vv(ji,jj-1,ibld(ji,jj) ,Kbb) ) & 
     580                   &  / MAX(1. , vmask(ji,jj,ibld(ji,jj) ) + vmask(ji,jj-1,ibld(ji,jj) ) ) 
     581            zdb_bl(ji,jj) = grav * zthermal * zdt_bl(ji,jj) - grav * zbeta * zds_bl(ji,jj) 
     582            zhbl(ji,jj) = gdepw(ji,jj,ibld(ji,jj),Kmm) 
     583            IF ( lconv(ji,jj) ) THEN 
     584               IF ( zdb_bl(ji,jj) > 0._wp )THEN 
     585                  IF ( ( zwstrc(ji,jj) / zvstr(ji,jj) )**3 <= 0.5 ) THEN  ! near neutral stability 
     586                        zari = 4.5 * ( zvstr(ji,jj)**2 ) & 
     587                          & / ( zdb_bl(ji,jj) * zhbl(ji,jj) ) + 0.01 
     588                  ELSE                                                     ! unstable 
     589                        zari = 4.5 * ( zwstrc(ji,jj)**2 ) & 
     590                          & / ( zdb_bl(ji,jj) * zhbl(ji,jj) ) + 0.01 
     591                  ENDIF 
     592                  IF ( zari > 0.2 ) THEN                                                ! This test checks for weakly stratified pycnocline 
     593                     zari = 0.2 
     594                     zwb_ent(ji,jj) = 0._wp 
     595                  ENDIF 
     596                  inhml = MAX( INT( zari * zhbl(ji,jj) / e3t(ji,jj,ibld(ji,jj),Kmm) ) , 1 ) 
     597                  imld(ji,jj) = MAX( ibld(ji,jj) - inhml, 1) 
     598                  zhml(ji,jj) = gdepw(ji,jj,imld(ji,jj),Kmm) 
     599                  zdh(ji,jj) = zhbl(ji,jj) - zhml(ji,jj) 
     600               ELSE  ! IF (zdb_bl) 
     601                  imld(ji,jj) = ibld(ji,jj) - 1 
     602                  zhml(ji,jj) = gdepw(ji,jj,imld(ji,jj),Kmm) 
     603                  zdh(ji,jj) = zhbl(ji,jj) - zhml(ji,jj) 
     604               ENDIF 
     605            ELSE   ! IF (lconv) 
     606               IF ( zdhdt(ji,jj) >= 0.0 ) THEN    ! probably shouldn't include wm here 
     607               ! boundary layer deepening 
     608                  IF ( zdb_bl(ji,jj) > 0._wp ) THEN 
     609               ! pycnocline thickness set by stratification - use same relationship as for neutral conditions. 
     610                     zari = MIN( 4.5 * ( zvstr(ji,jj)**2 ) & 
     611                       & / ( zdb_bl(ji,jj) * zhbl(ji,jj) ) + 0.01  , 0.2 ) 
     612                     inhml = MAX( INT( zari * zhbl(ji,jj) / e3t(ji,jj,ibld(ji,jj),Kmm) ) , 1 ) 
    619613                     imld(ji,jj) = MAX( ibld(ji,jj) - inhml, 1) 
    620                      zhml(ji,jj) = gdepw_n(ji,jj,imld(ji,jj)) 
     614                     zhml(ji,jj) = gdepw(ji,jj,imld(ji,jj),Kmm) 
    621615                     zdh(ji,jj) = zhbl(ji,jj) - zhml(ji,jj) 
    622                   ELSE  ! IF (zdb_bl) 
     616                  ELSE 
    623617                     imld(ji,jj) = ibld(ji,jj) - 1 
    624                      zhml(ji,jj) = gdepw_n(ji,jj,imld(ji,jj)) 
     618                     zhml(ji,jj) = gdepw(ji,jj,imld(ji,jj),Kmm) 
    625619                     zdh(ji,jj) = zhbl(ji,jj) - zhml(ji,jj) 
    626                   ENDIF 
    627                ELSE   ! IF (lconv) 
    628                   IF ( zdhdt(ji,jj) >= 0.0 ) THEN    ! probably shouldn't include wm here 
    629                   ! boundary layer deepening 
    630                      IF ( zdb_bl(ji,jj) > 0._wp ) THEN 
    631                   ! pycnocline thickness set by stratification - use same relationship as for neutral conditions. 
    632                         zari = MIN( 4.5 * ( zvstr(ji,jj)**2 ) & 
    633                           & / ( zdb_bl(ji,jj) * zhbl(ji,jj) ) + 0.01  , 0.2 ) 
    634                         inhml = MAX( INT( zari * zhbl(ji,jj) / e3t_n(ji,jj,ibld(ji,jj)) ) , 1 ) 
    635                         imld(ji,jj) = MAX( ibld(ji,jj) - inhml, 1) 
    636                         zhml(ji,jj) = gdepw_n(ji,jj,imld(ji,jj)) 
    637                         zdh(ji,jj) = zhbl(ji,jj) - zhml(ji,jj) 
    638                      ELSE 
    639                         imld(ji,jj) = ibld(ji,jj) - 1 
    640                         zhml(ji,jj) = gdepw_n(ji,jj,imld(ji,jj)) 
    641                         zdh(ji,jj) = zhbl(ji,jj) - zhml(ji,jj) 
    642                      ENDIF ! IF (zdb_bl > 0.0) 
    643                   ELSE     ! IF(dhdt >= 0) 
    644                   ! boundary layer collapsing. 
    645                      imld(ji,jj) = ibld(ji,jj) 
    646                      zhml(ji,jj) = zhbl(ji,jj) 
    647                      zdh(ji,jj) = 0._wp 
    648                   ENDIF    ! IF (dhdt >= 0) 
    649                ENDIF       ! IF (lconv) 
    650          END DO 
    651       END DO 
     620                  ENDIF ! IF (zdb_bl > 0.0) 
     621               ELSE     ! IF(dhdt >= 0) 
     622               ! boundary layer collapsing. 
     623                  imld(ji,jj) = ibld(ji,jj) 
     624                  zhml(ji,jj) = zhbl(ji,jj) 
     625                  zdh(ji,jj) = 0._wp 
     626               ENDIF    ! IF (dhdt >= 0) 
     627            ENDIF       ! IF (lconv) 
     628      END_2D 
    652629 
    653630      ! Average over the depth of the mixed layer in the convective boundary layer 
    654631      ! Also calculate entrainment fluxes for temperature and salinity 
    655       DO jj = 2, jpjm1                                 !  Vertical slab 
    656          DO ji = 2, jpim1 
    657             zthermal = rab_n(ji,jj,1,jp_tem) !ideally use ibld not 1?? 
    658             zbeta    = rab_n(ji,jj,1,jp_sal) 
    659             IF ( lconv(ji,jj) ) THEN 
     632      DO_2D_00_00 
     633         zthermal = rab_n(ji,jj,1,jp_tem) !ideally use ibld not 1?? 
     634         zbeta    = rab_n(ji,jj,1,jp_sal) 
     635         IF ( lconv(ji,jj) ) THEN 
     636            zt   = 0._wp 
     637            zs   = 0._wp 
     638            zu   = 0._wp 
     639            zv   = 0._wp 
     640            ! average over depth of boundary layer 
     641            zthick=0._wp 
     642            DO jm = 2, imld(ji,jj) 
     643               zthick=zthick+e3t(ji,jj,jm,Kmm) 
     644               zt   = zt  + e3t(ji,jj,jm,Kmm) * ts(ji,jj,jm,jp_tem,Kmm) 
     645               zs   = zs  + e3t(ji,jj,jm,Kmm) * ts(ji,jj,jm,jp_sal,Kmm) 
     646               zu   = zu  + e3t(ji,jj,jm,Kmm) & 
     647                  &            * ( uu(ji,jj,jm,Kbb) + uu(ji - 1,jj,jm,Kbb) ) & 
     648                  &            / MAX( 1. , umask(ji,jj,jm) + umask(ji - 1,jj,jm) ) 
     649               zv   = zv  + e3t(ji,jj,jm,Kmm) & 
     650                  &            * ( vv(ji,jj,jm,Kbb) + vv(ji,jj - 1,jm,Kbb) ) & 
     651                  &            / MAX( 1. , vmask(ji,jj,jm) + vmask(ji,jj - 1,jm) ) 
     652            END DO 
     653            zt_ml(ji,jj) = zt / zthick 
     654            zs_ml(ji,jj) = zs / zthick 
     655            zu_ml(ji,jj) = zu / zthick 
     656            zv_ml(ji,jj) = zv / zthick 
     657            zdt_ml(ji,jj) = zt_ml(ji,jj) - ts(ji,jj,ibld(ji,jj),jp_tem,Kmm) 
     658            zds_ml(ji,jj) = zs_ml(ji,jj) - ts(ji,jj,ibld(ji,jj),jp_sal,Kmm) 
     659            zdu_ml(ji,jj) = zu_ml(ji,jj) - ( uu(ji,jj,ibld(ji,jj),Kbb) + uu(ji-1,jj,ibld(ji,jj) ,Kbb) ) & 
     660                  &    / MAX(1. , umask(ji,jj,ibld(ji,jj) ) + umask(ji-1,jj,ibld(ji,jj) ) ) 
     661            zdv_ml(ji,jj) = zv_ml(ji,jj) - ( vv(ji,jj,ibld(ji,jj),Kbb) + vv(ji,jj-1,ibld(ji,jj) ,Kbb) ) & 
     662                  &    / MAX(1. , vmask(ji,jj,ibld(ji,jj) ) + vmask(ji,jj-1,ibld(ji,jj) ) ) 
     663            zdb_ml(ji,jj) = grav * zthermal * zdt_ml(ji,jj) - grav * zbeta * zds_ml(ji,jj) 
     664         ELSE 
     665         ! stable, if entraining calulate average below interface layer. 
     666            IF ( zdhdt(ji,jj) >= 0._wp ) THEN 
    660667               zt   = 0._wp 
    661668               zs   = 0._wp 
     
    665672               zthick=0._wp 
    666673               DO jm = 2, imld(ji,jj) 
    667                   zthick=zthick+e3t_n(ji,jj,jm) 
    668                   zt   = zt  + e3t_n(ji,jj,jm) * tsn(ji,jj,jm,jp_tem) 
    669                   zs   = zs  + e3t_n(ji,jj,jm) * tsn(ji,jj,jm,jp_sal) 
    670                   zu   = zu  + e3t_n(ji,jj,jm) & 
    671                      &            * ( ub(ji,jj,jm) + ub(ji - 1,jj,jm) ) & 
     674                  zthick=zthick+e3t(ji,jj,jm,Kmm) 
     675                  zt   = zt  + e3t(ji,jj,jm,Kmm) * ts(ji,jj,jm,jp_tem,Kmm) 
     676                  zs   = zs  + e3t(ji,jj,jm,Kmm) * ts(ji,jj,jm,jp_sal,Kmm) 
     677                  zu   = zu  + e3t(ji,jj,jm,Kmm) & 
     678                     &            * ( uu(ji,jj,jm,Kbb) + uu(ji - 1,jj,jm,Kbb) ) & 
    672679                     &            / MAX( 1. , umask(ji,jj,jm) + umask(ji - 1,jj,jm) ) 
    673                   zv   = zv  + e3t_n(ji,jj,jm) & 
    674                      &            * ( vb(ji,jj,jm) + vb(ji,jj - 1,jm) ) & 
     680                  zv   = zv  + e3t(ji,jj,jm,Kmm) & 
     681                     &            * ( vv(ji,jj,jm,Kbb) + vv(ji,jj - 1,jm,Kbb) ) & 
    675682                     &            / MAX( 1. , vmask(ji,jj,jm) + vmask(ji,jj - 1,jm) ) 
    676683               END DO 
     
    679686               zu_ml(ji,jj) = zu / zthick 
    680687               zv_ml(ji,jj) = zv / zthick 
    681                zdt_ml(ji,jj) = zt_ml(ji,jj) - tsn(ji,jj,ibld(ji,jj),jp_tem) 
    682                zds_ml(ji,jj) = zs_ml(ji,jj) - tsn(ji,jj,ibld(ji,jj),jp_sal) 
    683                zdu_ml(ji,jj) = zu_ml(ji,jj) - ( ub(ji,jj,ibld(ji,jj)) + ub(ji-1,jj,ibld(ji,jj) ) ) & 
     688               zdt_ml(ji,jj) = zt_ml(ji,jj) - ts(ji,jj,ibld(ji,jj),jp_tem,Kmm) 
     689               zds_ml(ji,jj) = zs_ml(ji,jj) - ts(ji,jj,ibld(ji,jj),jp_sal,Kmm) 
     690               zdu_ml(ji,jj) = zu_ml(ji,jj) - ( uu(ji,jj,ibld(ji,jj),Kbb) + uu(ji-1,jj,ibld(ji,jj) ,Kbb) ) & 
    684691                     &    / MAX(1. , umask(ji,jj,ibld(ji,jj) ) + umask(ji-1,jj,ibld(ji,jj) ) ) 
    685                zdv_ml(ji,jj) = zv_ml(ji,jj) - ( vb(ji,jj,ibld(ji,jj)) + vb(ji,jj-1,ibld(ji,jj) ) ) & 
     692               zdv_ml(ji,jj) = zv_ml(ji,jj) - ( vv(ji,jj,ibld(ji,jj),Kbb) + vv(ji,jj-1,ibld(ji,jj) ,Kbb) ) & 
    686693                     &    / MAX(1. , vmask(ji,jj,ibld(ji,jj) ) + vmask(ji,jj-1,ibld(ji,jj) ) ) 
    687694               zdb_ml(ji,jj) = grav * zthermal * zdt_ml(ji,jj) - grav * zbeta * zds_ml(ji,jj) 
    688             ELSE 
    689             ! stable, if entraining calulate average below interface layer. 
    690                IF ( zdhdt(ji,jj) >= 0._wp ) THEN 
    691                   zt   = 0._wp 
    692                   zs   = 0._wp 
    693                   zu   = 0._wp 
    694                   zv   = 0._wp 
    695                   ! average over depth of boundary layer 
    696                   zthick=0._wp 
    697                   DO jm = 2, imld(ji,jj) 
    698                      zthick=zthick+e3t_n(ji,jj,jm) 
    699                      zt   = zt  + e3t_n(ji,jj,jm) * tsn(ji,jj,jm,jp_tem) 
    700                      zs   = zs  + e3t_n(ji,jj,jm) * tsn(ji,jj,jm,jp_sal) 
    701                      zu   = zu  + e3t_n(ji,jj,jm) & 
    702                         &            * ( ub(ji,jj,jm) + ub(ji - 1,jj,jm) ) & 
    703                         &            / MAX( 1. , umask(ji,jj,jm) + umask(ji - 1,jj,jm) ) 
    704                      zv   = zv  + e3t_n(ji,jj,jm) & 
    705                         &            * ( vb(ji,jj,jm) + vb(ji,jj - 1,jm) ) & 
    706                         &            / MAX( 1. , vmask(ji,jj,jm) + vmask(ji,jj - 1,jm) ) 
    707                   END DO 
    708                   zt_ml(ji,jj) = zt / zthick 
    709                   zs_ml(ji,jj) = zs / zthick 
    710                   zu_ml(ji,jj) = zu / zthick 
    711                   zv_ml(ji,jj) = zv / zthick 
    712                   zdt_ml(ji,jj) = zt_ml(ji,jj) - tsn(ji,jj,ibld(ji,jj),jp_tem) 
    713                   zds_ml(ji,jj) = zs_ml(ji,jj) - tsn(ji,jj,ibld(ji,jj),jp_sal) 
    714                   zdu_ml(ji,jj) = zu_ml(ji,jj) - ( ub(ji,jj,ibld(ji,jj)) + ub(ji-1,jj,ibld(ji,jj) ) ) & 
    715                         &    / MAX(1. , umask(ji,jj,ibld(ji,jj) ) + umask(ji-1,jj,ibld(ji,jj) ) ) 
    716                   zdv_ml(ji,jj) = zv_ml(ji,jj) - ( vb(ji,jj,ibld(ji,jj)) + vb(ji,jj-1,ibld(ji,jj) ) ) & 
    717                         &    / MAX(1. , vmask(ji,jj,ibld(ji,jj) ) + vmask(ji,jj-1,ibld(ji,jj) ) ) 
    718                   zdb_ml(ji,jj) = grav * zthermal * zdt_ml(ji,jj) - grav * zbeta * zds_ml(ji,jj) 
    719                ENDIF 
    720695            ENDIF 
    721          END DO 
    722       END DO 
     696         ENDIF 
     697      END_2D 
    723698    ! 
    724699    ! rotate mean currents and changes onto wind align co-ordinates 
    725700    ! 
    726701 
    727       DO jj = 2, jpjm1 
    728          DO ji = 2, jpim1 
    729             ztemp = zu_ml(ji,jj) 
    730             zu_ml(ji,jj) = zu_ml(ji,jj) * zcos_wind(ji,jj) + zv_ml(ji,jj) * zsin_wind(ji,jj) 
    731             zv_ml(ji,jj) = zv_ml(ji,jj) * zcos_wind(ji,jj) - ztemp * zsin_wind(ji,jj) 
    732             ztemp = zdu_ml(ji,jj) 
    733             zdu_ml(ji,jj) = zdu_ml(ji,jj) * zcos_wind(ji,jj) + zdv_ml(ji,jj) * zsin_wind(ji,jj) 
    734             zdv_ml(ji,jj) = zdv_ml(ji,jj) * zsin_wind(ji,jj) - ztemp * zsin_wind(ji,jj) 
    735     ! 
    736             ztemp = zu_bl(ji,jj) 
    737             zu_bl = zu_bl(ji,jj) * zcos_wind(ji,jj) + zv_bl(ji,jj) * zsin_wind(ji,jj) 
    738             zv_bl(ji,jj) = zv_bl(ji,jj) * zcos_wind(ji,jj) - ztemp * zsin_wind(ji,jj) 
    739             ztemp = zdu_bl(ji,jj) 
    740             zdu_bl(ji,jj) = zdu_bl(ji,jj) * zcos_wind(ji,jj) + zdv_bl(ji,jj) * zsin_wind(ji,jj) 
    741             zdv_bl(ji,jj) = zdv_bl(ji,jj) * zsin_wind(ji,jj) - ztemp * zsin_wind(ji,jj) 
    742          END DO 
    743       END DO 
     702      DO_2D_00_00 
     703         ztemp = zu_ml(ji,jj) 
     704         zu_ml(ji,jj) = zu_ml(ji,jj) * zcos_wind(ji,jj) + zv_ml(ji,jj) * zsin_wind(ji,jj) 
     705         zv_ml(ji,jj) = zv_ml(ji,jj) * zcos_wind(ji,jj) - ztemp * zsin_wind(ji,jj) 
     706         ztemp = zdu_ml(ji,jj) 
     707         zdu_ml(ji,jj) = zdu_ml(ji,jj) * zcos_wind(ji,jj) + zdv_ml(ji,jj) * zsin_wind(ji,jj) 
     708         zdv_ml(ji,jj) = zdv_ml(ji,jj) * zsin_wind(ji,jj) - ztemp * zsin_wind(ji,jj) 
     709 ! 
     710         ztemp = zu_bl(ji,jj) 
     711         zu_bl = zu_bl(ji,jj) * zcos_wind(ji,jj) + zv_bl(ji,jj) * zsin_wind(ji,jj) 
     712         zv_bl(ji,jj) = zv_bl(ji,jj) * zcos_wind(ji,jj) - ztemp * zsin_wind(ji,jj) 
     713         ztemp = zdu_bl(ji,jj) 
     714         zdu_bl(ji,jj) = zdu_bl(ji,jj) * zcos_wind(ji,jj) + zdv_bl(ji,jj) * zsin_wind(ji,jj) 
     715         zdv_bl(ji,jj) = zdv_bl(ji,jj) * zsin_wind(ji,jj) - ztemp * zsin_wind(ji,jj) 
     716      END_2D 
    744717 
    745718     zuw_bse = 0._wp 
    746719     zvw_bse = 0._wp 
    747      DO jj = 2, jpjm1 
    748         DO ji = 2, jpim1 
    749  
    750            IF ( lconv(ji,jj) ) THEN 
    751               IF ( zdb_bl(ji,jj) > 0._wp ) THEN 
    752                  zwth_ent(ji,jj) = zwb_ent(ji,jj) * zdt_ml(ji,jj) / (zdb_ml(ji,jj) + epsln) 
    753                  zws_ent(ji,jj) = zwb_ent(ji,jj) * zds_ml(ji,jj) / (zdb_ml(ji,jj) + epsln) 
    754               ENDIF 
    755            ELSE 
    756               zwth_ent(ji,jj) = -2.0 * zwthav(ji,jj) * ( (1.0 - 0.8) - ( 1.0 - 0.8)**(3.0/2.0) ) 
    757               zws_ent(ji,jj) = -2.0 * zwsav(ji,jj) * ( (1.0 - 0.8 ) - ( 1.0 - 0.8 )**(3.0/2.0) ) 
     720     DO_2D_00_00 
     721 
     722        IF ( lconv(ji,jj) ) THEN 
     723           IF ( zdb_bl(ji,jj) > 0._wp ) THEN 
     724              zwth_ent(ji,jj) = zwb_ent(ji,jj) * zdt_ml(ji,jj) / (zdb_ml(ji,jj) + epsln) 
     725              zws_ent(ji,jj) = zwb_ent(ji,jj) * zds_ml(ji,jj) / (zdb_ml(ji,jj) + epsln) 
    758726           ENDIF 
    759         END DO 
    760      END DO 
     727        ELSE 
     728           zwth_ent(ji,jj) = -2.0 * zwthav(ji,jj) * ( (1.0 - 0.8) - ( 1.0 - 0.8)**(3.0/2.0) ) 
     729           zws_ent(ji,jj) = -2.0 * zwsav(ji,jj) * ( (1.0 - 0.8 ) - ( 1.0 - 0.8 )**(3.0/2.0) ) 
     730        ENDIF 
     731     END_2D 
    761732 
    762733      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     
    764735      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    765736 
    766        DO jj = 2, jpjm1 
    767           DO ji = 2, jpim1 
    768           ! 
    769              IF ( lconv (ji,jj) ) THEN 
    770              ! Unstable conditions 
    771                 IF( zdb_bl(ji,jj) > 0._wp ) THEN 
    772                 ! calculate pycnocline profiles, no need if zdb_bl <= 0. since profile is zero and arrays have been initialized to zero 
    773                    ztgrad = ( zdt_ml(ji,jj) / zdh(ji,jj) ) 
    774                    zsgrad = ( zds_ml(ji,jj) / zdh(ji,jj) ) 
    775                    zbgrad = ( zdb_ml(ji,jj) / zdh(ji,jj) ) 
    776                    DO jk = 2 , ibld(ji,jj) 
    777                       znd = -( gdepw_n(ji,jj,jk) - zhml(ji,jj) ) / zdh(ji,jj) 
    778                       zdtdz_pyc(ji,jj,jk) =  ztgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 
    779                       zdbdz_pyc(ji,jj,jk) =  zbgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 
    780                       zdsdz_pyc(ji,jj,jk) =  zsgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 
    781                    END DO 
    782                 ENDIF 
    783              ELSE 
    784              ! stable conditions 
    785              ! if pycnocline profile only defined when depth steady of increasing. 
    786                 IF ( zdhdt(ji,jj) >= 0.0 ) THEN        ! Depth increasing, or steady. 
    787                    IF ( zdb_bl(ji,jj) > 0._wp ) THEN 
    788                      IF ( zhol(ji,jj) >= 0.5 ) THEN      ! Very stable - 'thick' pycnocline 
    789                          ztgrad = zdt_bl(ji,jj) / zhbl(ji,jj) 
    790                          zsgrad = zds_bl(ji,jj) / zhbl(ji,jj) 
    791                          zbgrad = zdb_bl(ji,jj) / zhbl(ji,jj) 
    792                          DO jk = 2, ibld(ji,jj) 
    793                             znd = gdepw_n(ji,jj,jk) / zhbl(ji,jj) 
    794                             zdtdz_pyc(ji,jj,jk) =  ztgrad * EXP( -15.0 * ( znd - 0.9 )**2 ) 
    795                             zdbdz_pyc(ji,jj,jk) =  zbgrad * EXP( -15.0 * ( znd - 0.9 )**2 ) 
    796                             zdsdz_pyc(ji,jj,jk) =  zsgrad * EXP( -15.0 * ( znd - 0.9 )**2 ) 
    797                          END DO 
    798                      ELSE                                   ! Slightly stable - 'thin' pycnoline - needed when stable layer begins to form. 
    799                          ztgrad = zdt_bl(ji,jj) / zdh(ji,jj) 
    800                          zsgrad = zds_bl(ji,jj) / zdh(ji,jj) 
    801                          zbgrad = zdb_bl(ji,jj) / zdh(ji,jj) 
    802                          DO jk = 2, ibld(ji,jj) 
    803                             znd = -( gdepw_n(ji,jj,jk) - zhml(ji,jj) ) / zdh(ji,jj) 
    804                             zdtdz_pyc(ji,jj,jk) =  ztgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 
    805                             zdbdz_pyc(ji,jj,jk) =  zbgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 
    806                             zdsdz_pyc(ji,jj,jk) =  zsgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 
    807                          END DO 
    808                       ENDIF ! IF (zhol >=0.5) 
    809                    ENDIF    ! IF (zdb_bl> 0.) 
    810                 ENDIF       ! IF (zdhdt >= 0) zdhdt < 0 not considered since pycnocline profile is zero, profile arrays are intialized to zero 
    811              ENDIF          ! IF (lconv) 
    812             ! 
    813           END DO 
    814        END DO 
    815 ! 
    816        DO jj = 2, jpjm1 
    817           DO ji = 2, jpim1 
    818           ! 
    819              IF ( lconv (ji,jj) ) THEN 
    820              ! Unstable conditions 
    821                  zugrad = ( zdu_ml(ji,jj) / zdh(ji,jj) ) + 0.275 * zustar(ji,jj)*zustar(ji,jj) / & 
    822                & (( zwstrl(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * zhml(ji,jj) ) / zla(ji,jj)**(8.0/3.0) 
    823                 zvgrad = ( zdv_ml(ji,jj) / zdh(ji,jj) ) + 3.5 * ff_t(ji,jj) * zustke(ji,jj) / & 
    824               & ( zwstrl(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird 
    825                 DO jk = 2 , ibld(ji,jj)-1 
    826                    znd = -( gdepw_n(ji,jj,jk) - zhml(ji,jj) ) / zdh(ji,jj) 
    827                    zdudz_pyc(ji,jj,jk) =  zugrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 
    828                    zdvdz_pyc(ji,jj,jk) = zvgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 
    829                 END DO 
    830              ELSE 
    831              ! stable conditions 
    832                 zugrad = 3.25 * zdu_bl(ji,jj) / zhbl(ji,jj) 
    833                 zvgrad = 2.75 * zdv_bl(ji,jj) / zhbl(ji,jj) 
    834                 DO jk = 2, ibld(ji,jj) 
    835                    znd = gdepw_n(ji,jj,jk) / zhbl(ji,jj) 
    836                    IF ( znd < 1.0 ) THEN 
    837                       zdudz_pyc(ji,jj,jk) = zugrad * EXP( -40.0 * ( znd - 1.0 )**2 ) 
    838                    ELSE 
    839                       zdudz_pyc(ji,jj,jk) = zugrad * EXP( -20.0 * ( znd - 1.0 )**2 ) 
    840                    ENDIF 
    841                    zdvdz_pyc(ji,jj,jk) = zvgrad * EXP( -20.0 * ( znd - 0.85 )**2 ) 
     737       DO_2D_00_00 
     738       ! 
     739          IF ( lconv (ji,jj) ) THEN 
     740          ! Unstable conditions 
     741             IF( zdb_bl(ji,jj) > 0._wp ) THEN 
     742             ! calculate pycnocline profiles, no need if zdb_bl <= 0. since profile is zero and arrays have been initialized to zero 
     743                ztgrad = ( zdt_ml(ji,jj) / zdh(ji,jj) ) 
     744                zsgrad = ( zds_ml(ji,jj) / zdh(ji,jj) ) 
     745                zbgrad = ( zdb_ml(ji,jj) / zdh(ji,jj) ) 
     746                DO jk = 2 , ibld(ji,jj) 
     747                   znd = -( gdepw(ji,jj,jk,Kmm) - zhml(ji,jj) ) / zdh(ji,jj) 
     748                   zdtdz_pyc(ji,jj,jk) =  ztgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 
     749                   zdbdz_pyc(ji,jj,jk) =  zbgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 
     750                   zdsdz_pyc(ji,jj,jk) =  zsgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 
    842751                END DO 
    843752             ENDIF 
    844             ! 
    845           END DO 
    846        END DO 
     753          ELSE 
     754          ! stable conditions 
     755          ! if pycnocline profile only defined when depth steady of increasing. 
     756             IF ( zdhdt(ji,jj) >= 0.0 ) THEN        ! Depth increasing, or steady. 
     757                IF ( zdb_bl(ji,jj) > 0._wp ) THEN 
     758                  IF ( zhol(ji,jj) >= 0.5 ) THEN      ! Very stable - 'thick' pycnocline 
     759                      ztgrad = zdt_bl(ji,jj) / zhbl(ji,jj) 
     760                      zsgrad = zds_bl(ji,jj) / zhbl(ji,jj) 
     761                      zbgrad = zdb_bl(ji,jj) / zhbl(ji,jj) 
     762                      DO jk = 2, ibld(ji,jj) 
     763                         znd = gdepw(ji,jj,jk,Kmm) / zhbl(ji,jj) 
     764                         zdtdz_pyc(ji,jj,jk) =  ztgrad * EXP( -15.0 * ( znd - 0.9 )**2 ) 
     765                         zdbdz_pyc(ji,jj,jk) =  zbgrad * EXP( -15.0 * ( znd - 0.9 )**2 ) 
     766                         zdsdz_pyc(ji,jj,jk) =  zsgrad * EXP( -15.0 * ( znd - 0.9 )**2 ) 
     767                      END DO 
     768                  ELSE                                   ! Slightly stable - 'thin' pycnoline - needed when stable layer begins to form. 
     769                      ztgrad = zdt_bl(ji,jj) / zdh(ji,jj) 
     770                      zsgrad = zds_bl(ji,jj) / zdh(ji,jj) 
     771                      zbgrad = zdb_bl(ji,jj) / zdh(ji,jj) 
     772                      DO jk = 2, ibld(ji,jj) 
     773                         znd = -( gdepw(ji,jj,jk,Kmm) - zhml(ji,jj) ) / zdh(ji,jj) 
     774                         zdtdz_pyc(ji,jj,jk) =  ztgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 
     775                         zdbdz_pyc(ji,jj,jk) =  zbgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 
     776                         zdsdz_pyc(ji,jj,jk) =  zsgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 
     777                      END DO 
     778                   ENDIF ! IF (zhol >=0.5) 
     779                ENDIF    ! IF (zdb_bl> 0.) 
     780             ENDIF       ! IF (zdhdt >= 0) zdhdt < 0 not considered since pycnocline profile is zero, profile arrays are intialized to zero 
     781          ENDIF          ! IF (lconv) 
     782         ! 
     783       END_2D 
     784! 
     785       DO_2D_00_00 
     786       ! 
     787          IF ( lconv (ji,jj) ) THEN 
     788          ! Unstable conditions 
     789              zugrad = ( zdu_ml(ji,jj) / zdh(ji,jj) ) + 0.275 * zustar(ji,jj)*zustar(ji,jj) / & 
     790            & (( zwstrl(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * zhml(ji,jj) ) / zla(ji,jj)**(8.0/3.0) 
     791             zvgrad = ( zdv_ml(ji,jj) / zdh(ji,jj) ) + 3.5 * ff_t(ji,jj) * zustke(ji,jj) / & 
     792           & ( zwstrl(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird 
     793             DO jk = 2 , ibld(ji,jj)-1 
     794                znd = -( gdepw(ji,jj,jk,Kmm) - zhml(ji,jj) ) / zdh(ji,jj) 
     795                zdudz_pyc(ji,jj,jk) =  zugrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 
     796                zdvdz_pyc(ji,jj,jk) = zvgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 
     797             END DO 
     798          ELSE 
     799          ! stable conditions 
     800             zugrad = 3.25 * zdu_bl(ji,jj) / zhbl(ji,jj) 
     801             zvgrad = 2.75 * zdv_bl(ji,jj) / zhbl(ji,jj) 
     802             DO jk = 2, ibld(ji,jj) 
     803                znd = gdepw(ji,jj,jk,Kmm) / zhbl(ji,jj) 
     804                IF ( znd < 1.0 ) THEN 
     805                   zdudz_pyc(ji,jj,jk) = zugrad * EXP( -40.0 * ( znd - 1.0 )**2 ) 
     806                ELSE 
     807                   zdudz_pyc(ji,jj,jk) = zugrad * EXP( -20.0 * ( znd - 1.0 )**2 ) 
     808                ENDIF 
     809                zdvdz_pyc(ji,jj,jk) = zvgrad * EXP( -20.0 * ( znd - 0.85 )**2 ) 
     810             END DO 
     811          ENDIF 
     812         ! 
     813       END_2D 
    847814       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    848815       ! Eddy viscosity/diffusivity and non-gradient terms in the flux-gradient relationship 
     
    860827      !     zvisml_sc = zwstrl * zhbl * EXP ( -( zhol / 0.183_wp )**2 ) 
    861828      !  ENDWHERE 
    862        DO jj = 2, jpjm1 
    863           DO ji = 2, jpim1 
    864              IF ( lconv(ji,jj) ) THEN 
    865                zdifml_sc(ji,jj) = zhml(ji,jj) * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird 
    866                zvisml_sc(ji,jj) = zdifml_sc(ji,jj) 
    867                zdifpyc_sc(ji,jj) = 0.165 * ( zvstr(ji,jj)**3 + 0.5 *zwstrc(ji,jj)**3 )**pthird * zdh(ji,jj) 
    868                zvispyc_sc(ji,jj) = 0.142 * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * zdh(ji,jj) 
    869                zbeta_d_sc(ji,jj) = 1.0 - (0.165 / 0.8 * zdh(ji,jj) / zhbl(ji,jj) )**p2third 
    870                zbeta_v_sc(ji,jj) = 1.0 -  2.0 * (0.142 /0.375) * zdh(ji,jj) / zhml(ji,jj) 
    871              ELSE 
    872                zdifml_sc(ji,jj) = zvstr(ji,jj) * zhbl(ji,jj) * EXP ( -( zhol(ji,jj) / 0.6_wp )**2 ) 
    873                zvisml_sc(ji,jj) = zvstr(ji,jj) * zhbl(ji,jj) * EXP ( -( zhol(ji,jj) / 0.6_wp )**2 ) 
    874             END IF 
    875         END DO 
    876     END DO 
     829       DO_2D_00_00 
     830          IF ( lconv(ji,jj) ) THEN 
     831            zdifml_sc(ji,jj) = zhml(ji,jj) * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird 
     832            zvisml_sc(ji,jj) = zdifml_sc(ji,jj) 
     833            zdifpyc_sc(ji,jj) = 0.165 * ( zvstr(ji,jj)**3 + 0.5 *zwstrc(ji,jj)**3 )**pthird * zdh(ji,jj) 
     834            zvispyc_sc(ji,jj) = 0.142 * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * zdh(ji,jj) 
     835            zbeta_d_sc(ji,jj) = 1.0 - (0.165 / 0.8 * zdh(ji,jj) / zhbl(ji,jj) )**p2third 
     836            zbeta_v_sc(ji,jj) = 1.0 -  2.0 * (0.142 /0.375) * zdh(ji,jj) / zhml(ji,jj) 
     837          ELSE 
     838            zdifml_sc(ji,jj) = zvstr(ji,jj) * zhbl(ji,jj) * EXP ( -( zhol(ji,jj) / 0.6_wp )**2 ) 
     839            zvisml_sc(ji,jj) = zvstr(ji,jj) * zhbl(ji,jj) * EXP ( -( zhol(ji,jj) / 0.6_wp )**2 ) 
     840         END IF 
     841       END_2D 
    877842! 
    878        DO jj = 2, jpjm1 
    879           DO ji = 2, jpim1 
    880              IF ( lconv(ji,jj) ) THEN 
    881                 DO jk = 2, imld(ji,jj)   ! mixed layer diffusivity 
    882                     zznd_ml = gdepw_n(ji,jj,jk) / zhml(ji,jj) 
     843       DO_2D_00_00 
     844          IF ( lconv(ji,jj) ) THEN 
     845             DO jk = 2, imld(ji,jj)   ! mixed layer diffusivity 
     846                 zznd_ml = gdepw(ji,jj,jk,Kmm) / zhml(ji,jj) 
     847                 ! 
     848                 zdiffut(ji,jj,jk) = 0.8   * zdifml_sc(ji,jj) * zznd_ml * ( 1.0 - zbeta_d_sc(ji,jj) * zznd_ml    )**1.5 
     849                 ! 
     850                 zviscos(ji,jj,jk) = 0.375 * zvisml_sc(ji,jj) * zznd_ml * ( 1.0 - zbeta_v_sc(ji,jj) * zznd_ml    ) & 
     851                      &            *                                      ( 1.0 -               0.5 * zznd_ml**2 ) 
     852             END DO 
     853             ! pycnocline - if present linear profile 
     854             IF ( zdh(ji,jj) > 0._wp ) THEN 
     855                DO jk = imld(ji,jj)+1 , ibld(ji,jj) 
     856                    zznd_pyc = -( gdepw(ji,jj,jk,Kmm) - zhml(ji,jj) ) / zdh(ji,jj) 
    883857                    ! 
    884                     zdiffut(ji,jj,jk) = 0.8   * zdifml_sc(ji,jj) * zznd_ml * ( 1.0 - zbeta_d_sc(ji,jj) * zznd_ml    )**1.5 
     858                    zdiffut(ji,jj,jk) = zdifpyc_sc(ji,jj) * ( 1.0 + zznd_pyc ) 
    885859                    ! 
    886                     zviscos(ji,jj,jk) = 0.375 * zvisml_sc(ji,jj) * zznd_ml * ( 1.0 - zbeta_v_sc(ji,jj) * zznd_ml    ) & 
    887                          &            *                                      ( 1.0 -               0.5 * zznd_ml**2 ) 
     860                    zviscos(ji,jj,jk) = zvispyc_sc(ji,jj) * ( 1.0 + zznd_pyc ) 
    888861                END DO 
    889                 ! pycnocline - if present linear profile 
    890                 IF ( zdh(ji,jj) > 0._wp ) THEN 
    891                    DO jk = imld(ji,jj)+1 , ibld(ji,jj) 
    892                        zznd_pyc = -( gdepw_n(ji,jj,jk) - zhml(ji,jj) ) / zdh(ji,jj) 
    893                        ! 
    894                        zdiffut(ji,jj,jk) = zdifpyc_sc(ji,jj) * ( 1.0 + zznd_pyc ) 
    895                        ! 
    896                        zviscos(ji,jj,jk) = zvispyc_sc(ji,jj) * ( 1.0 + zznd_pyc ) 
    897                    END DO 
    898                 ENDIF 
    899                 ! Temporay fix to ensure zdiffut is +ve; won't be necessary with wn taken out 
    900                 zdiffut(ji,jj,ibld(ji,jj)) = zdhdt(ji,jj)* e3t_n(ji,jj,ibld(ji,jj)) 
    901                 ! could be taken out, take account of entrainment represents as a diffusivity 
    902                 ! should remove w from here, represents entrainment 
    903              ELSE 
    904              ! stable conditions 
    905                 DO jk = 2, ibld(ji,jj) 
    906                    zznd_ml = gdepw_n(ji,jj,jk) / zhbl(ji,jj) 
    907                    zdiffut(ji,jj,jk) = 0.75 * zdifml_sc(ji,jj) * zznd_ml * ( 1.0 - zznd_ml )**1.5 
    908                    zviscos(ji,jj,jk) = 0.375 * zvisml_sc(ji,jj) * zznd_ml * (1.0 - zznd_ml) * ( 1.0 - zznd_ml**2 ) 
    909                 END DO 
    910              ENDIF   ! end if ( lconv ) 
     862             ENDIF 
     863             ! Temporay fix to ensure zdiffut is +ve; won't be necessary with ww taken out 
     864             zdiffut(ji,jj,ibld(ji,jj)) = zdhdt(ji,jj)* e3t(ji,jj,ibld(ji,jj),Kmm) 
     865             ! could be taken out, take account of entrainment represents as a diffusivity 
     866             ! should remove w from here, represents entrainment 
     867          ELSE 
     868          ! stable conditions 
     869             DO jk = 2, ibld(ji,jj) 
     870                zznd_ml = gdepw(ji,jj,jk,Kmm) / zhbl(ji,jj) 
     871                zdiffut(ji,jj,jk) = 0.75 * zdifml_sc(ji,jj) * zznd_ml * ( 1.0 - zznd_ml )**1.5 
     872                zviscos(ji,jj,jk) = 0.375 * zvisml_sc(ji,jj) * zznd_ml * (1.0 - zznd_ml) * ( 1.0 - zznd_ml**2 ) 
     873             END DO 
     874          ENDIF   ! end if ( lconv ) 
    911875! 
    912           END DO  ! end of ji loop 
    913        END DO     ! end of jj loop 
     876       END_2D 
    914877 
    915878       ! 
     
    928891 
    929892 
    930        DO jj = 2, jpjm1 
    931           DO ji = 2, jpim1 
    932             IF ( lconv(ji,jj) ) THEN 
    933               DO jk = 2, imld(ji,jj) 
    934                  zznd_d = gdepw_n(ji,jj,jk) / dstokes(ji,jj) 
    935                  ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 1.35 * EXP ( -zznd_d ) * ( 1.0 - EXP ( -2.0 * zznd_d ) ) * zsc_wth_1(ji,jj) 
    936                  ! 
    937                  ghams(ji,jj,jk) = ghams(ji,jj,jk) + 1.35 * EXP ( -zznd_d ) * ( 1.0 - EXP ( -2.0 * zznd_d ) ) *  zsc_ws_1(ji,jj) 
    938               END DO ! end jk loop 
    939             ELSE     ! else for if (lconv) 
     893       DO_2D_00_00 
     894         IF ( lconv(ji,jj) ) THEN 
     895           DO jk = 2, imld(ji,jj) 
     896              zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj) 
     897              ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 1.35 * EXP ( -zznd_d ) * ( 1.0 - EXP ( -2.0 * zznd_d ) ) * zsc_wth_1(ji,jj) 
     898              ! 
     899              ghams(ji,jj,jk) = ghams(ji,jj,jk) + 1.35 * EXP ( -zznd_d ) * ( 1.0 - EXP ( -2.0 * zznd_d ) ) *  zsc_ws_1(ji,jj) 
     900           END DO ! end jk loop 
     901         ELSE     ! else for if (lconv) 
    940902 ! Stable conditions 
    941                DO jk = 2, ibld(ji,jj) 
    942                   zznd_d=gdepw_n(ji,jj,jk) / dstokes(ji,jj) 
    943                   ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 1.5 * EXP ( -0.9 * zznd_d ) & 
    944                        &          *                 ( 1.0 - EXP ( -4.0 * zznd_d ) ) * zsc_wth_1(ji,jj) 
    945                   ! 
    946                   ghams(ji,jj,jk) = ghams(ji,jj,jk) + 1.5 * EXP ( -0.9 * zznd_d ) & 
    947                        &          *                 ( 1.0 - EXP ( -4.0 * zznd_d ) ) *  zsc_ws_1(ji,jj) 
    948                END DO 
    949             ENDIF               ! endif for check on lconv 
    950  
    951           END DO  ! end of ji loop 
    952        END DO     ! end of jj loop 
     903            DO jk = 2, ibld(ji,jj) 
     904               zznd_d=gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj) 
     905               ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 1.5 * EXP ( -0.9 * zznd_d ) & 
     906                    &          *                 ( 1.0 - EXP ( -4.0 * zznd_d ) ) * zsc_wth_1(ji,jj) 
     907               ! 
     908               ghams(ji,jj,jk) = ghams(ji,jj,jk) + 1.5 * EXP ( -0.9 * zznd_d ) & 
     909                    &          *                 ( 1.0 - EXP ( -4.0 * zznd_d ) ) *  zsc_ws_1(ji,jj) 
     910            END DO 
     911         ENDIF               ! endif for check on lconv 
     912 
     913       END_2D 
    953914 
    954915 
     
    963924       ENDWHERE 
    964925 
    965        DO jj = 2, jpjm1 
    966           DO ji = 2, jpim1 
    967              IF ( lconv(ji,jj) ) THEN 
    968                 DO jk = 2, imld(ji,jj) 
    969                    zznd_d = gdepw_n(ji,jj,jk) / dstokes(ji,jj) 
    970                    ghamu(ji,jj,jk) = ghamu(ji,jj,jk) +      ( -0.05 * EXP ( -0.4 * zznd_d )   * zsc_uw_1(ji,jj)   & 
    971                         &          +                        0.00125 * EXP (      - zznd_d )   * zsc_uw_2(ji,jj) ) & 
    972                         &          *                          ( 1.0 - EXP ( -2.0 * zznd_d ) ) 
     926       DO_2D_00_00 
     927          IF ( lconv(ji,jj) ) THEN 
     928             DO jk = 2, imld(ji,jj) 
     929                zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj) 
     930                ghamu(ji,jj,jk) = ghamu(ji,jj,jk) +      ( -0.05 * EXP ( -0.4 * zznd_d )   * zsc_uw_1(ji,jj)   & 
     931                     &          +                        0.00125 * EXP (      - zznd_d )   * zsc_uw_2(ji,jj) ) & 
     932                     &          *                          ( 1.0 - EXP ( -2.0 * zznd_d ) ) 
    973933! 
    974                    ghamv(ji,jj,jk) = ghamv(ji,jj,jk) - 0.65 *  0.15 * EXP (      - zznd_d )                       & 
    975                         &          *                          ( 1.0 - EXP ( -2.0 * zznd_d ) ) * zsc_vw_1(ji,jj) 
    976                 END DO   ! end jk loop 
    977              ELSE 
     934                ghamv(ji,jj,jk) = ghamv(ji,jj,jk) - 0.65 *  0.15 * EXP (      - zznd_d )                       & 
     935                     &          *                          ( 1.0 - EXP ( -2.0 * zznd_d ) ) * zsc_vw_1(ji,jj) 
     936             END DO   ! end jk loop 
     937          ELSE 
    978938! Stable conditions 
    979                 DO jk = 2, ibld(ji,jj) ! corrected to ibld 
    980                    zznd_d = gdepw_n(ji,jj,jk) / dstokes(ji,jj) 
    981                    ghamu(ji,jj,jk) = ghamu(ji,jj,jk) - 0.75 *   1.3 * EXP ( -0.5 * zznd_d )                       & 
    982                         &                                   * ( 1.0 - EXP ( -4.0 * zznd_d ) ) * zsc_uw_1(ji,jj) 
    983                    ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + 0._wp 
    984                 END DO   ! end jk loop 
    985              ENDIF 
    986           END DO  ! ji loop 
    987        END DO     ! jj loo 
     939             DO jk = 2, ibld(ji,jj) ! corrected to ibld 
     940                zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj) 
     941                ghamu(ji,jj,jk) = ghamu(ji,jj,jk) - 0.75 *   1.3 * EXP ( -0.5 * zznd_d )                       & 
     942                     &                                   * ( 1.0 - EXP ( -4.0 * zznd_d ) ) * zsc_uw_1(ji,jj) 
     943                ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + 0._wp 
     944             END DO   ! end jk loop 
     945          ENDIF 
     946       END_2D 
    988947 
    989948! Buoyancy term in flux-gradient relationship [note : includes ROI ratio (X0.3) and pressure (X0.5)] 
     
    997956       ENDWHERE 
    998957 
    999        DO jj = 2, jpjm1 
    1000           DO ji = 2, jpim1 
    1001              IF (lconv(ji,jj) ) THEN 
    1002                 DO jk = 2, imld(ji,jj) 
    1003                    zznd_ml = gdepw_n(ji,jj,jk) / zhml(ji,jj) 
    1004                    ! calculate turbulent length scale 
    1005                    zl_c = 0.9 * ( 1.0 - EXP ( - 7.0 * ( zznd_ml - zznd_ml**3 / 3.0 ) ) )                                           & 
    1006                         &     * ( 1.0 - EXP ( -15.0 * (     1.1 - zznd_ml          ) ) ) 
    1007                    zl_l = 2.0 * ( 1.0 - EXP ( - 2.0 * ( zznd_ml - zznd_ml**3 / 3.0 ) ) )                                           & 
    1008                         &     * ( 1.0 - EXP ( - 5.0 * (     1.0 - zznd_ml          ) ) ) * ( 1.0 + dstokes(ji,jj) / zhml (ji,jj) ) 
    1009                    zl_eps = zl_l + ( zl_c - zl_l ) / ( 1.0 + EXP ( 3.0 * LOG10 ( - zhol(ji,jj) ) ) ) ** (3.0/2.0) 
    1010                    ! non-gradient buoyancy terms 
    1011                    ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 0.3 * 0.5 * zsc_wth_1(ji,jj) * zl_eps * zhml(ji,jj) / ( 0.15 + zznd_ml ) 
    1012                    ghams(ji,jj,jk) = ghams(ji,jj,jk) + 0.3 * 0.5 *  zsc_ws_1(ji,jj) * zl_eps * zhml(ji,jj) / ( 0.15 + zznd_ml ) 
    1013                 END DO 
    1014              ELSE 
    1015                 DO jk = 2, ibld(ji,jj) 
    1016                    ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + zsc_wth_1(ji,jj) 
    1017                    ghams(ji,jj,jk) = ghams(ji,jj,jk) +  zsc_ws_1(ji,jj) 
    1018                 END DO 
    1019              ENDIF 
    1020           END DO   ! ji loop 
    1021        END DO      ! jj loop 
     958       DO_2D_00_00 
     959          IF (lconv(ji,jj) ) THEN 
     960             DO jk = 2, imld(ji,jj) 
     961                zznd_ml = gdepw(ji,jj,jk,Kmm) / zhml(ji,jj) 
     962                ! calculate turbulent length scale 
     963                zl_c = 0.9 * ( 1.0 - EXP ( - 7.0 * ( zznd_ml - zznd_ml**3 / 3.0 ) ) )                                           & 
     964                     &     * ( 1.0 - EXP ( -15.0 * (     1.1 - zznd_ml          ) ) ) 
     965                zl_l = 2.0 * ( 1.0 - EXP ( - 2.0 * ( zznd_ml - zznd_ml**3 / 3.0 ) ) )                                           & 
     966                     &     * ( 1.0 - EXP ( - 5.0 * (     1.0 - zznd_ml          ) ) ) * ( 1.0 + dstokes(ji,jj) / zhml (ji,jj) ) 
     967                zl_eps = zl_l + ( zl_c - zl_l ) / ( 1.0 + EXP ( 3.0 * LOG10 ( - zhol(ji,jj) ) ) ) ** (3.0/2.0) 
     968                ! non-gradient buoyancy terms 
     969                ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 0.3 * 0.5 * zsc_wth_1(ji,jj) * zl_eps * zhml(ji,jj) / ( 0.15 + zznd_ml ) 
     970                ghams(ji,jj,jk) = ghams(ji,jj,jk) + 0.3 * 0.5 *  zsc_ws_1(ji,jj) * zl_eps * zhml(ji,jj) / ( 0.15 + zznd_ml ) 
     971             END DO 
     972          ELSE 
     973             DO jk = 2, ibld(ji,jj) 
     974                ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + zsc_wth_1(ji,jj) 
     975                ghams(ji,jj,jk) = ghams(ji,jj,jk) +  zsc_ws_1(ji,jj) 
     976             END DO 
     977          ENDIF 
     978       END_2D 
    1022979 
    1023980 
     
    1031988       ENDWHERE 
    1032989 
    1033        DO jj = 2, jpjm1 
    1034           DO ji = 2, jpim1 
    1035              IF ( lconv(ji,jj) ) THEN 
    1036                 DO jk = 2 , imld(ji,jj) 
    1037                    zznd_d = gdepw_n(ji,jj,jk) / dstokes(ji,jj) 
    1038                    ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + 0.3 * 0.5 * ( zsc_uw_1(ji,jj) +   0.125 * EXP( -0.5 * zznd_d )     & 
    1039                         &                                                            * (   1.0 - EXP( -0.5 * zznd_d ) )   & 
    1040                         &                                          * zsc_uw_2(ji,jj)                                    ) 
    1041                    ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zsc_vw_1(ji,jj) 
    1042                 END DO  ! jk loop 
    1043              ELSE 
    1044              ! stable conditions 
    1045                 DO jk = 2, ibld(ji,jj) 
    1046                    ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + zsc_uw_1(ji,jj) 
    1047                    ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zsc_vw_1(ji,jj) 
    1048                 END DO 
    1049              ENDIF 
    1050           END DO        ! ji loop 
    1051        END DO           ! jj loop 
     990       DO_2D_00_00 
     991          IF ( lconv(ji,jj) ) THEN 
     992             DO jk = 2 , imld(ji,jj) 
     993                zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj) 
     994                ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + 0.3 * 0.5 * ( zsc_uw_1(ji,jj) +   0.125 * EXP( -0.5 * zznd_d )     & 
     995                     &                                                            * (   1.0 - EXP( -0.5 * zznd_d ) )   & 
     996                     &                                          * zsc_uw_2(ji,jj)                                    ) 
     997                ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zsc_vw_1(ji,jj) 
     998             END DO  ! jk loop 
     999          ELSE 
     1000          ! stable conditions 
     1001             DO jk = 2, ibld(ji,jj) 
     1002                ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + zsc_uw_1(ji,jj) 
     1003                ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zsc_vw_1(ji,jj) 
     1004             END DO 
     1005          ENDIF 
     1006       END_2D 
    10521007 
    10531008! Transport term in flux-gradient relationship [note : includes ROI ratio (X0.3) ] 
     
    10611016       ENDWHERE 
    10621017 
    1063        DO jj = 2, jpjm1 
    1064           DO ji = 2, jpim1 
    1065             IF ( lconv(ji,jj) ) THEN 
    1066                DO jk = 2, imld(ji,jj) 
    1067                   zznd_ml=gdepw_n(ji,jj,jk) / zhml(ji,jj) 
    1068                   ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 0.3 * zsc_wth_1(ji,jj)                & 
    1069                        &          * ( -2.0 + 2.75 * (       ( 1.0 + 0.6 * zznd_ml**4 )      & 
    1070                        &                               - EXP(     - 6.0 * zznd_ml    ) ) )  & 
    1071                        &          * ( 1.0 - EXP( - 15.0 * (         1.0 - zznd_ml    ) ) ) 
    1072                   ! 
    1073                   ghams(ji,jj,jk) = ghams(ji,jj,jk) + 0.3 * zsc_ws_1(ji,jj)  & 
    1074                        &          * ( -2.0 + 2.75 * (       ( 1.0 + 0.6 * zznd_ml**4 )      & 
    1075                        &                               - EXP(     - 6.0 * zznd_ml    ) ) )  & 
    1076                        &          * ( 1.0 - EXP ( -15.0 * (         1.0 - zznd_ml    ) ) ) 
    1077                END DO 
    1078             ELSE 
    1079                DO jk = 2, ibld(ji,jj) 
    1080                   zznd_d = gdepw_n(ji,jj,jk) / dstokes(ji,jj) 
    1081                   znd = gdepw_n(ji,jj,jk) / zhbl(ji,jj) 
    1082                   ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 0.3 * ( -4.06 * EXP( -2.0 * zznd_d ) * (1.0 - EXP( -4.0 * zznd_d ) ) + & 
    1083                &  7.5 * EXP ( -10.0 * ( 0.95 - znd )**2 ) * ( 1.0 - znd ) ) * zsc_wth_1(ji,jj) 
    1084                   ghams(ji,jj,jk) = ghams(ji,jj,jk) + 0.3 * ( -4.06 * EXP( -2.0 * zznd_d ) * (1.0 - EXP( -4.0 * zznd_d ) ) + & 
    1085                &  7.5 * EXP ( -10.0 * ( 0.95 - znd )**2 ) * ( 1.0 - znd ) ) * zsc_ws_1(ji,jj) 
    1086                END DO 
    1087             ENDIF 
    1088           ENDDO    ! ji loop 
    1089        END DO      ! jj loop 
     1018       DO_2D_00_00 
     1019         IF ( lconv(ji,jj) ) THEN 
     1020            DO jk = 2, imld(ji,jj) 
     1021               zznd_ml=gdepw(ji,jj,jk,Kmm) / zhml(ji,jj) 
     1022               ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 0.3 * zsc_wth_1(ji,jj)                & 
     1023                    &          * ( -2.0 + 2.75 * (       ( 1.0 + 0.6 * zznd_ml**4 )      & 
     1024                    &                               - EXP(     - 6.0 * zznd_ml    ) ) )  & 
     1025                    &          * ( 1.0 - EXP( - 15.0 * (         1.0 - zznd_ml    ) ) ) 
     1026               ! 
     1027               ghams(ji,jj,jk) = ghams(ji,jj,jk) + 0.3 * zsc_ws_1(ji,jj)  & 
     1028                    &          * ( -2.0 + 2.75 * (       ( 1.0 + 0.6 * zznd_ml**4 )      & 
     1029                    &                               - EXP(     - 6.0 * zznd_ml    ) ) )  & 
     1030                    &          * ( 1.0 - EXP ( -15.0 * (         1.0 - zznd_ml    ) ) ) 
     1031            END DO 
     1032         ELSE 
     1033            DO jk = 2, ibld(ji,jj) 
     1034               zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj) 
     1035               znd = gdepw(ji,jj,jk,Kmm) / zhbl(ji,jj) 
     1036               ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 0.3 * ( -4.06 * EXP( -2.0 * zznd_d ) * (1.0 - EXP( -4.0 * zznd_d ) ) + & 
     1037            &  7.5 * EXP ( -10.0 * ( 0.95 - znd )**2 ) * ( 1.0 - znd ) ) * zsc_wth_1(ji,jj) 
     1038               ghams(ji,jj,jk) = ghams(ji,jj,jk) + 0.3 * ( -4.06 * EXP( -2.0 * zznd_d ) * (1.0 - EXP( -4.0 * zznd_d ) ) + & 
     1039            &  7.5 * EXP ( -10.0 * ( 0.95 - znd )**2 ) * ( 1.0 - znd ) ) * zsc_ws_1(ji,jj) 
     1040            END DO 
     1041         ENDIF 
     1042       END_2D 
    10901043 
    10911044 
     
    11001053       ENDWHERE 
    11011054 
    1102        DO jj = 2, jpjm1 
    1103           DO ji = 2, jpim1 
    1104              IF ( lconv(ji,jj) ) THEN 
    1105                DO jk = 2, imld(ji,jj) 
    1106                   zznd_ml = gdepw_n(ji,jj,jk) / zhml(ji,jj) 
    1107                   zznd_d = gdepw_n(ji,jj,jk) / dstokes(ji,jj) 
     1055       DO_2D_00_00 
     1056          IF ( lconv(ji,jj) ) THEN 
     1057            DO jk = 2, imld(ji,jj) 
     1058               zznd_ml = gdepw(ji,jj,jk,Kmm) / zhml(ji,jj) 
     1059               zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj) 
     1060               ghamu(ji,jj,jk) = ghamu(ji,jj,jk)& 
     1061                    & + 0.3 * ( -2.0 + 2.5 * ( 1.0 + 0.1 * zznd_ml**4 ) - EXP ( -8.0 * zznd_ml ) ) * zsc_uw_1(ji,jj) 
     1062               ! 
     1063               ghamv(ji,jj,jk) = ghamv(ji,jj,jk)& 
     1064                    & + 0.3 * 0.1 * ( EXP( -zznd_d ) + EXP( -5.0 * ( 1.0 - zznd_ml ) ) ) * zsc_vw_1(ji,jj) 
     1065            END DO 
     1066          ELSE 
     1067            DO jk = 2, ibld(ji,jj) 
     1068               znd = gdepw(ji,jj,jk,Kmm) / zhbl(ji,jj) 
     1069               zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj) 
     1070               IF ( zznd_d <= 2.0 ) THEN 
     1071                  ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + 0.5 * 0.3 & 
     1072                       &*  ( 2.25 - 3.0  * ( 1.0 - EXP( - 1.25 * zznd_d ) ) * ( 1.0 - EXP( -2.0 * zznd_d ) ) ) * zsc_uw_1(ji,jj) 
     1073                  ! 
     1074               ELSE 
    11081075                  ghamu(ji,jj,jk) = ghamu(ji,jj,jk)& 
    1109                        & + 0.3 * ( -2.0 + 2.5 * ( 1.0 + 0.1 * zznd_ml**4 ) - EXP ( -8.0 * zznd_ml ) ) * zsc_uw_1(ji,jj) 
     1076                       & + 0.5 * 0.3 * ( 1.0 - EXP( -5.0 * ( 1.0 - znd ) ) ) * zsc_uw_2(ji,jj) 
    11101077                  ! 
    1111                   ghamv(ji,jj,jk) = ghamv(ji,jj,jk)& 
    1112                        & + 0.3 * 0.1 * ( EXP( -zznd_d ) + EXP( -5.0 * ( 1.0 - zznd_ml ) ) ) * zsc_vw_1(ji,jj) 
    1113                END DO 
    1114              ELSE 
    1115                DO jk = 2, ibld(ji,jj) 
    1116                   znd = gdepw_n(ji,jj,jk) / zhbl(ji,jj) 
    1117                   zznd_d = gdepw_n(ji,jj,jk) / dstokes(ji,jj) 
    1118                   IF ( zznd_d <= 2.0 ) THEN 
    1119                      ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + 0.5 * 0.3 & 
    1120                           &*  ( 2.25 - 3.0  * ( 1.0 - EXP( - 1.25 * zznd_d ) ) * ( 1.0 - EXP( -2.0 * zznd_d ) ) ) * zsc_uw_1(ji,jj) 
    1121                      ! 
    1122                   ELSE 
    1123                      ghamu(ji,jj,jk) = ghamu(ji,jj,jk)& 
    1124                           & + 0.5 * 0.3 * ( 1.0 - EXP( -5.0 * ( 1.0 - znd ) ) ) * zsc_uw_2(ji,jj) 
    1125                      ! 
    1126                   ENDIF 
    1127  
    1128                   ghamv(ji,jj,jk) = ghamv(ji,jj,jk)& 
    1129                        & + 0.3 * 0.15 * SIN( 3.14159 * ( 0.65 * zznd_d ) ) * EXP( -0.25 * zznd_d**2 ) * zsc_vw_1(ji,jj) 
    1130                   ghamv(ji,jj,jk) = ghamv(ji,jj,jk)& 
    1131                        & + 0.3 * 0.15 * EXP( -5.0 * ( 1.0 - znd ) ) * ( 1.0 - EXP( -20.0 * ( 1.0 - znd ) ) ) * zsc_vw_2(ji,jj) 
    1132                END DO 
    1133              ENDIF 
    1134           END DO 
    1135        END DO 
     1078               ENDIF 
     1079 
     1080               ghamv(ji,jj,jk) = ghamv(ji,jj,jk)& 
     1081                    & + 0.3 * 0.15 * SIN( 3.14159 * ( 0.65 * zznd_d ) ) * EXP( -0.25 * zznd_d**2 ) * zsc_vw_1(ji,jj) 
     1082               ghamv(ji,jj,jk) = ghamv(ji,jj,jk)& 
     1083                    & + 0.3 * 0.15 * EXP( -5.0 * ( 1.0 - znd ) ) * ( 1.0 - EXP( -20.0 * ( 1.0 - znd ) ) ) * zsc_vw_2(ji,jj) 
     1084            END DO 
     1085          ENDIF 
     1086       END_2D 
    11361087! 
    11371088! Make surface forced velocity non-gradient terms go to zero at the base of the mixed layer. 
    11381089 
    1139       DO jj = 2, jpjm1 
    1140          DO ji = 2, jpim1 
    1141             IF ( lconv(ji,jj) ) THEN 
    1142                DO jk = 2, ibld(ji,jj) 
    1143                   znd = ( gdepw_n(ji,jj,jk) - zhml(ji,jj) ) / zhml(ji,jj) !ALMG to think about 
    1144                   IF ( znd >= 0.0 ) THEN 
    1145                      ghamu(ji,jj,jk) = ghamu(ji,jj,jk) * ( 1.0 - EXP( -30.0 * znd**2 ) ) 
    1146                      ghamv(ji,jj,jk) = ghamv(ji,jj,jk) * ( 1.0 - EXP( -30.0 * znd**2 ) ) 
    1147                   ELSE 
    1148                      ghamu(ji,jj,jk) = 0._wp 
    1149                      ghamv(ji,jj,jk) = 0._wp 
    1150                   ENDIF 
    1151                END DO 
    1152             ELSE 
    1153                DO jk = 2, ibld(ji,jj) 
    1154                   znd = ( gdepw_n(ji,jj,jk) - zhml(ji,jj) ) / zhml(ji,jj) !ALMG to think about 
    1155                   IF ( znd >= 0.0 ) THEN 
    1156                      ghamu(ji,jj,jk) = ghamu(ji,jj,jk) * ( 1.0 - EXP( -10.0 * znd**2 ) ) 
    1157                      ghamv(ji,jj,jk) = ghamv(ji,jj,jk) * ( 1.0 - EXP( -10.0 * znd**2 ) ) 
    1158                   ELSE 
    1159                      ghamu(ji,jj,jk) = 0._wp 
    1160                      ghamv(ji,jj,jk) = 0._wp 
    1161                   ENDIF 
    1162                END DO 
    1163             ENDIF 
    1164          END DO 
    1165       END DO 
     1090      DO_2D_00_00 
     1091         IF ( lconv(ji,jj) ) THEN 
     1092            DO jk = 2, ibld(ji,jj) 
     1093               znd = ( gdepw(ji,jj,jk,Kmm) - zhml(ji,jj) ) / zhml(ji,jj) !ALMG to think about 
     1094               IF ( znd >= 0.0 ) THEN 
     1095                  ghamu(ji,jj,jk) = ghamu(ji,jj,jk) * ( 1.0 - EXP( -30.0 * znd**2 ) ) 
     1096                  ghamv(ji,jj,jk) = ghamv(ji,jj,jk) * ( 1.0 - EXP( -30.0 * znd**2 ) ) 
     1097               ELSE 
     1098                  ghamu(ji,jj,jk) = 0._wp 
     1099                  ghamv(ji,jj,jk) = 0._wp 
     1100               ENDIF 
     1101            END DO 
     1102         ELSE 
     1103            DO jk = 2, ibld(ji,jj) 
     1104               znd = ( gdepw(ji,jj,jk,Kmm) - zhml(ji,jj) ) / zhml(ji,jj) !ALMG to think about 
     1105               IF ( znd >= 0.0 ) THEN 
     1106                  ghamu(ji,jj,jk) = ghamu(ji,jj,jk) * ( 1.0 - EXP( -10.0 * znd**2 ) ) 
     1107                  ghamv(ji,jj,jk) = ghamv(ji,jj,jk) * ( 1.0 - EXP( -10.0 * znd**2 ) ) 
     1108               ELSE 
     1109                  ghamu(ji,jj,jk) = 0._wp 
     1110                  ghamv(ji,jj,jk) = 0._wp 
     1111               ENDIF 
     1112            END DO 
     1113         ENDIF 
     1114      END_2D 
    11661115 
    11671116      ! pynocline contributions 
    11681117       ! Temporary fix to avoid instabilities when zdb_bl becomes very very small 
    11691118       zsc_uw_1 = 0._wp ! 50.0 * zla**(8.0/3.0) * zustar**2 * zhbl / ( zdb_bl + epsln ) 
    1170        DO jj = 2, jpjm1 
    1171           DO ji = 2, jpim1 
    1172              DO jk= 2, ibld(ji,jj) 
    1173                 znd = gdepw_n(ji,jj,jk) / zhbl(ji,jj) 
    1174                 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + zdiffut(ji,jj,jk) * zdtdz_pyc(ji,jj,jk) 
    1175                 ghams(ji,jj,jk) = ghams(ji,jj,jk) + zdiffut(ji,jj,jk) * zdsdz_pyc(ji,jj,jk) 
    1176                 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + zviscos(ji,jj,jk) * zdudz_pyc(ji,jj,jk) 
    1177                 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + zsc_uw_1(ji,jj) * ( 1.0 - znd )**(7.0/4.0) * zdbdz_pyc(ji,jj,jk) 
    1178                 ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zviscos(ji,jj,jk) * zdvdz_pyc(ji,jj,jk) 
     1119       DO_2D_00_00 
     1120          DO jk= 2, ibld(ji,jj) 
     1121             znd = gdepw(ji,jj,jk,Kmm) / zhbl(ji,jj) 
     1122             ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + zdiffut(ji,jj,jk) * zdtdz_pyc(ji,jj,jk) 
     1123             ghams(ji,jj,jk) = ghams(ji,jj,jk) + zdiffut(ji,jj,jk) * zdsdz_pyc(ji,jj,jk) 
     1124             ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + zviscos(ji,jj,jk) * zdudz_pyc(ji,jj,jk) 
     1125             ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + zsc_uw_1(ji,jj) * ( 1.0 - znd )**(7.0/4.0) * zdbdz_pyc(ji,jj,jk) 
     1126             ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zviscos(ji,jj,jk) * zdvdz_pyc(ji,jj,jk) 
     1127          END DO 
     1128       END_2D 
     1129 
     1130! Entrainment contribution. 
     1131 
     1132       DO_2D_00_00 
     1133          IF ( lconv(ji,jj) ) THEN 
     1134            DO jk = 1, imld(ji,jj) - 1 
     1135               znd=gdepw(ji,jj,jk,Kmm) / zhml(ji,jj) 
     1136               ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + zwth_ent(ji,jj) * znd 
     1137               ghams(ji,jj,jk) = ghams(ji,jj,jk) + zws_ent(ji,jj) * znd 
     1138               ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + zuw_bse(ji,jj) * znd 
     1139               ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zvw_bse(ji,jj) * znd 
     1140            END DO 
     1141            DO jk = imld(ji,jj), ibld(ji,jj) 
     1142               znd = -( gdepw(ji,jj,jk,Kmm) - zhml(ji,jj) ) / zdh(ji,jj) 
     1143               ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + zwth_ent(ji,jj) * ( 1.0 + znd ) 
     1144               ghams(ji,jj,jk) = ghams(ji,jj,jk) + zws_ent(ji,jj) * ( 1.0 + znd ) 
     1145               ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + zuw_bse(ji,jj) * ( 1.0 + znd ) 
     1146               ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zvw_bse(ji,jj) * ( 1.0 + znd ) 
    11791147             END DO 
    1180            END DO 
    1181        END DO 
    1182  
    1183 ! Entrainment contribution. 
    1184  
    1185        DO jj=2, jpjm1 
    1186           DO ji = 2, jpim1 
    1187              IF ( lconv(ji,jj) ) THEN 
    1188                DO jk = 1, imld(ji,jj) - 1 
    1189                   znd=gdepw_n(ji,jj,jk) / zhml(ji,jj) 
    1190                   ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + zwth_ent(ji,jj) * znd 
    1191                   ghams(ji,jj,jk) = ghams(ji,jj,jk) + zws_ent(ji,jj) * znd 
    1192                   ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + zuw_bse(ji,jj) * znd 
    1193                   ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zvw_bse(ji,jj) * znd 
    1194                END DO 
    1195                DO jk = imld(ji,jj), ibld(ji,jj) 
    1196                   znd = -( gdepw_n(ji,jj,jk) - zhml(ji,jj) ) / zdh(ji,jj) 
    1197                   ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + zwth_ent(ji,jj) * ( 1.0 + znd ) 
    1198                   ghams(ji,jj,jk) = ghams(ji,jj,jk) + zws_ent(ji,jj) * ( 1.0 + znd ) 
    1199                   ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + zuw_bse(ji,jj) * ( 1.0 + znd ) 
    1200                   ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zvw_bse(ji,jj) * ( 1.0 + znd ) 
    1201                 END DO 
    1202              ENDIF 
    1203              ghamt(ji,jj,ibld(ji,jj)) = 0._wp 
    1204              ghams(ji,jj,ibld(ji,jj)) = 0._wp 
    1205              ghamu(ji,jj,ibld(ji,jj)) = 0._wp 
    1206              ghamv(ji,jj,ibld(ji,jj)) = 0._wp 
    1207           END DO       ! ji loop 
    1208        END DO          ! jj loop 
     1148          ENDIF 
     1149          ghamt(ji,jj,ibld(ji,jj)) = 0._wp 
     1150          ghams(ji,jj,ibld(ji,jj)) = 0._wp 
     1151          ghamu(ji,jj,ibld(ji,jj)) = 0._wp 
     1152          ghamv(ji,jj,ibld(ji,jj)) = 0._wp 
     1153       END_2D 
    12091154 
    12101155 
     
    12201165       ! rotate non-gradient velocity terms back to model reference frame 
    12211166 
    1222        DO jj = 2, jpjm1 
    1223           DO ji = 2, jpim1 
    1224              DO jk = 2, ibld(ji,jj) 
    1225                 ztemp = ghamu(ji,jj,jk) 
    1226                 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) * zcos_wind(ji,jj) - ghamv(ji,jj,jk) * zsin_wind(ji,jj) 
    1227                 ghamv(ji,jj,jk) = ghamv(ji,jj,jk) * zcos_wind(ji,jj) + ztemp * zsin_wind(ji,jj) 
    1228              END DO 
     1167       DO_2D_00_00 
     1168          DO jk = 2, ibld(ji,jj) 
     1169             ztemp = ghamu(ji,jj,jk) 
     1170             ghamu(ji,jj,jk) = ghamu(ji,jj,jk) * zcos_wind(ji,jj) - ghamv(ji,jj,jk) * zsin_wind(ji,jj) 
     1171             ghamv(ji,jj,jk) = ghamv(ji,jj,jk) * zcos_wind(ji,jj) + ztemp * zsin_wind(ji,jj) 
    12291172          END DO 
    1230        END DO 
     1173       END_2D 
    12311174 
    12321175       IF(ln_dia_osm) THEN 
     
    12361179! KPP-style Ri# mixing 
    12371180       IF( ln_kpprimix) THEN 
    1238           DO jk = 2, jpkm1           !* Shear production at uw- and vw-points (energy conserving form) 
    1239              DO jj = 1, jpjm1 
    1240                 DO ji = 1, jpim1   ! vector opt. 
    1241                    z3du(ji,jj,jk) = 0.5 * (  un(ji,jj,jk-1) -  un(ji  ,jj,jk) )   & 
    1242                         &                 * (  ub(ji,jj,jk-1) -  ub(ji  ,jj,jk) ) * wumask(ji,jj,jk) & 
    1243                         &                 / (  e3uw_n(ji,jj,jk) * e3uw_b(ji,jj,jk) ) 
    1244                    z3dv(ji,jj,jk) = 0.5 * (  vn(ji,jj,jk-1) -  vn(ji,jj  ,jk) )   & 
    1245                         &                 * (  vb(ji,jj,jk-1) -  vb(ji,jj  ,jk) ) * wvmask(ji,jj,jk) & 
    1246                         &                 / (  e3vw_n(ji,jj,jk) * e3vw_b(ji,jj,jk) ) 
    1247                 END DO 
     1181          DO_3D_10_10( 2, jpkm1 ) 
     1182             z3du(ji,jj,jk) = 0.5 * (  uu(ji,jj,jk-1,Kmm) -  uu(ji  ,jj,jk,Kmm) )   & 
     1183                  &                 * (  uu(ji,jj,jk-1,Kbb) -  uu(ji  ,jj,jk,Kbb) ) * wumask(ji,jj,jk) & 
     1184                  &                 / (  e3uw(ji,jj,jk,Kmm) * e3uw(ji,jj,jk,Kbb) ) 
     1185             z3dv(ji,jj,jk) = 0.5 * (  vv(ji,jj,jk-1,Kmm) -  vv(ji,jj  ,jk,Kmm) )   & 
     1186                  &                 * (  vv(ji,jj,jk-1,Kbb) -  vv(ji,jj  ,jk,Kbb) ) * wvmask(ji,jj,jk) & 
     1187                  &                 / (  e3vw(ji,jj,jk,Kmm) * e3vw(ji,jj,jk,Kbb) ) 
     1188          END_3D 
     1189      ! 
     1190         DO_3D_00_00( 2, jpkm1 ) 
     1191            !                                          ! shear prod. at w-point weightened by mask 
     1192            zesh2  =  ( z3du(ji-1,jj,jk) + z3du(ji,jj,jk) ) / MAX( 1._wp , umask(ji-1,jj,jk) + umask(ji,jj,jk) )   & 
     1193               &    + ( z3dv(ji,jj-1,jk) + z3dv(ji,jj,jk) ) / MAX( 1._wp , vmask(ji,jj-1,jk) + vmask(ji,jj,jk) ) 
     1194            !                                          ! local Richardson number 
     1195            zri   = MAX( rn2b(ji,jj,jk), 0._wp ) / MAX(zesh2, epsln) 
     1196            zfri =  MIN( zri / rn_riinfty , 1.0_wp ) 
     1197            zfri  = ( 1.0_wp - zfri * zfri ) 
     1198            zrimix(ji,jj,jk)  =  zfri * zfri  * zfri * wmask(ji, jj, jk) 
     1199         END_3D 
     1200 
     1201          DO_2D_00_00 
     1202             DO jk = ibld(ji,jj) + 1, jpkm1 
     1203                zdiffut(ji,jj,jk) = zrimix(ji,jj,jk)*rn_difri 
     1204                zviscos(ji,jj,jk) = zrimix(ji,jj,jk)*rn_difri 
    12481205             END DO 
    1249           END DO 
    1250       ! 
    1251          DO jk = 2, jpkm1 
    1252             DO jj = 2, jpjm1 
    1253                DO ji = 2, jpim1   ! vector opt. 
    1254                   !                                          ! shear prod. at w-point weightened by mask 
    1255                   zesh2  =  ( z3du(ji-1,jj,jk) + z3du(ji,jj,jk) ) / MAX( 1._wp , umask(ji-1,jj,jk) + umask(ji,jj,jk) )   & 
    1256                      &    + ( z3dv(ji,jj-1,jk) + z3dv(ji,jj,jk) ) / MAX( 1._wp , vmask(ji,jj-1,jk) + vmask(ji,jj,jk) ) 
    1257                   !                                          ! local Richardson number 
    1258                   zri   = MAX( rn2b(ji,jj,jk), 0._wp ) / MAX(zesh2, epsln) 
    1259                   zfri =  MIN( zri / rn_riinfty , 1.0_wp ) 
    1260                   zfri  = ( 1.0_wp - zfri * zfri ) 
    1261                   zrimix(ji,jj,jk)  =  zfri * zfri  * zfri * wmask(ji, jj, jk) 
    1262                 END DO 
    1263              END DO 
    1264           END DO 
    1265  
    1266           DO jj = 2, jpjm1 
    1267              DO ji = 2, jpim1 
    1268                 DO jk = ibld(ji,jj) + 1, jpkm1 
    1269                    zdiffut(ji,jj,jk) = zrimix(ji,jj,jk)*rn_difri 
    1270                    zviscos(ji,jj,jk) = zrimix(ji,jj,jk)*rn_difri 
    1271                 END DO 
    1272              END DO 
    1273           END DO 
     1206          END_2D 
    12741207 
    12751208       END IF ! ln_kpprimix = .true. 
     
    12771210! KPP-style set diffusivity large if unstable below BL 
    12781211       IF( ln_convmix) THEN 
    1279           DO jj = 2, jpjm1 
    1280              DO ji = 2, jpim1 
    1281                 DO jk = ibld(ji,jj) + 1, jpkm1 
    1282                   IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) zdiffut(ji,jj,jk) = rn_difconv 
    1283                 END DO 
     1212          DO_2D_00_00 
     1213             DO jk = ibld(ji,jj) + 1, jpkm1 
     1214               IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) zdiffut(ji,jj,jk) = rn_difconv 
    12841215             END DO 
    1285           END DO 
     1216          END_2D 
    12861217       END IF ! ln_convmix = .true. 
    12871218 
     
    12911222       ! GN 25/8: need to change tmask --> wmask 
    12921223 
    1293      DO jk = 2, jpkm1 
    1294          DO jj = 2, jpjm1 
    1295              DO ji = 2, jpim1 
    1296                 p_avt(ji,jj,jk) = MAX( zdiffut(ji,jj,jk), avtb(jk) ) * tmask(ji,jj,jk) 
    1297                 p_avm(ji,jj,jk) = MAX( zviscos(ji,jj,jk), avmb(jk) ) * tmask(ji,jj,jk) 
    1298              END DO 
    1299          END DO 
    1300      END DO 
     1224     DO_3D_00_00( 2, jpkm1 ) 
     1225          p_avt(ji,jj,jk) = MAX( zdiffut(ji,jj,jk), avtb(jk) ) * tmask(ji,jj,jk) 
     1226          p_avm(ji,jj,jk) = MAX( zviscos(ji,jj,jk), avmb(jk) ) * tmask(ji,jj,jk) 
     1227     END_3D 
    13011228      ! Lateral boundary conditions on ghamu and ghamv, currently on W-grid  (sign unchanged), needed to caclulate gham[uv] on u and v grids 
    13021229     CALL lbc_lnk_multi( 'zdfosm', p_avt, 'W', 1. , p_avm, 'W', 1.,   & 
    13031230      &                  ghamu, 'W', 1. , ghamv, 'W', 1. ) 
    1304        DO jk = 2, jpkm1 
    1305            DO jj = 2, jpjm1 
    1306                DO ji = 2, jpim1 
    1307                   ghamu(ji,jj,jk) = ( ghamu(ji,jj,jk) + ghamu(ji+1,jj,jk) ) & 
    1308                      &  / MAX( 1., tmask(ji,jj,jk) + tmask (ji + 1,jj,jk) ) * umask(ji,jj,jk) 
    1309  
    1310                   ghamv(ji,jj,jk) = ( ghamv(ji,jj,jk) + ghamv(ji,jj+1,jk) ) & 
    1311                       &  / MAX( 1., tmask(ji,jj,jk) + tmask (ji,jj+1,jk) ) * vmask(ji,jj,jk) 
    1312  
    1313                   ghamt(ji,jj,jk) =  ghamt(ji,jj,jk) * tmask(ji,jj,jk) 
    1314                   ghams(ji,jj,jk) =  ghams(ji,jj,jk) * tmask(ji,jj,jk) 
    1315                END DO 
    1316            END DO 
    1317         END DO 
     1231       DO_3D_00_00( 2, jpkm1 ) 
     1232            ghamu(ji,jj,jk) = ( ghamu(ji,jj,jk) + ghamu(ji+1,jj,jk) ) & 
     1233               &  / MAX( 1., tmask(ji,jj,jk) + tmask (ji + 1,jj,jk) ) * umask(ji,jj,jk) 
     1234 
     1235            ghamv(ji,jj,jk) = ( ghamv(ji,jj,jk) + ghamv(ji,jj+1,jk) ) & 
     1236                &  / MAX( 1., tmask(ji,jj,jk) + tmask (ji,jj+1,jk) ) * vmask(ji,jj,jk) 
     1237 
     1238            ghamt(ji,jj,jk) =  ghamt(ji,jj,jk) * tmask(ji,jj,jk) 
     1239            ghams(ji,jj,jk) =  ghams(ji,jj,jk) * tmask(ji,jj,jk) 
     1240       END_3D 
    13181241        ! Lateral boundary conditions on final outputs for gham[ts],  on W-grid  (sign unchanged) 
    13191242        ! Lateral boundary conditions on final outputs for gham[uv],  on [UV]-grid  (sign unchanged) 
     
    13641287 
    13651288 
    1366    SUBROUTINE zdf_osm_init 
     1289   SUBROUTINE zdf_osm_init( Kmm )  
    13671290     !!---------------------------------------------------------------------- 
    13681291     !!                  ***  ROUTINE zdf_osm_init  *** 
     
    13761299     !! ** input   :   Namlist namosm 
    13771300     !!---------------------------------------------------------------------- 
     1301     INTEGER, INTENT(in)    :: Kmm ! time level index (middle) 
     1302     ! 
    13781303     INTEGER  ::   ios            ! local integer 
    13791304     INTEGER  ::   ji, jj, jk     ! dummy loop indices 
     
    13841309     !!---------------------------------------------------------------------- 
    13851310     ! 
    1386      REWIND( numnam_ref )              ! Namelist namzdf_osm in reference namelist : Osmosis ML model 
    13871311     READ  ( numnam_ref, namzdf_osm, IOSTAT = ios, ERR = 901) 
    13881312901  IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_osm in reference namelist' ) 
    13891313 
    1390      REWIND( numnam_cfg )              ! Namelist namzdf_tke in configuration namelist : Turbulent Kinetic Energy 
    13911314     READ  ( numnam_cfg, namzdf_osm, IOSTAT = ios, ERR = 902 ) 
    13921315902  IF( ios >  0 ) CALL ctl_nam ( ios , 'namzdf_osm in configuration namelist' ) 
     
    14231346     IF( zdf_osm_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_osm_init : unable to allocate arrays' ) 
    14241347 
    1425      call osm_rst( nit000, 'READ' ) !* read or initialize hbl 
     1348     call osm_rst( nit000, Kmm, 'READ' ) !* read or initialize hbl 
    14261349 
    14271350     IF( ln_zdfddm) THEN 
     
    14591382        etmean(:,:,:) = 0.e0 
    14601383 
    1461         DO jk = 1, jpkm1 
    1462            DO jj = 2, jpjm1 
    1463               DO ji = 2, jpim1   ! vector opt. 
    1464                  etmean(ji,jj,jk) = tmask(ji,jj,jk)                     & 
    1465                       &  / MAX( 1.,  umask(ji-1,jj  ,jk) + umask(ji,jj,jk)   & 
    1466                       &            + vmask(ji  ,jj-1,jk) + vmask(ji,jj,jk)  ) 
    1467               END DO 
    1468            END DO 
    1469         END DO 
     1384        DO_3D_00_00( 1, jpkm1 ) 
     1385           etmean(ji,jj,jk) = tmask(ji,jj,jk)                     & 
     1386                &  / MAX( 1.,  umask(ji-1,jj  ,jk) + umask(ji,jj,jk)   & 
     1387                &            + vmask(ji  ,jj-1,jk) + vmask(ji,jj,jk)  ) 
     1388        END_3D 
    14701389 
    14711390     CASE ( 1 )                ! horizontal average 
     
    14771396        etmean(:,:,:) = 0.e0 
    14781397 
    1479         DO jk = 1, jpkm1 
    1480            DO jj = 2, jpjm1 
    1481               DO ji = 2, jpim1   ! vector opt. 
    1482                  etmean(ji,jj,jk) = tmask(ji, jj,jk)                           & 
    1483                       & / MAX( 1., 2.* tmask(ji,jj,jk)                           & 
    1484                       &      +.5 * ( tmask(ji-1,jj+1,jk) + tmask(ji-1,jj-1,jk)   & 
    1485                       &             +tmask(ji+1,jj+1,jk) + tmask(ji+1,jj-1,jk) ) & 
    1486                       &      +1. * ( tmask(ji-1,jj  ,jk) + tmask(ji  ,jj+1,jk)   & 
    1487                       &             +tmask(ji  ,jj-1,jk) + tmask(ji+1,jj  ,jk) ) ) 
    1488               END DO 
    1489            END DO 
    1490         END DO 
     1398        DO_3D_00_00( 1, jpkm1 ) 
     1399           etmean(ji,jj,jk) = tmask(ji, jj,jk)                           & 
     1400                & / MAX( 1., 2.* tmask(ji,jj,jk)                           & 
     1401                &      +.5 * ( tmask(ji-1,jj+1,jk) + tmask(ji-1,jj-1,jk)   & 
     1402                &             +tmask(ji+1,jj+1,jk) + tmask(ji+1,jj-1,jk) ) & 
     1403                &      +1. * ( tmask(ji-1,jj  ,jk) + tmask(ji  ,jj+1,jk)   & 
     1404                &             +tmask(ji  ,jj-1,jk) + tmask(ji+1,jj  ,jk) ) ) 
     1405        END_3D 
    14911406 
    14921407     CASE DEFAULT 
     
    15171432 
    15181433 
    1519    SUBROUTINE osm_rst( kt, cdrw ) 
     1434   SUBROUTINE osm_rst( kt, Kmm, cdrw ) 
    15201435     !!--------------------------------------------------------------------- 
    15211436     !!                   ***  ROUTINE osm_rst  *** 
     
    15271442     !!---------------------------------------------------------------------- 
    15281443 
    1529      INTEGER, INTENT(in) :: kt 
     1444     INTEGER         , INTENT(in) ::   kt     ! ocean time step index 
     1445     INTEGER         , INTENT(in) ::   Kmm    ! ocean time level index (middle) 
    15301446     CHARACTER(len=*), INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag 
    15311447 
     
    15451461        id1 = iom_varid( numror, 'wn'   , ldstop = .FALSE. ) 
    15461462        IF( id1 > 0 ) THEN                       ! 'wn' exists; read 
    1547            CALL iom_get( numror, jpdom_autoglo, 'wn', wn, ldxios = lrxios ) 
    1548            WRITE(numout,*) ' ===>>>> :  wn read from restart file' 
     1463           CALL iom_get( numror, jpdom_autoglo, 'wn', ww, ldxios = lrxios ) 
     1464           WRITE(numout,*) ' ===>>>> :  ww read from restart file' 
    15491465        ELSE 
    1550            wn(:,:,:) = 0._wp 
    1551            WRITE(numout,*) ' ===>>>> :  wn not in restart file, set to zero initially' 
     1466           ww(:,:,:) = 0._wp 
     1467           WRITE(numout,*) ' ===>>>> :  ww not in restart file, set to zero initially' 
    15521468        END IF 
    15531469        id1 = iom_varid( numror, 'hbl'   , ldstop = .FALSE. ) 
     
    15681484     IF( TRIM(cdrw) == 'WRITE') THEN     !* Write hbli into the restart file, then return 
    15691485        IF(lwp) WRITE(numout,*) '---- osm-rst ----' 
    1570          CALL iom_rstput( kt, nitrst, numrow, 'wn'     , wn  , ldxios = lwxios ) 
     1486         CALL iom_rstput( kt, nitrst, numrow, 'wn'     , ww  , ldxios = lwxios ) 
    15711487         CALL iom_rstput( kt, nitrst, numrow, 'hbl'    , hbl , ldxios = lwxios ) 
    15721488         CALL iom_rstput( kt, nitrst, numrow, 'hbli'   , hbli, ldxios = lwxios ) 
     
    15801496     ALLOCATE( imld_rst(jpi,jpj) ) 
    15811497     ! w-level of the mixing and mixed layers 
    1582      CALL eos_rab( tsn, rab_n ) 
    1583      CALL bn2(tsn, rab_n, rn2) 
     1498     CALL eos_rab( ts(:,:,:,:,Kmm), rab_n, Kmm ) 
     1499     CALL bn2(ts(:,:,:,:,Kmm), rab_n, rn2, Kmm) 
    15841500     imld_rst(:,:)  = nlb10         ! Initialization to the number of w ocean point 
    15851501     hbl(:,:)  = 0._wp              ! here hbl used as a dummy variable, integrating vertically N^2 
     
    15871503     ! 
    15881504     hbl(:,:)  = 0._wp              ! here hbl used as a dummy variable, integrating vertically N^2 
    1589      DO jk = 1, jpkm1 
    1590         DO jj = 1, jpj              ! Mixed layer level: w-level 
    1591            DO ji = 1, jpi 
    1592               ikt = mbkt(ji,jj) 
    1593               hbl(ji,jj) = hbl(ji,jj) + MAX( rn2(ji,jj,jk) , 0._wp ) * e3w_n(ji,jj,jk) 
    1594               IF( hbl(ji,jj) < zN2_c )   imld_rst(ji,jj) = MIN( jk , ikt ) + 1   ! Mixed layer level 
    1595            END DO 
    1596         END DO 
    1597      END DO 
     1505     DO_3D_11_11( 1, jpkm1 ) 
     1506        ikt = mbkt(ji,jj) 
     1507        hbl(ji,jj) = hbl(ji,jj) + MAX( rn2(ji,jj,jk) , 0._wp ) * e3w(ji,jj,jk,Kmm) 
     1508        IF( hbl(ji,jj) < zN2_c )   imld_rst(ji,jj) = MIN( jk , ikt ) + 1   ! Mixed layer level 
     1509     END_3D 
    15981510     ! 
    1599      DO jj = 1, jpj 
    1600         DO ji = 1, jpi 
    1601            iiki = imld_rst(ji,jj) 
    1602            hbl (ji,jj) = gdepw_n(ji,jj,iiki  ) * ssmask(ji,jj)    ! Turbocline depth 
    1603         END DO 
    1604      END DO 
     1511     DO_2D_11_11 
     1512        iiki = imld_rst(ji,jj) 
     1513        hbl (ji,jj) = gdepw(ji,jj,iiki  ,Kmm) * ssmask(ji,jj)    ! Turbocline depth 
     1514     END_2D 
    16051515     hbl = MAX(hbl,epsln) 
    16061516     hbli(:,:) = hbl(:,:) 
     
    16101520 
    16111521 
    1612    SUBROUTINE tra_osm( kt ) 
     1522   SUBROUTINE tra_osm( kt, Kmm, pts, Krhs ) 
    16131523      !!---------------------------------------------------------------------- 
    16141524      !!                  ***  ROUTINE tra_osm  *** 
     
    16201530      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdt, ztrds   ! 3D workspace 
    16211531      !!---------------------------------------------------------------------- 
    1622       INTEGER, INTENT(in) :: kt 
     1532      INTEGER                                  , INTENT(in)    :: kt        ! time step index 
     1533      INTEGER                                  , INTENT(in)    :: Kmm, Krhs ! time level indices 
     1534      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts       ! active tracers and RHS of tracer equation 
     1535      ! 
    16231536      INTEGER :: ji, jj, jk 
    16241537      ! 
     
    16301543 
    16311544      IF( l_trdtra )   THEN                    !* Save ta and sa trends 
    1632          ALLOCATE( ztrdt(jpi,jpj,jpk) )   ;    ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
    1633          ALLOCATE( ztrds(jpi,jpj,jpk) )   ;    ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
     1545         ALLOCATE( ztrdt(jpi,jpj,jpk) )   ;    ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) 
     1546         ALLOCATE( ztrds(jpi,jpj,jpk) )   ;    ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) 
    16341547      ENDIF 
    16351548 
    16361549      ! add non-local temperature and salinity flux 
    1637       DO jk = 1, jpkm1 
    1638          DO jj = 2, jpjm1 
    1639             DO ji = 2, jpim1 
    1640                tsa(ji,jj,jk,jp_tem) =  tsa(ji,jj,jk,jp_tem)                      & 
    1641                   &                 - (  ghamt(ji,jj,jk  )  & 
    1642                   &                    - ghamt(ji,jj,jk+1) ) /e3t_n(ji,jj,jk) 
    1643                tsa(ji,jj,jk,jp_sal) =  tsa(ji,jj,jk,jp_sal)                      & 
    1644                   &                 - (  ghams(ji,jj,jk  )  & 
    1645                   &                    - ghams(ji,jj,jk+1) ) / e3t_n(ji,jj,jk) 
    1646             END DO 
    1647          END DO 
    1648       END DO 
     1550      DO_3D_00_00( 1, jpkm1 ) 
     1551         pts(ji,jj,jk,jp_tem,Krhs) =  pts(ji,jj,jk,jp_tem,Krhs)                      & 
     1552            &                 - (  ghamt(ji,jj,jk  )  & 
     1553            &                    - ghamt(ji,jj,jk+1) ) /e3t(ji,jj,jk,Kmm) 
     1554         pts(ji,jj,jk,jp_sal,Krhs) =  pts(ji,jj,jk,jp_sal,Krhs)                      & 
     1555            &                 - (  ghams(ji,jj,jk  )  & 
     1556            &                    - ghams(ji,jj,jk+1) ) / e3t(ji,jj,jk,Kmm) 
     1557      END_3D 
    16491558 
    16501559 
    16511560      ! save the non-local tracer flux trends for diagnostic 
    16521561      IF( l_trdtra )   THEN 
    1653          ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 
    1654          ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:) 
     1562         ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:) 
     1563         ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:) 
    16551564!!bug gm jpttdzdf ==> jpttosm 
    1656          CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdf, ztrdt ) 
    1657          CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdf, ztrds ) 
     1565         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_zdf, ztrdt ) 
     1566         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_zdf, ztrds ) 
    16581567         DEALLOCATE( ztrdt )      ;     DEALLOCATE( ztrds ) 
    16591568      ENDIF 
    16601569 
    1661       IF(ln_ctl) THEN 
    1662          CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' osm  - Ta: ', mask1=tmask,   & 
    1663          &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     1570      IF(sn_cfctl%l_prtctl) THEN 
     1571         CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' osm  - Ta: ', mask1=tmask,   & 
     1572         &             tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    16641573      ENDIF 
    16651574      ! 
     
    16841593 
    16851594 
    1686    SUBROUTINE dyn_osm( kt ) 
     1595   SUBROUTINE dyn_osm( kt, Kmm, puu, pvv, Krhs ) 
    16871596      !!---------------------------------------------------------------------- 
    16881597      !!                  ***  ROUTINE dyn_osm  *** 
     
    16931602      !! ** Method  :   ??? 
    16941603      !!---------------------------------------------------------------------- 
    1695       INTEGER, INTENT(in) ::   kt   ! 
     1604      INTEGER                             , INTENT( in )  ::  kt          ! ocean time step index 
     1605      INTEGER                             , INTENT( in )  ::  Kmm, Krhs   ! ocean time level indices 
     1606      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation 
    16961607      ! 
    16971608      INTEGER :: ji, jj, jk   ! dummy loop indices 
     
    17051616      !code saving tracer trends removed, replace with trdmxl_oce 
    17061617 
    1707       DO jk = 1, jpkm1           ! add non-local u and v fluxes 
    1708          DO jj = 2, jpjm1 
    1709             DO ji = 2, jpim1 
    1710                ua(ji,jj,jk) =  ua(ji,jj,jk)                      & 
    1711                   &                 - (  ghamu(ji,jj,jk  )  & 
    1712                   &                    - ghamu(ji,jj,jk+1) ) / e3u_n(ji,jj,jk) 
    1713                va(ji,jj,jk) =  va(ji,jj,jk)                      & 
    1714                   &                 - (  ghamv(ji,jj,jk  )  & 
    1715                   &                    - ghamv(ji,jj,jk+1) ) / e3v_n(ji,jj,jk) 
    1716             END DO 
    1717          END DO 
    1718       END DO 
     1618      DO_3D_00_00( 1, jpkm1 ) 
     1619         puu(ji,jj,jk,Krhs) =  puu(ji,jj,jk,Krhs)                      & 
     1620            &                 - (  ghamu(ji,jj,jk  )  & 
     1621            &                    - ghamu(ji,jj,jk+1) ) / e3u(ji,jj,jk,Kmm) 
     1622         pvv(ji,jj,jk,Krhs) =  pvv(ji,jj,jk,Krhs)                      & 
     1623            &                 - (  ghamv(ji,jj,jk  )  & 
     1624            &                    - ghamv(ji,jj,jk+1) ) / e3v(ji,jj,jk,Kmm) 
     1625      END_3D 
    17191626      ! 
    17201627      ! code for saving tracer trends removed 
  • NEMO/trunk/src/OCE/ZDF/zdfphy.F90

    r11536 r12377  
    6161CONTAINS 
    6262 
    63    SUBROUTINE zdf_phy_init 
     63   SUBROUTINE zdf_phy_init( Kmm ) 
    6464      !!---------------------------------------------------------------------- 
    6565      !!                  ***  ROUTINE zdf_phy_init  *** 
     
    7070      !!                set horizontal shape and vertical profile of background mixing coef. 
    7171      !!---------------------------------------------------------------------- 
     72      INTEGER, INTENT(in)    :: Kmm ! time level index (middle) 
     73      ! 
    7274      INTEGER ::   jk            ! dummy loop indices 
    7375      INTEGER ::   ioptio, ios   ! local integers 
     
    9193      ! 
    9294      !                           !==  Namelist  ==! 
    93       REWIND( numnam_ref )              ! Namelist namzdf in reference namelist : Vertical mixing parameters 
    9495      READ  ( numnam_ref, namzdf, IOSTAT = ios, ERR = 901) 
    9596901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namzdf in reference namelist' ) 
    9697      ! 
    97       REWIND( numnam_cfg )              ! Namelist namzdf in reference namelist : Vertical mixing parameters 
    9898      READ  ( numnam_cfg, namzdf, IOSTAT = ios, ERR = 902 ) 
    9999902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namzdf in configuration namelist' ) 
     
    191191      ioptio = 0  
    192192      IF( ln_zdfcst ) THEN   ;   ioptio = ioptio + 1   ;    nzdf_phy = np_CST   ;   ENDIF 
    193       IF( ln_zdfric ) THEN   ;   ioptio = ioptio + 1   ;    nzdf_phy = np_RIC   ;   CALL zdf_ric_init   ;   ENDIF 
    194       IF( ln_zdftke ) THEN   ;   ioptio = ioptio + 1   ;    nzdf_phy = np_TKE   ;   CALL zdf_tke_init   ;   ENDIF 
    195       IF( ln_zdfgls ) THEN   ;   ioptio = ioptio + 1   ;    nzdf_phy = np_GLS   ;   CALL zdf_gls_init   ;   ENDIF 
    196       IF( ln_zdfosm ) THEN   ;   ioptio = ioptio + 1   ;    nzdf_phy = np_OSM   ;   CALL zdf_osm_init   ;   ENDIF 
     193      IF( ln_zdfric ) THEN   ;   ioptio = ioptio + 1   ;    nzdf_phy = np_RIC   ;   CALL zdf_ric_init          ;   ENDIF 
     194      IF( ln_zdftke ) THEN   ;   ioptio = ioptio + 1   ;    nzdf_phy = np_TKE   ;   CALL zdf_tke_init( Kmm )   ;   ENDIF 
     195      IF( ln_zdfgls ) THEN   ;   ioptio = ioptio + 1   ;    nzdf_phy = np_GLS   ;   CALL zdf_gls_init          ;   ENDIF 
     196      IF( ln_zdfosm ) THEN   ;   ioptio = ioptio + 1   ;    nzdf_phy = np_OSM   ;   CALL zdf_osm_init( Kmm )   ;   ENDIF 
    197197      ! 
    198198      IF( ioptio /= 1 )    CALL ctl_stop( 'zdf_phy_init: one and only one vertical diffusion option has to be defined ' ) 
     
    219219 
    220220 
    221    SUBROUTINE zdf_phy( kt ) 
     221   SUBROUTINE zdf_phy( kt, Kbb, Kmm, Krhs ) 
    222222      !!---------------------------------------------------------------------- 
    223223      !!                     ***  ROUTINE zdf_phy  *** 
     
    231231      !!                bottom stress.....                               <<<<====verifier ! 
    232232      !!---------------------------------------------------------------------- 
    233       INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     233      INTEGER, INTENT(in) ::   kt         ! ocean time-step index 
     234      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs   ! ocean time level indices 
    234235      ! 
    235236      INTEGER ::   ji, jj, jk   ! dummy loop indice 
     
    242243         ! 
    243244         !                       !* bottom drag 
    244          CALL zdf_drg( kt, mbkt    , r_Cdmin_bot, r_Cdmax_bot,   &   ! <<== in  
     245         CALL zdf_drg( kt, Kmm, mbkt , r_Cdmin_bot, r_Cdmax_bot,   &   ! <<== in  
    245246            &              r_z0_bot,   r_ke0_bot,    rCd0_bot,   & 
    246247            &                                        rCdU_bot  )     ! ==>> out : bottom drag [m/s] 
    247248         IF( ln_isfcav ) THEN    !* top drag   (ocean cavities) 
    248             CALL zdf_drg( kt, mikt    , r_Cdmin_top, r_Cdmax_top,   &   ! <<== in  
     249            CALL zdf_drg( kt, Kmm, mikt , r_Cdmin_top, r_Cdmax_top,   &   ! <<== in  
    249250               &              r_z0_top,   r_ke0_top,    rCd0_top,   & 
    250251               &                                        rCdU_top  )     ! ==>> out : bottom drag [m/s] 
     
    255256      ! 
    256257      IF( l_zdfsh2 )   &         !* shear production at w-points (energy conserving form) 
    257          CALL zdf_sh2( ub, vb, un, vn, avm_k,   &     ! <<== in 
    258             &                           zsh2    )     ! ==>> out : shear production 
     258         CALL zdf_sh2( Kbb, Kmm, avm_k,   &     ! <<== in 
     259            &                     zsh2    )     ! ==>> out : shear production 
    259260      ! 
    260261      SELECT CASE ( nzdf_phy )                  !* Vertical eddy viscosity and diffusivity coefficients at w-points 
    261       CASE( np_RIC )   ;   CALL zdf_ric( kt, gdept_n, zsh2, avm_k, avt_k )    ! Richardson number dependent Kz 
    262       CASE( np_TKE )   ;   CALL zdf_tke( kt         , zsh2, avm_k, avt_k )    ! TKE closure scheme for Kz 
    263       CASE( np_GLS )   ;   CALL zdf_gls( kt         , zsh2, avm_k, avt_k )    ! GLS closure scheme for Kz 
    264       CASE( np_OSM )   ;   CALL zdf_osm( kt               , avm_k, avt_k )    ! OSMOSIS closure scheme for Kz 
     262      CASE( np_RIC )   ;   CALL zdf_ric( kt,      Kmm, zsh2, avm_k, avt_k )    ! Richardson number dependent Kz 
     263      CASE( np_TKE )   ;   CALL zdf_tke( kt, Kbb, Kmm, zsh2, avm_k, avt_k )    ! TKE closure scheme for Kz 
     264      CASE( np_GLS )   ;   CALL zdf_gls( kt, Kbb, Kmm, zsh2, avm_k, avt_k )    ! GLS closure scheme for Kz 
     265      CASE( np_OSM )   ;   CALL zdf_osm( kt, Kbb, Kmm, Krhs, avm_k, avt_k )    ! OSMOSIS closure scheme for Kz 
    265266!     CASE( np_CST )                                  ! Constant Kz (reset avt, avm to the background value) 
    266267!         ! avt_k and avm_k set one for all at initialisation phase 
     
    281282      ENDIF 
    282283      ! 
    283       IF( ln_zdfevd )   CALL zdf_evd( kt, avm, avt )  !* convection: enhanced vertical eddy diffusivity 
     284      IF( ln_zdfevd )   CALL zdf_evd( kt, Kmm, Krhs, avm, avt )  !* convection: enhanced vertical eddy diffusivity 
    284285      ! 
    285286      !                                         !* double diffusive mixing 
    286287      IF( ln_zdfddm ) THEN                            ! update avt and compute avs 
    287                         CALL zdf_ddm( kt, avm, avt, avs ) 
     288                        CALL zdf_ddm( kt, Kmm,  avm, avt, avs ) 
    288289      ELSE                                            ! same mixing on all tracers 
    289290         avs(2:jpim1,2:jpjm1,1:jpkm1) = avt(2:jpim1,2:jpjm1,1:jpkm1) 
     
    291292      ! 
    292293      !                                         !* wave-induced mixing  
    293       IF( ln_zdfswm )   CALL zdf_swm( kt, avm, avt, avs )   ! surface  wave (Qiao et al. 2004)  
    294       IF( ln_zdfiwm )   CALL zdf_iwm( kt, avm, avt, avs )   ! internal wave (de Lavergne et al 2017) 
     294      IF( ln_zdfswm )   CALL zdf_swm( kt, Kmm, avm, avt, avs )   ! surface  wave (Qiao et al. 2004)  
     295      IF( ln_zdfiwm )   CALL zdf_iwm( kt, Kmm, avm, avt, avs )   ! internal wave (de Lavergne et al 2017) 
    295296 
    296297#if defined key_agrif  
     
    313314      ENDIF 
    314315      ! 
    315       CALL zdf_mxl( kt )                        !* mixed layer depth, and level 
     316      CALL zdf_mxl( kt, Kmm )                        !* mixed layer depth, and level 
    316317      ! 
    317318      IF( lrst_oce ) THEN                       !* write TKE, GLS or RIC fields in the restart file 
     
    319320         IF( ln_zdfgls )   CALL gls_rst( kt, 'WRITE' ) 
    320321         IF( ln_zdfric )   CALL ric_rst( kt, 'WRITE' )  
    321          ! NB. OSMOSIS restart (osm_rst) will be called in step.F90 after wn has been updated 
     322         ! NB. OSMOSIS restart (osm_rst) will be called in step.F90 after ww has been updated 
    322323      ENDIF 
    323324      ! 
  • NEMO/trunk/src/OCE/ZDF/zdfric.F90

    r11536 r12377  
    5050 
    5151   !! * Substitutions 
    52 #  include "vectopt_loop_substitute.h90" 
     52#  include "do_loop_substitute.h90" 
    5353   !!---------------------------------------------------------------------- 
    5454   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    7878      !!---------------------------------------------------------------------- 
    7979      ! 
    80       REWIND( numnam_ref )              ! Namelist namzdf_ric in reference namelist : Vertical diffusion Kz depends on Richardson number 
    8180      READ  ( numnam_ref, namzdf_ric, IOSTAT = ios, ERR = 901) 
    8281901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_ric in reference namelist' ) 
    8382 
    84       REWIND( numnam_cfg )              ! Namelist namzdf_ric in configuration namelist : Vertical diffusion Kz depends on Richardson number 
    8583      READ  ( numnam_cfg, namzdf_ric, IOSTAT = ios, ERR = 902 ) 
    8684902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namzdf_ric in configuration namelist' ) 
     
    112110 
    113111 
    114    SUBROUTINE zdf_ric( kt, pdept, p_sh2, p_avm, p_avt ) 
     112   SUBROUTINE zdf_ric( kt, Kmm, p_sh2, p_avm, p_avt ) 
    115113      !!---------------------------------------------------------------------- 
    116114      !!                 ***  ROUTINE zdfric  *** 
     
    125123      !!                    avt = avm0 / (1 + rn_alp*ri) 
    126124      !!                with ri  = N^2 / dz(u)**2 
    127       !!                         = e3w**2 * rn2/[ mi( dk(ub) )+mj( dk(vb) ) ] 
     125      !!                         = e3w**2 * rn2/[ mi( dk(uu(:,:,:,Kbb)) )+mj( dk(vv(:,:,:,Kbb)) ) ] 
    128126      !!                    avm0= rn_avmri / (1 + rn_alp*Ri)**nn_ric 
    129127      !!                where ri is the before local Richardson number, 
     
    152150      !!---------------------------------------------------------------------- 
    153151      INTEGER                   , INTENT(in   ) ::   kt             ! ocean time-step 
    154       REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pdept          ! depth of t-point  [m] 
     152      INTEGER                   , INTENT(in   ) ::   Kmm            ! ocean time level index 
    155153      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   p_sh2          ! shear production term 
    156154      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   p_avm, p_avt   ! momentum and tracer Kz (w-points) 
     
    162160      ! 
    163161      !                       !==  avm and avt = F(Richardson number)  ==! 
    164       DO jk = 2, jpkm1 
    165          DO jj = 1, jpjm1 
    166             DO ji = 1, jpim1              ! coefficient = F(richardson number) (avm-weighted Ri) 
    167                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 ) )  ) 
    168                zav   = rn_avmri * zcfRi**nn_ric 
    169                !                          ! avm and avt coefficients 
    170                p_avm(ji,jj,jk) = MAX(  zav         , avmb(jk)  ) * wmask(ji,jj,jk) 
    171                p_avt(ji,jj,jk) = MAX(  zav * zcfRi , avtb(jk)  ) * wmask(ji,jj,jk) 
    172             END DO 
    173          END DO 
    174       END DO 
     162      DO_3D_10_10( 2, jpkm1 ) 
     163         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 ) )  ) 
     164         zav   = rn_avmri * zcfRi**nn_ric 
     165         !                          ! avm and avt coefficients 
     166         p_avm(ji,jj,jk) = MAX(  zav         , avmb(jk)  ) * wmask(ji,jj,jk) 
     167         p_avt(ji,jj,jk) = MAX(  zav * zcfRi , avtb(jk)  ) * wmask(ji,jj,jk) 
     168      END_3D 
    175169      ! 
    176170!!gm BUG <<<<====  This param can't work at low latitude  
     
    179173      IF( ln_mldw ) THEN      !==  set a minimum value in the Ekman layer  ==! 
    180174         ! 
    181          DO jj = 2, jpjm1        !* Ekman depth 
    182             DO ji = 2, jpim1 
    183                zustar = SQRT( taum(ji,jj) * r1_rau0 ) 
    184                zhek   = rn_ekmfc * zustar / ( ABS( ff_t(ji,jj) ) + rsmall )   ! Ekman depth 
    185                zh_ekm(ji,jj) = MAX(  rn_mldmin , MIN( zhek , rn_mldmax )  )   ! set allowed range 
    186             END DO 
    187          END DO 
    188          DO jk = 2, jpkm1        !* minimum mixing coeff. within the Ekman layer 
    189             DO jj = 2, jpjm1 
    190                DO ji = 2, jpim1 
    191                   IF( pdept(ji,jj,jk) < zh_ekm(ji,jj) ) THEN 
    192                      p_avm(ji,jj,jk) = MAX(  p_avm(ji,jj,jk), rn_wvmix  ) * wmask(ji,jj,jk) 
    193                      p_avt(ji,jj,jk) = MAX(  p_avt(ji,jj,jk), rn_wtmix  ) * wmask(ji,jj,jk) 
    194                   ENDIF 
    195                END DO 
    196             END DO 
    197          END DO 
     175         DO_2D_00_00 
     176            zustar = SQRT( taum(ji,jj) * r1_rau0 ) 
     177            zhek   = rn_ekmfc * zustar / ( ABS( ff_t(ji,jj) ) + rsmall )   ! Ekman depth 
     178            zh_ekm(ji,jj) = MAX(  rn_mldmin , MIN( zhek , rn_mldmax )  )   ! set allowed range 
     179         END_2D 
     180         DO_3D_00_00( 2, jpkm1 ) 
     181            IF( gdept(ji,jj,jk,Kmm) < zh_ekm(ji,jj) ) THEN 
     182               p_avm(ji,jj,jk) = MAX(  p_avm(ji,jj,jk), rn_wvmix  ) * wmask(ji,jj,jk) 
     183               p_avt(ji,jj,jk) = MAX(  p_avt(ji,jj,jk), rn_wtmix  ) * wmask(ji,jj,jk) 
     184            ENDIF 
     185         END_3D 
    198186      ENDIF 
    199187      ! 
  • NEMO/trunk/src/OCE/ZDF/zdfsh2.F90

    r10069 r12377  
    1111   !!   zdf_sh2       : compute mixing the shear production term of TKE 
    1212   !!---------------------------------------------------------------------- 
     13   USE oce 
    1314   USE dom_oce        ! domain: ocean 
    1415   ! 
     
    2122   PUBLIC   zdf_sh2        ! called by zdftke, zdfglf, and zdfric 
    2223    
     24   !! * Substitutions 
     25#  include "do_loop_substitute.h90" 
    2326   !!---------------------------------------------------------------------- 
    2427   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    2831CONTAINS 
    2932 
    30    SUBROUTINE zdf_sh2( pub, pvb, pun, pvn, p_avm, p_sh2  )  
     33   SUBROUTINE zdf_sh2( Kbb, Kmm, p_avm, p_sh2  )  
    3134      !!---------------------------------------------------------------------- 
    3235      !!                   ***  ROUTINE zdf_sh2  *** 
     
    4750      !! References :   Bruchard, OM 2002 
    4851      !! --------------------------------------------------------------------- 
    49       REAL(wp), DIMENSION(:,:,:) , INTENT(in   ) ::   pub, pvb, pun, pvn   ! before, now horizontal velocities 
     52      INTEGER                    , INTENT(in   ) ::   Kbb, Kmm             ! ocean time level indices 
    5053      REAL(wp), DIMENSION(:,:,:) , INTENT(in   ) ::   p_avm                ! vertical eddy viscosity (w-points) 
    5154      REAL(wp), DIMENSION(:,:,:) , INTENT(  out) ::   p_sh2                ! shear production of TKE (w-points) 
     
    5659      ! 
    5760      DO jk = 2, jpkm1 
    58          DO jj = 1, jpjm1        !* 2 x shear production at uw- and vw-points (energy conserving form) 
    59             DO ji = 1, jpim1 
    60                zsh2u(ji,jj) = ( p_avm(ji+1,jj,jk) + p_avm(ji,jj,jk) ) & 
    61                   &         * (   pun(ji,jj,jk-1) -   pun(ji,jj,jk) ) & 
    62                   &         * (   pub(ji,jj,jk-1) -   pub(ji,jj,jk) ) / ( e3uw_n(ji,jj,jk) * e3uw_b(ji,jj,jk) ) * wumask(ji,jj,jk) 
    63                zsh2v(ji,jj) = ( p_avm(ji,jj+1,jk) + p_avm(ji,jj,jk) ) & 
    64                   &         * (   pvn(ji,jj,jk-1) -   pvn(ji,jj,jk) ) & 
    65                   &         * (   pvb(ji,jj,jk-1) -   pvb(ji,jj,jk) ) / ( e3vw_n(ji,jj,jk) * e3vw_b(ji,jj,jk) ) * wvmask(ji,jj,jk) 
    66             END DO 
    67          END DO 
    68          DO jj = 2, jpjm1        !* shear production at w-point 
    69             DO ji = 2, jpim1           ! coast mask: =2 at the coast ; =1 otherwise (NB: wmask useless as zsh2 are masked) 
    70                p_sh2(ji,jj,jk) = 0.25 * (   ( zsh2u(ji-1,jj) + zsh2u(ji,jj) ) * ( 2. - umask(ji-1,jj,jk) * umask(ji,jj,jk) )   & 
    71                   &                       + ( zsh2v(ji,jj-1) + zsh2v(ji,jj) ) * ( 2. - vmask(ji,jj-1,jk) * vmask(ji,jj,jk) )   ) 
    72             END DO 
    73          END DO 
     61         DO_2D_10_10 
     62            zsh2u(ji,jj) = ( p_avm(ji+1,jj,jk) + p_avm(ji,jj,jk) ) & 
     63               &         * (   uu(ji,jj,jk-1,Kmm) -   uu(ji,jj,jk,Kmm) ) & 
     64               &         * (   uu(ji,jj,jk-1,Kbb) -   uu(ji,jj,jk,Kbb) ) / ( e3uw(ji,jj,jk,Kmm) * e3uw(ji,jj,jk,Kbb) ) * wumask(ji,jj,jk) 
     65            zsh2v(ji,jj) = ( p_avm(ji,jj+1,jk) + p_avm(ji,jj,jk) ) & 
     66               &         * (   vv(ji,jj,jk-1,Kmm) -   vv(ji,jj,jk,Kmm) ) & 
     67               &         * (   vv(ji,jj,jk-1,Kbb) -   vv(ji,jj,jk,Kbb) ) / ( e3vw(ji,jj,jk,Kmm) * e3vw(ji,jj,jk,Kbb) ) * wvmask(ji,jj,jk) 
     68         END_2D 
     69         DO_2D_00_00 
     70            p_sh2(ji,jj,jk) = 0.25 * (   ( zsh2u(ji-1,jj) + zsh2u(ji,jj) ) * ( 2. - umask(ji-1,jj,jk) * umask(ji,jj,jk) )   & 
     71               &                       + ( zsh2v(ji,jj-1) + zsh2v(ji,jj) ) * ( 2. - vmask(ji,jj-1,jk) * vmask(ji,jj,jk) )   ) 
     72         END_2D 
    7473      END DO  
    7574      ! 
  • NEMO/trunk/src/OCE/ZDF/zdfswm.F90

    r10069 r12377  
    2727   PUBLIC zdf_swm_init    ! routine called in zdf_phy_init 
    2828 
     29   !! * Substitutions 
     30#  include "do_loop_substitute.h90" 
    2931   !!---------------------------------------------------------------------- 
    3032   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    3436CONTAINS 
    3537 
    36    SUBROUTINE zdf_swm( kt, p_avm, p_avt, p_avs ) 
     38   SUBROUTINE zdf_swm( kt, Kmm, p_avm, p_avt, p_avs ) 
    3739      !!--------------------------------------------------------------------- 
    3840      !!                     ***  ROUTINE zdf_swm *** 
     
    5254      !!--------------------------------------------------------------------- 
    5355      INTEGER                    , INTENT(in   ) ::   kt             ! ocean time step 
     56      INTEGER                    , INTENT(in   ) ::   Kmm            ! time level index 
    5457      REAL(wp), DIMENSION(:,:,:) , INTENT(inout) ::   p_avm          ! momentum Kz (w-points) 
    5558      REAL(wp), DIMENSION(:,:,:) , INTENT(inout) ::   p_avt, p_avs   ! tracer   Kz (w-points) 
     
    6063      ! 
    6164      zcoef = 1._wp * 0.353553_wp 
    62       DO jk = 2, jpkm1 
    63          DO jj = 2, jpjm1 
    64             DO ji = 2, jpim1 
    65                zqb = zcoef * hsw(ji,jj) * tsd2d(ji,jj) * EXP( -3. * wnum(ji,jj) * gdepw_n(ji,jj,jk) ) * wmask(ji,jj,jk) 
    66                ! 
    67                p_avt(ji,jj,jk) = p_avt(ji,jj,jk) + zqb 
    68                p_avs(ji,jj,jk) = p_avs(ji,jj,jk) + zqb 
    69                p_avm(ji,jj,jk) = p_avm(ji,jj,jk) + zqb 
    70             END DO 
    71          END DO 
    72       END DO 
     65      DO_3D_00_00( 2, jpkm1 ) 
     66         zqb = zcoef * hsw(ji,jj) * tsd2d(ji,jj) * EXP( -3. * wnum(ji,jj) * gdepw(ji,jj,jk,Kmm) ) * wmask(ji,jj,jk) 
     67         ! 
     68         p_avt(ji,jj,jk) = p_avt(ji,jj,jk) + zqb 
     69         p_avs(ji,jj,jk) = p_avs(ji,jj,jk) + zqb 
     70         p_avm(ji,jj,jk) = p_avm(ji,jj,jk) + zqb 
     71      END_3D 
    7372      ! 
    7473   END SUBROUTINE zdf_swm 
  • NEMO/trunk/src/OCE/ZDF/zdftke.F90

    r11536 r12377  
    8989 
    9090   !! * Substitutions 
    91 #  include "vectopt_loop_substitute.h90" 
     91#  include "do_loop_substitute.h90" 
    9292   !!---------------------------------------------------------------------- 
    9393   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    109109 
    110110 
    111    SUBROUTINE zdf_tke( kt, p_sh2, p_avm, p_avt ) 
     111   SUBROUTINE zdf_tke( kt, Kbb, Kmm, p_sh2, p_avm, p_avt ) 
    112112      !!---------------------------------------------------------------------- 
    113113      !!                   ***  ROUTINE zdf_tke  *** 
     
    155155      !!---------------------------------------------------------------------- 
    156156      INTEGER                   , INTENT(in   ) ::   kt             ! ocean time step 
     157      INTEGER                   , INTENT(in   ) ::   Kbb, Kmm       ! ocean time level indices 
    157158      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   p_sh2          ! shear production term 
    158159      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   p_avm, p_avt   !  momentum and tracer Kz (w-points) 
    159160      !!---------------------------------------------------------------------- 
    160161      ! 
    161       CALL tke_tke( gdepw_n, e3t_n, e3w_n, p_sh2, p_avm, p_avt )   ! now tke (en) 
    162       ! 
    163       CALL tke_avn( gdepw_n, e3t_n, e3w_n,        p_avm, p_avt )   ! now avt, avm, dissl 
     162      CALL tke_tke( Kbb, Kmm, p_sh2, p_avm, p_avt )   ! now tke (en) 
     163      ! 
     164      CALL tke_avn( Kbb, Kmm,        p_avm, p_avt )   ! now avt, avm, dissl 
    164165      ! 
    165166  END SUBROUTINE zdf_tke 
    166167 
    167168 
    168    SUBROUTINE tke_tke( pdepw, p_e3t, p_e3w, p_sh2, p_avm, p_avt ) 
     169   SUBROUTINE tke_tke( Kbb, Kmm, p_sh2, p_avm, p_avt ) 
    169170      !!---------------------------------------------------------------------- 
    170171      !!                   ***  ROUTINE tke_tke  *** 
     
    186187      USE zdf_oce , ONLY : en   ! ocean vertical physics 
    187188      !! 
    188       REAL(wp), DIMENSION(:,:,:) , INTENT(in   ) ::   pdepw          ! depth of w-points 
    189       REAL(wp), DIMENSION(:,:,:) , INTENT(in   ) ::   p_e3t, p_e3w   ! level thickness (t- & w-points) 
     189      INTEGER                    , INTENT(in   ) ::   Kbb, Kmm       ! ocean time level indices 
    190190      REAL(wp), DIMENSION(:,:,:) , INTENT(in   ) ::   p_sh2          ! shear production term 
    191191      REAL(wp), DIMENSION(:,:,:) , INTENT(in   ) ::   p_avm, p_avt   ! vertical eddy viscosity & diffusivity (w-points) 
     
    215215      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    216216       
    217       DO jj = 2, jpjm1            ! en(1)   = rn_ebb taum / rau0  (min value rn_emin0) 
    218          DO ji = fs_2, fs_jpim1   ! vector opt. 
    219             en(ji,jj,1) = MAX( rn_emin0, zbbrau * taum(ji,jj) ) * tmask(ji,jj,1) 
    220          END DO 
    221       END DO 
     217      DO_2D_00_00 
     218         en(ji,jj,1) = MAX( rn_emin0, zbbrau * taum(ji,jj) ) * tmask(ji,jj,1) 
     219      END_2D 
    222220      IF ( ln_isfcav ) THEN 
    223          DO jj = 2, jpjm1            ! en(mikt(ji,jj))   = rn_emin 
    224             DO ji = fs_2, fs_jpim1   ! vector opt. 
    225                en(ji,jj,mikt(ji,jj)) = rn_emin * tmask(ji,jj,1) 
    226             END DO 
    227          END DO 
     221         DO_2D_00_00 
     222            en(ji,jj,mikt(ji,jj)) = rn_emin * tmask(ji,jj,1) 
     223         END_2D 
    228224      ENDIF 
    229225      ! 
     
    238234      IF( ln_drg ) THEN       !== friction used as top/bottom boundary condition on TKE 
    239235         ! 
    240          DO jj = 2, jpjm1           ! bottom friction 
    241             DO ji = fs_2, fs_jpim1     ! vector opt. 
    242                zmsku = ( 2. - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) ) 
    243                zmskv = ( 2. - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) ) 
    244                !                       ! where 0.001875 = (rn_ebb0/rau0) * 0.5 = 3.75*0.5/1000. (CAUTION CdU<0) 
    245                zebot = - 0.001875_wp * rCdU_bot(ji,jj) * SQRT(  ( zmsku*( ub(ji,jj,mbkt(ji,jj))+ub(ji-1,jj,mbkt(ji,jj)) ) )**2  & 
    246                   &                                           + ( zmskv*( vb(ji,jj,mbkt(ji,jj))+vb(ji,jj-1,mbkt(ji,jj)) ) )**2  ) 
    247                en(ji,jj,mbkt(ji,jj)+1) = MAX( zebot, rn_emin ) * ssmask(ji,jj) 
    248             END DO 
    249          END DO 
     236         DO_2D_00_00 
     237            zmsku = ( 2. - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) ) 
     238            zmskv = ( 2. - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) ) 
     239            !                       ! where 0.001875 = (rn_ebb0/rau0) * 0.5 = 3.75*0.5/1000. (CAUTION CdU<0) 
     240            zebot = - 0.001875_wp * rCdU_bot(ji,jj) * SQRT(  ( zmsku*( uu(ji,jj,mbkt(ji,jj),Kbb)+uu(ji-1,jj,mbkt(ji,jj),Kbb) ) )**2  & 
     241               &                                           + ( zmskv*( vv(ji,jj,mbkt(ji,jj),Kbb)+vv(ji,jj-1,mbkt(ji,jj),Kbb) ) )**2  ) 
     242            en(ji,jj,mbkt(ji,jj)+1) = MAX( zebot, rn_emin ) * ssmask(ji,jj) 
     243         END_2D 
    250244         IF( ln_isfcav ) THEN       ! top friction 
    251             DO jj = 2, jpjm1 
    252                DO ji = fs_2, fs_jpim1   ! vector opt. 
    253                   zmsku = ( 2. - umask(ji-1,jj,mikt(ji,jj)) * umask(ji,jj,mikt(ji,jj)) ) 
    254                   zmskv = ( 2. - vmask(ji,jj-1,mikt(ji,jj)) * vmask(ji,jj,mikt(ji,jj)) ) 
    255                   !                             ! where 0.001875 = (rn_ebb0/rau0) * 0.5 = 3.75*0.5/1000.  (CAUTION CdU<0) 
    256                   zetop = - 0.001875_wp * rCdU_top(ji,jj) * SQRT(  ( zmsku*( ub(ji,jj,mikt(ji,jj))+ub(ji-1,jj,mikt(ji,jj)) ) )**2  & 
    257                      &                                           + ( zmskv*( vb(ji,jj,mikt(ji,jj))+vb(ji,jj-1,mikt(ji,jj)) ) )**2  ) 
    258                   en(ji,jj,mikt(ji,jj)) = MAX( zetop, rn_emin ) * (1._wp - tmask(ji,jj,1))   ! masked at ocean surface 
    259                END DO 
    260             END DO 
     245            DO_2D_00_00 
     246               zmsku = ( 2. - umask(ji-1,jj,mikt(ji,jj)) * umask(ji,jj,mikt(ji,jj)) ) 
     247               zmskv = ( 2. - vmask(ji,jj-1,mikt(ji,jj)) * vmask(ji,jj,mikt(ji,jj)) ) 
     248               !                             ! where 0.001875 = (rn_ebb0/rau0) * 0.5 = 3.75*0.5/1000.  (CAUTION CdU<0) 
     249               zetop = - 0.001875_wp * rCdU_top(ji,jj) * SQRT(  ( zmsku*( uu(ji,jj,mikt(ji,jj),Kbb)+uu(ji-1,jj,mikt(ji,jj),Kbb) ) )**2  & 
     250                  &                                           + ( zmskv*( vv(ji,jj,mikt(ji,jj),Kbb)+vv(ji,jj-1,mikt(ji,jj),Kbb) ) )**2  ) 
     251               en(ji,jj,mikt(ji,jj)) = MAX( zetop, rn_emin ) * (1._wp - tmask(ji,jj,1))   ! masked at ocean surface 
     252            END_2D 
    261253         ENDIF 
    262254         ! 
     
    268260         ! 
    269261         !                        !* total energy produce by LC : cumulative sum over jk 
    270          zpelc(:,:,1) =  MAX( rn2b(:,:,1), 0._wp ) * pdepw(:,:,1) * p_e3w(:,:,1) 
     262         zpelc(:,:,1) =  MAX( rn2b(:,:,1), 0._wp ) * gdepw(:,:,1,Kmm) * e3w(:,:,1,Kmm) 
    271263         DO jk = 2, jpk 
    272             zpelc(:,:,jk)  = zpelc(:,:,jk-1) + MAX( rn2b(:,:,jk), 0._wp ) * pdepw(:,:,jk) * p_e3w(:,:,jk) 
     264            zpelc(:,:,jk)  = zpelc(:,:,jk-1) + MAX( rn2b(:,:,jk), 0._wp ) * gdepw(:,:,jk,Kmm) * e3w(:,:,jk,Kmm) 
    273265         END DO 
    274266         !                        !* finite Langmuir Circulation depth 
    275267         zcof = 0.5 * 0.016 * 0.016 / ( zrhoa * zcdrag ) 
    276268         imlc(:,:) = mbkt(:,:) + 1       ! Initialization to the number of w ocean point (=2 over land) 
    277          DO jk = jpkm1, 2, -1 
    278             DO jj = 1, jpj               ! Last w-level at which zpelc>=0.5*us*us  
    279                DO ji = 1, jpi            !      with us=0.016*wind(starting from jpk-1) 
    280                   zus  = zcof * taum(ji,jj) 
    281                   IF( zpelc(ji,jj,jk) > zus )   imlc(ji,jj) = jk 
    282                END DO 
    283             END DO 
    284          END DO 
     269         DO_3DS_11_11( jpkm1, 2, -1 ) 
     270            zus  = zcof * taum(ji,jj) 
     271            IF( zpelc(ji,jj,jk) > zus )   imlc(ji,jj) = jk 
     272         END_3D 
    285273         !                               ! finite LC depth 
    286          DO jj = 1, jpj  
    287             DO ji = 1, jpi 
    288                zhlc(ji,jj) = pdepw(ji,jj,imlc(ji,jj)) 
    289             END DO 
    290          END DO 
     274         DO_2D_11_11 
     275            zhlc(ji,jj) = gdepw(ji,jj,imlc(ji,jj),Kmm) 
     276         END_2D 
    291277         zcof = 0.016 / SQRT( zrhoa * zcdrag ) 
    292          DO jj = 2, jpjm1 
    293             DO ji = fs_2, fs_jpim1   ! vector opt. 
    294                zus  = zcof * SQRT( taum(ji,jj) )           ! Stokes drift 
    295                zfr_i(ji,jj) = ( 1._wp - 4._wp * fr_i(ji,jj) ) * zus * zus * zus * tmask(ji,jj,1) ! zus > 0. ok 
    296                IF (zfr_i(ji,jj) < 0. ) zfr_i(ji,jj) = 0. 
    297             END DO 
    298          END DO          
    299          DO jk = 2, jpkm1         !* TKE Langmuir circulation source term added to en 
    300             DO jj = 2, jpjm1 
    301                DO ji = fs_2, fs_jpim1   ! vector opt. 
    302                   IF ( zfr_i(ji,jj) /= 0. ) THEN                
    303                      ! vertical velocity due to LC    
    304                      IF ( pdepw(ji,jj,jk) - zhlc(ji,jj) < 0 .AND. wmask(ji,jj,jk) /= 0. ) THEN 
    305                         !                                           ! vertical velocity due to LC 
    306                         zwlc = rn_lc * SIN( rpi * pdepw(ji,jj,jk) / zhlc(ji,jj) )   ! warning: optimization: zus^3 is in zfr_i 
    307                         !                                           ! TKE Langmuir circulation source term 
    308                         en(ji,jj,jk) = en(ji,jj,jk) + rdt * zfr_i(ji,jj) * ( zwlc * zwlc * zwlc ) / zhlc(ji,jj) 
    309                      ENDIF 
    310                   ENDIF 
    311                END DO 
    312             END DO 
    313          END DO 
     278         DO_2D_00_00 
     279            zus  = zcof * SQRT( taum(ji,jj) )           ! Stokes drift 
     280            zfr_i(ji,jj) = ( 1._wp - 4._wp * fr_i(ji,jj) ) * zus * zus * zus * tmask(ji,jj,1) ! zus > 0. ok 
     281            IF (zfr_i(ji,jj) < 0. ) zfr_i(ji,jj) = 0. 
     282         END_2D 
     283         DO_3D_00_00( 2, jpkm1 ) 
     284            IF ( zfr_i(ji,jj) /= 0. ) THEN                
     285               ! vertical velocity due to LC    
     286               IF ( gdepw(ji,jj,jk,Kmm) - zhlc(ji,jj) < 0 .AND. wmask(ji,jj,jk) /= 0. ) THEN 
     287                  !                                           ! vertical velocity due to LC 
     288                  zwlc = rn_lc * SIN( rpi * gdepw(ji,jj,jk,Kmm) / zhlc(ji,jj) )   ! warning: optimization: zus^3 is in zfr_i 
     289                  !                                           ! TKE Langmuir circulation source term 
     290                  en(ji,jj,jk) = en(ji,jj,jk) + rdt * zfr_i(ji,jj) * ( zwlc * zwlc * zwlc ) / zhlc(ji,jj) 
     291               ENDIF 
     292            ENDIF 
     293         END_3D 
    314294         ! 
    315295      ENDIF 
     
    323303      ! 
    324304      IF( nn_pdl == 1 ) THEN      !* Prandtl number = F( Ri ) 
    325          DO jk = 2, jpkm1 
    326             DO jj = 2, jpjm1 
    327                DO ji = 2, jpim1 
    328                   !                             ! local Richardson number 
    329                   zri = MAX( rn2b(ji,jj,jk), 0._wp ) * p_avm(ji,jj,jk) / ( p_sh2(ji,jj,jk) + rn_bshear ) 
    330                   !                             ! inverse of Prandtl number 
    331                   apdlr(ji,jj,jk) = MAX(  0.1_wp,  ri_cri / MAX( ri_cri , zri )  ) 
    332                END DO 
    333             END DO 
    334          END DO 
     305         DO_3D_00_00( 2, jpkm1 ) 
     306            !                             ! local Richardson number 
     307            zri = MAX( rn2b(ji,jj,jk), 0._wp ) * p_avm(ji,jj,jk) / ( p_sh2(ji,jj,jk) + rn_bshear ) 
     308            !                             ! inverse of Prandtl number 
     309            apdlr(ji,jj,jk) = MAX(  0.1_wp,  ri_cri / MAX( ri_cri , zri )  ) 
     310         END_3D 
    335311      ENDIF 
    336312      !          
    337       DO jk = 2, jpkm1           !* Matrix and right hand side in en 
    338          DO jj = 2, jpjm1 
    339             DO ji = fs_2, fs_jpim1   ! vector opt. 
    340                zcof   = zfact1 * tmask(ji,jj,jk) 
    341                !                                   ! A minimum of 2.e-5 m2/s is imposed on TKE vertical 
    342                !                                   ! eddy coefficient (ensure numerical stability) 
    343                zzd_up = zcof * MAX(  p_avm(ji,jj,jk+1) + p_avm(ji,jj,jk  ) , 2.e-5_wp  )   &  ! upper diagonal 
    344                   &          /    (  p_e3t(ji,jj,jk  ) * p_e3w(ji,jj,jk  )  ) 
    345                zzd_lw = zcof * MAX(  p_avm(ji,jj,jk  ) + p_avm(ji,jj,jk-1) , 2.e-5_wp  )   &  ! lower diagonal 
    346                   &          /    (  p_e3t(ji,jj,jk-1) * p_e3w(ji,jj,jk  )  ) 
    347                ! 
    348                zd_up(ji,jj,jk) = zzd_up            ! Matrix (zdiag, zd_up, zd_lw) 
    349                zd_lw(ji,jj,jk) = zzd_lw 
    350                zdiag(ji,jj,jk) = 1._wp - zzd_lw - zzd_up + zfact2 * dissl(ji,jj,jk) * wmask(ji,jj,jk) 
    351                ! 
    352                !                                   ! right hand side in en 
    353                en(ji,jj,jk) = en(ji,jj,jk) + rdt * (  p_sh2(ji,jj,jk)                          &   ! shear 
    354                   &                                 - p_avt(ji,jj,jk) * rn2(ji,jj,jk)          &   ! stratification 
    355                   &                                 + zfact3 * dissl(ji,jj,jk) * en(ji,jj,jk)  &   ! dissipation 
    356                   &                                ) * wmask(ji,jj,jk) 
    357             END DO 
    358          END DO 
    359       END DO 
     313      DO_3D_00_00( 2, jpkm1 ) 
     314         zcof   = zfact1 * tmask(ji,jj,jk) 
     315         !                                   ! A minimum of 2.e-5 m2/s is imposed on TKE vertical 
     316         !                                   ! eddy coefficient (ensure numerical stability) 
     317         zzd_up = zcof * MAX(  p_avm(ji,jj,jk+1) + p_avm(ji,jj,jk  ) , 2.e-5_wp  )   &  ! upper diagonal 
     318            &          /    (  e3t(ji,jj,jk  ,Kmm) * e3w(ji,jj,jk  ,Kmm)  ) 
     319         zzd_lw = zcof * MAX(  p_avm(ji,jj,jk  ) + p_avm(ji,jj,jk-1) , 2.e-5_wp  )   &  ! lower diagonal 
     320            &          /    (  e3t(ji,jj,jk-1,Kmm) * e3w(ji,jj,jk  ,Kmm)  ) 
     321         ! 
     322         zd_up(ji,jj,jk) = zzd_up            ! Matrix (zdiag, zd_up, zd_lw) 
     323         zd_lw(ji,jj,jk) = zzd_lw 
     324         zdiag(ji,jj,jk) = 1._wp - zzd_lw - zzd_up + zfact2 * dissl(ji,jj,jk) * wmask(ji,jj,jk) 
     325         ! 
     326         !                                   ! right hand side in en 
     327         en(ji,jj,jk) = en(ji,jj,jk) + rdt * (  p_sh2(ji,jj,jk)                          &   ! shear 
     328            &                                 - p_avt(ji,jj,jk) * rn2(ji,jj,jk)          &   ! stratification 
     329            &                                 + zfact3 * dissl(ji,jj,jk) * en(ji,jj,jk)  &   ! dissipation 
     330            &                                ) * wmask(ji,jj,jk) 
     331      END_3D 
    360332      !                          !* Matrix inversion from level 2 (tke prescribed at level 1) 
    361       DO jk = 3, jpkm1                             ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 
    362          DO jj = 2, jpjm1 
    363             DO ji = fs_2, fs_jpim1    ! vector opt. 
    364                zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1) 
    365             END DO 
    366          END DO 
    367       END DO 
    368       DO jj = 2, jpjm1                             ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 
    369          DO ji = fs_2, fs_jpim1   ! vector opt. 
    370             zd_lw(ji,jj,2) = en(ji,jj,2) - zd_lw(ji,jj,2) * en(ji,jj,1)    ! Surface boudary conditions on tke 
    371          END DO 
    372       END DO 
    373       DO jk = 3, jpkm1 
    374          DO jj = 2, jpjm1 
    375             DO ji = fs_2, fs_jpim1    ! vector opt. 
    376                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) 
    377             END DO 
    378          END DO 
    379       END DO 
    380       DO jj = 2, jpjm1                             ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 
    381          DO ji = fs_2, fs_jpim1   ! vector opt. 
    382             en(ji,jj,jpkm1) = zd_lw(ji,jj,jpkm1) / zdiag(ji,jj,jpkm1) 
    383          END DO 
    384       END DO 
    385       DO jk = jpk-2, 2, -1 
    386          DO jj = 2, jpjm1 
    387             DO ji = fs_2, fs_jpim1    ! vector opt. 
    388                en(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * en(ji,jj,jk+1) ) / zdiag(ji,jj,jk) 
    389             END DO 
    390          END DO 
    391       END DO 
    392       DO jk = 2, jpkm1                             ! set the minimum value of tke 
    393          DO jj = 2, jpjm1 
    394             DO ji = fs_2, fs_jpim1   ! vector opt. 
    395                en(ji,jj,jk) = MAX( en(ji,jj,jk), rn_emin ) * wmask(ji,jj,jk) 
    396             END DO 
    397          END DO 
    398       END DO 
     333      DO_3D_00_00( 3, jpkm1 ) 
     334         zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1) 
     335      END_3D 
     336      DO_2D_00_00 
     337         zd_lw(ji,jj,2) = en(ji,jj,2) - zd_lw(ji,jj,2) * en(ji,jj,1)    ! Surface boudary conditions on tke 
     338      END_2D 
     339      DO_3D_00_00( 3, jpkm1 ) 
     340         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) 
     341      END_3D 
     342      DO_2D_00_00 
     343         en(ji,jj,jpkm1) = zd_lw(ji,jj,jpkm1) / zdiag(ji,jj,jpkm1) 
     344      END_2D 
     345      DO_3DS_00_00( jpk-2, 2, -1 ) 
     346         en(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * en(ji,jj,jk+1) ) / zdiag(ji,jj,jk) 
     347      END_3D 
     348      DO_3D_00_00( 2, jpkm1 ) 
     349         en(ji,jj,jk) = MAX( en(ji,jj,jk), rn_emin ) * wmask(ji,jj,jk) 
     350      END_3D 
    399351      ! 
    400352      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     
    402354      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    403355!!gm BUG : in the exp  remove the depth of ssh !!! 
    404 !!gm       i.e. use gde3w in argument (pdepw) 
     356!!gm       i.e. use gde3w in argument (gdepw(:,:,:,Kmm)) 
    405357       
    406358       
    407359      IF( nn_etau == 1 ) THEN           !* penetration below the mixed layer (rn_efr fraction) 
    408          DO jk = 2, jpkm1                       ! rn_eice =0 ON below sea-ice, =4 OFF when ice fraction > 0.25 
    409             DO jj = 2, jpjm1 
    410                DO ji = fs_2, fs_jpim1   ! vector opt. 
    411                   en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -pdepw(ji,jj,jk) / htau(ji,jj) )   & 
    412                      &                                 * MAX(0.,1._wp - rn_eice *fr_i(ji,jj) )  * wmask(ji,jj,jk) * tmask(ji,jj,1) 
    413                END DO 
    414             END DO 
    415          END DO 
     360         DO_3D_00_00( 2, jpkm1 ) 
     361            en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -gdepw(ji,jj,jk,Kmm) / htau(ji,jj) )   & 
     362               &                                 * MAX(0.,1._wp - rn_eice *fr_i(ji,jj) )  * wmask(ji,jj,jk) * tmask(ji,jj,1) 
     363         END_3D 
    416364      ELSEIF( nn_etau == 2 ) THEN       !* act only at the base of the mixed layer (jk=nmln)  (rn_efr fraction) 
    417          DO jj = 2, jpjm1 
    418             DO ji = fs_2, fs_jpim1   ! vector opt. 
    419                jk = nmln(ji,jj) 
    420                en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -pdepw(ji,jj,jk) / htau(ji,jj) )   & 
    421                   &                                 * MAX(0.,1._wp - rn_eice *fr_i(ji,jj) )  * wmask(ji,jj,jk) * tmask(ji,jj,1) 
    422             END DO 
    423          END DO 
     365         DO_2D_00_00 
     366            jk = nmln(ji,jj) 
     367            en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -gdepw(ji,jj,jk,Kmm) / htau(ji,jj) )   & 
     368               &                                 * MAX(0.,1._wp - rn_eice *fr_i(ji,jj) )  * wmask(ji,jj,jk) * tmask(ji,jj,1) 
     369         END_2D 
    424370      ELSEIF( nn_etau == 3 ) THEN       !* penetration belox the mixed layer (HF variability) 
    425          DO jk = 2, jpkm1 
    426             DO jj = 2, jpjm1 
    427                DO ji = fs_2, fs_jpim1   ! vector opt. 
    428                   ztx2 = utau(ji-1,jj  ) + utau(ji,jj) 
    429                   zty2 = vtau(ji  ,jj-1) + vtau(ji,jj) 
    430                   ztau = 0.5_wp * SQRT( ztx2 * ztx2 + zty2 * zty2 ) * tmask(ji,jj,1)    ! module of the mean stress  
    431                   zdif = taum(ji,jj) - ztau                            ! mean of modulus - modulus of the mean  
    432                   zdif = rhftau_scl * MAX( 0._wp, zdif + rhftau_add )  ! apply some modifications... 
    433                   en(ji,jj,jk) = en(ji,jj,jk) + zbbrau * zdif * EXP( -pdepw(ji,jj,jk) / htau(ji,jj) )   & 
    434                      &                        * MAX(0.,1._wp - rn_eice *fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 
    435                END DO 
    436             END DO 
    437          END DO 
     371         DO_3D_00_00( 2, jpkm1 ) 
     372            ztx2 = utau(ji-1,jj  ) + utau(ji,jj) 
     373            zty2 = vtau(ji  ,jj-1) + vtau(ji,jj) 
     374            ztau = 0.5_wp * SQRT( ztx2 * ztx2 + zty2 * zty2 ) * tmask(ji,jj,1)    ! module of the mean stress  
     375            zdif = taum(ji,jj) - ztau                            ! mean of modulus - modulus of the mean  
     376            zdif = rhftau_scl * MAX( 0._wp, zdif + rhftau_add )  ! apply some modifications... 
     377            en(ji,jj,jk) = en(ji,jj,jk) + zbbrau * zdif * EXP( -gdepw(ji,jj,jk,Kmm) / htau(ji,jj) )   & 
     378               &                        * MAX(0.,1._wp - rn_eice *fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 
     379         END_3D 
    438380      ENDIF 
    439381      ! 
     
    441383 
    442384 
    443    SUBROUTINE tke_avn( pdepw, p_e3t, p_e3w, p_avm, p_avt ) 
     385   SUBROUTINE tke_avn( Kbb, Kmm, p_avm, p_avt ) 
    444386      !!---------------------------------------------------------------------- 
    445387      !!                   ***  ROUTINE tke_avn  *** 
     
    477419      USE zdf_oce , ONLY : en, avtb, avmb, avtb_2d   ! ocean vertical physics 
    478420      !! 
    479       REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pdepw          ! depth (w-points) 
    480       REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   p_e3t, p_e3w   ! level thickness (t- & w-points) 
     421      INTEGER                   , INTENT(in   ) ::   Kbb, Kmm       ! ocean time level indices 
    481422      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   p_avm, p_avt   ! vertical eddy viscosity & diffusivity (w-points) 
    482423      ! 
     
    500441      IF( ln_mxl0 ) THEN            ! surface mixing length = F(stress) : l=vkarmn*2.e5*taum/(rau0*g) 
    501442         zraug = vkarmn * 2.e5_wp / ( rau0 * grav ) 
    502          DO jj = 2, jpjm1 
    503             DO ji = fs_2, fs_jpim1 
    504                zmxlm(ji,jj,1) = MAX( rn_mxl0, zraug * taum(ji,jj) * tmask(ji,jj,1) ) 
    505             END DO 
    506          END DO 
     443         DO_2D_00_00 
     444            zmxlm(ji,jj,1) = MAX( rn_mxl0, zraug * taum(ji,jj) * tmask(ji,jj,1) ) 
     445         END_2D 
    507446      ELSE  
    508447         zmxlm(:,:,1) = rn_mxl0 
    509448      ENDIF 
    510449      ! 
    511       DO jk = 2, jpkm1              ! interior value : l=sqrt(2*e/n^2) 
    512          DO jj = 2, jpjm1 
    513             DO ji = fs_2, fs_jpim1   ! vector opt. 
    514                zrn2 = MAX( rn2(ji,jj,jk), rsmall ) 
    515                zmxlm(ji,jj,jk) = MAX(  rmxl_min,  SQRT( 2._wp * en(ji,jj,jk) / zrn2 )  ) 
    516             END DO 
    517          END DO 
    518       END DO 
     450      DO_3D_00_00( 2, jpkm1 ) 
     451         zrn2 = MAX( rn2(ji,jj,jk), rsmall ) 
     452         zmxlm(ji,jj,jk) = MAX(  rmxl_min,  SQRT( 2._wp * en(ji,jj,jk) / zrn2 )  ) 
     453      END_3D 
    519454      ! 
    520455      !                     !* Physical limits for the mixing length 
     
    526461      ! 
    527462 !!gm Not sure of that coding for ISF.... 
    528       ! where wmask = 0 set zmxlm == p_e3w 
     463      ! where wmask = 0 set zmxlm == e3w(:,:,:,Kmm) 
    529464      CASE ( 0 )           ! bounded by the distance to surface and bottom 
    530          DO jk = 2, jpkm1 
    531             DO jj = 2, jpjm1 
    532                DO ji = fs_2, fs_jpim1   ! vector opt. 
    533                   zemxl = MIN( pdepw(ji,jj,jk) - pdepw(ji,jj,mikt(ji,jj)), zmxlm(ji,jj,jk),   & 
    534                   &            pdepw(ji,jj,mbkt(ji,jj)+1) - pdepw(ji,jj,jk) ) 
    535                   ! wmask prevent zmxlm = 0 if jk = mikt(ji,jj) 
    536                   zmxlm(ji,jj,jk) = zemxl * wmask(ji,jj,jk) + MIN( zmxlm(ji,jj,jk) , p_e3w(ji,jj,jk) ) * (1 - wmask(ji,jj,jk)) 
    537                   zmxld(ji,jj,jk) = zemxl * wmask(ji,jj,jk) + MIN( zmxlm(ji,jj,jk) , p_e3w(ji,jj,jk) ) * (1 - wmask(ji,jj,jk)) 
    538                END DO 
    539             END DO 
    540          END DO 
     465         DO_3D_00_00( 2, jpkm1 ) 
     466            zemxl = MIN( gdepw(ji,jj,jk,Kmm) - gdepw(ji,jj,mikt(ji,jj),Kmm), zmxlm(ji,jj,jk),   & 
     467            &            gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) - gdepw(ji,jj,jk,Kmm) ) 
     468            ! wmask prevent zmxlm = 0 if jk = mikt(ji,jj) 
     469            zmxlm(ji,jj,jk) = zemxl * wmask(ji,jj,jk) + MIN( zmxlm(ji,jj,jk) , e3w(ji,jj,jk,Kmm) ) * (1 - wmask(ji,jj,jk)) 
     470            zmxld(ji,jj,jk) = zemxl * wmask(ji,jj,jk) + MIN( zmxlm(ji,jj,jk) , e3w(ji,jj,jk,Kmm) ) * (1 - wmask(ji,jj,jk)) 
     471         END_3D 
    541472         ! 
    542473      CASE ( 1 )           ! bounded by the vertical scale factor 
    543          DO jk = 2, jpkm1 
    544             DO jj = 2, jpjm1 
    545                DO ji = fs_2, fs_jpim1   ! vector opt. 
    546                   zemxl = MIN( p_e3w(ji,jj,jk), zmxlm(ji,jj,jk) ) 
    547                   zmxlm(ji,jj,jk) = zemxl 
    548                   zmxld(ji,jj,jk) = zemxl 
    549                END DO 
    550             END DO 
    551          END DO 
     474         DO_3D_00_00( 2, jpkm1 ) 
     475            zemxl = MIN( e3w(ji,jj,jk,Kmm), zmxlm(ji,jj,jk) ) 
     476            zmxlm(ji,jj,jk) = zemxl 
     477            zmxld(ji,jj,jk) = zemxl 
     478         END_3D 
    552479         ! 
    553480      CASE ( 2 )           ! |dk[xml]| bounded by e3t : 
    554          DO jk = 2, jpkm1         ! from the surface to the bottom : 
    555             DO jj = 2, jpjm1 
    556                DO ji = fs_2, fs_jpim1   ! vector opt. 
    557                   zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk-1) + p_e3t(ji,jj,jk-1), zmxlm(ji,jj,jk) ) 
    558                END DO 
    559             END DO 
    560          END DO 
    561          DO jk = jpkm1, 2, -1     ! from the bottom to the surface : 
    562             DO jj = 2, jpjm1 
    563                DO ji = fs_2, fs_jpim1   ! vector opt. 
    564                   zemxl = MIN( zmxlm(ji,jj,jk+1) + p_e3t(ji,jj,jk+1), zmxlm(ji,jj,jk) ) 
    565                   zmxlm(ji,jj,jk) = zemxl 
    566                   zmxld(ji,jj,jk) = zemxl 
    567                END DO 
    568             END DO 
    569          END DO 
     481         DO_3D_00_00( 2, jpkm1 ) 
     482            zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk-1) + e3t(ji,jj,jk-1,Kmm), zmxlm(ji,jj,jk) ) 
     483         END_3D 
     484         DO_3DS_00_00( jpkm1, 2, -1 ) 
     485            zemxl = MIN( zmxlm(ji,jj,jk+1) + e3t(ji,jj,jk+1,Kmm), zmxlm(ji,jj,jk) ) 
     486            zmxlm(ji,jj,jk) = zemxl 
     487            zmxld(ji,jj,jk) = zemxl 
     488         END_3D 
    570489         ! 
    571490      CASE ( 3 )           ! lup and ldown, |dk[xml]| bounded by e3t : 
    572          DO jk = 2, jpkm1         ! from the surface to the bottom : lup 
    573             DO jj = 2, jpjm1 
    574                DO ji = fs_2, fs_jpim1   ! vector opt. 
    575                   zmxld(ji,jj,jk) = MIN( zmxld(ji,jj,jk-1) + p_e3t(ji,jj,jk-1), zmxlm(ji,jj,jk) ) 
    576                END DO 
    577             END DO 
    578          END DO 
    579          DO jk = jpkm1, 2, -1     ! from the bottom to the surface : ldown 
    580             DO jj = 2, jpjm1 
    581                DO ji = fs_2, fs_jpim1   ! vector opt. 
    582                   zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk+1) + p_e3t(ji,jj,jk+1), zmxlm(ji,jj,jk) ) 
    583                END DO 
    584             END DO 
    585          END DO 
    586          DO jk = 2, jpkm1 
    587             DO jj = 2, jpjm1 
    588                DO ji = fs_2, fs_jpim1   ! vector opt. 
    589                   zemlm = MIN ( zmxld(ji,jj,jk),  zmxlm(ji,jj,jk) ) 
    590                   zemlp = SQRT( zmxld(ji,jj,jk) * zmxlm(ji,jj,jk) ) 
    591                   zmxlm(ji,jj,jk) = zemlm 
    592                   zmxld(ji,jj,jk) = zemlp 
    593                END DO 
    594             END DO 
    595          END DO 
     491         DO_3D_00_00( 2, jpkm1 ) 
     492            zmxld(ji,jj,jk) = MIN( zmxld(ji,jj,jk-1) + e3t(ji,jj,jk-1,Kmm), zmxlm(ji,jj,jk) ) 
     493         END_3D 
     494         DO_3DS_00_00( jpkm1, 2, -1 ) 
     495            zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk+1) + e3t(ji,jj,jk+1,Kmm), zmxlm(ji,jj,jk) ) 
     496         END_3D 
     497         DO_3D_00_00( 2, jpkm1 ) 
     498            zemlm = MIN ( zmxld(ji,jj,jk),  zmxlm(ji,jj,jk) ) 
     499            zemlp = SQRT( zmxld(ji,jj,jk) * zmxlm(ji,jj,jk) ) 
     500            zmxlm(ji,jj,jk) = zemlm 
     501            zmxld(ji,jj,jk) = zemlp 
     502         END_3D 
    596503         ! 
    597504      END SELECT 
     
    600507      !                     !  Vertical eddy viscosity and diffusivity  (avm and avt) 
    601508      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    602       DO jk = 1, jpkm1            !* vertical eddy viscosity & diffivity at w-points 
    603          DO jj = 2, jpjm1 
    604             DO ji = fs_2, fs_jpim1   ! vector opt. 
    605                zsqen = SQRT( en(ji,jj,jk) ) 
    606                zav   = rn_ediff * zmxlm(ji,jj,jk) * zsqen 
    607                p_avm(ji,jj,jk) = MAX( zav,                  avmb(jk) ) * wmask(ji,jj,jk) 
    608                p_avt(ji,jj,jk) = MAX( zav, avtb_2d(ji,jj) * avtb(jk) ) * wmask(ji,jj,jk) 
    609                dissl(ji,jj,jk) = zsqen / zmxld(ji,jj,jk) 
    610             END DO 
    611          END DO 
    612       END DO 
     509      DO_3D_00_00( 1, jpkm1 ) 
     510         zsqen = SQRT( en(ji,jj,jk) ) 
     511         zav   = rn_ediff * zmxlm(ji,jj,jk) * zsqen 
     512         p_avm(ji,jj,jk) = MAX( zav,                  avmb(jk) ) * wmask(ji,jj,jk) 
     513         p_avt(ji,jj,jk) = MAX( zav, avtb_2d(ji,jj) * avtb(jk) ) * wmask(ji,jj,jk) 
     514         dissl(ji,jj,jk) = zsqen / zmxld(ji,jj,jk) 
     515      END_3D 
    613516      ! 
    614517      ! 
    615518      IF( nn_pdl == 1 ) THEN      !* Prandtl number case: update avt 
    616          DO jk = 2, jpkm1 
    617             DO jj = 2, jpjm1 
    618                DO ji = fs_2, fs_jpim1   ! vector opt. 
    619                   p_avt(ji,jj,jk)   = MAX( apdlr(ji,jj,jk) * p_avt(ji,jj,jk), avtb_2d(ji,jj) * avtb(jk) ) * tmask(ji,jj,jk) 
    620               END DO 
    621             END DO 
    622          END DO 
    623       ENDIF 
    624       ! 
    625       IF(ln_ctl) THEN 
     519         DO_3D_00_00( 2, jpkm1 ) 
     520            p_avt(ji,jj,jk)   = MAX( apdlr(ji,jj,jk) * p_avt(ji,jj,jk), avtb_2d(ji,jj) * avtb(jk) ) * tmask(ji,jj,jk) 
     521         END_3D 
     522      ENDIF 
     523      ! 
     524      IF(sn_cfctl%l_prtctl) THEN 
    626525         CALL prt_ctl( tab3d_1=en   , clinfo1=' tke  - e: ', tab3d_2=p_avt, clinfo2=' t: ', kdim=jpk) 
    627526         CALL prt_ctl( tab3d_1=p_avm, clinfo1=' tke  - m: ', kdim=jpk ) 
     
    631530 
    632531 
    633    SUBROUTINE zdf_tke_init 
     532   SUBROUTINE zdf_tke_init( Kmm ) 
    634533      !!---------------------------------------------------------------------- 
    635534      !!                  ***  ROUTINE zdf_tke_init  *** 
     
    647546      USE zdf_oce , ONLY : ln_zdfiwm   ! Internal Wave Mixing flag 
    648547      !! 
    649       INTEGER ::   ji, jj, jk   ! dummy loop indices 
    650       INTEGER ::   ios 
     548      INTEGER, INTENT(in) ::   Kmm          ! time level index 
     549      INTEGER             ::   ji, jj, jk   ! dummy loop indices 
     550      INTEGER             ::   ios 
    651551      !! 
    652552      NAMELIST/namzdf_tke/ rn_ediff, rn_ediss , rn_ebb , rn_emin  ,          & 
     
    656556      !!---------------------------------------------------------------------- 
    657557      ! 
    658       REWIND( numnam_ref )              ! Namelist namzdf_tke in reference namelist : Turbulent Kinetic Energy 
    659558      READ  ( numnam_ref, namzdf_tke, IOSTAT = ios, ERR = 901) 
    660559901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_tke in reference namelist' ) 
    661560 
    662       REWIND( numnam_cfg )              ! Namelist namzdf_tke in configuration namelist : Turbulent Kinetic Energy 
    663561      READ  ( numnam_cfg, namzdf_tke, IOSTAT = ios, ERR = 902 ) 
    664562902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namzdf_tke in configuration namelist' ) 
     
    725623      ENDIF 
    726624       
    727       IF( nn_etau == 2  )   CALL zdf_mxl( nit000 )      ! Initialization of nmln  
     625      IF( nn_etau == 2  )   CALL zdf_mxl( nit000, Kmm )      ! Initialization of nmln  
    728626 
    729627      !                               !* depth of penetration of surface tke 
Note: See TracChangeset for help on using the changeset viewer.