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

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 15548 for NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/OCE/ZDF/zdfiwm.F90 – NEMO

Ignore:
Timestamp:
2021-11-28T18:59:49+01:00 (3 years ago)
Author:
gsamson
Message:

update branch to the head of the trunk (r15547); ticket #2632

Location:
NEMO/branches/2021/ticket2632_r14588_theta_sbcblk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2021/ticket2632_r14588_theta_sbcblk

    • Property svn:externals
      •  

        old new  
        99 
        1010# SETTE 
        11 ^/utils/CI/sette@14244        sette 
         11^/utils/CI/sette@HEAD        sette 
         12 
  • NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/OCE/ZDF/zdfiwm.F90

    r13497 r15548  
    125125      ! 
    126126      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    127       REAL(wp) ::   zztmp, ztmp1, ztmp2        ! scalar workspace 
    128       REAL(wp), DIMENSION(jpi,jpj)     ::   zfact       ! Used for vertical structure 
    129       REAL(wp), DIMENSION(jpi,jpj)     ::   zhdep       ! Ocean depth 
    130       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwkb        ! WKB-stretched height above bottom 
    131       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zweight     ! Weight for high mode vertical distribution 
    132       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   znu_t       ! Molecular kinematic viscosity (T grid) 
    133       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   znu_w       ! Molecular kinematic viscosity (W grid) 
    134       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zReb        ! Turbulence intensity parameter 
    135       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zemx_iwm    ! local energy density available for mixing (W/kg) 
    136       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zav_ratio   ! S/T diffusivity ratio (only for ln_tsdiff=T) 
    137       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zav_wave    ! Internal wave-induced diffusivity 
     127      REAL(wp), SAVE :: zztmp 
     128      REAL(wp)       :: ztmp1, ztmp2        ! scalar workspace 
     129      REAL(wp), DIMENSION(A2D(nn_hls))     ::   zfact       ! Used for vertical structure 
     130      REAL(wp), DIMENSION(A2D(nn_hls))     ::   zhdep       ! Ocean depth 
     131      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zwkb        ! WKB-stretched height above bottom 
     132      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zweight     ! Weight for high mode vertical distribution 
     133      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   znu_t       ! Molecular kinematic viscosity (T grid) 
     134      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   znu_w       ! Molecular kinematic viscosity (W grid) 
     135      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zReb        ! Turbulence intensity parameter 
     136      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zemx_iwm    ! local energy density available for mixing (W/kg) 
     137      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zav_ratio   ! S/T diffusivity ratio (only for ln_tsdiff=T) 
     138      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zav_wave    ! Internal wave-induced diffusivity 
    138139      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   z3d  ! 3D workspace used for iom_put  
    139140      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   z2d  ! 2D     -      -    -     - 
     
    143144      ! Set to zero the 1st and last vertical levels of appropriate variables 
    144145      IF( iom_use("emix_iwm") ) THEN 
    145          DO_2D( 0, 0, 0, 0 ) 
    146             zemx_iwm (ji,jj,1) = 0._wp   ;   zemx_iwm (ji,jj,jpk) = 0._wp 
    147          END_2D 
     146         zemx_iwm(:,:,:) = 0._wp 
    148147      ENDIF 
    149148      IF( iom_use("av_ratio") ) THEN 
    150          DO_2D( 0, 0, 0, 0 ) 
    151             zav_ratio(ji,jj,1) = 0._wp   ;   zav_ratio(ji,jj,jpk) = 0._wp 
    152          END_2D 
     149         zav_ratio(:,:,:) = 0._wp 
    153150      ENDIF 
    154151      IF( iom_use("av_wave") .OR. sn_cfctl%l_prtctl ) THEN 
    155          DO_2D( 0, 0, 0, 0 ) 
    156             zav_wave (ji,jj,1) = 0._wp   ;   zav_wave (ji,jj,jpk) = 0._wp 
    157          END_2D 
     152         zav_wave(:,:,:) = 0._wp 
    158153      ENDIF 
    159154      ! 
     
    164159      !                       !* Critical slope mixing: distribute energy over the time-varying ocean depth, 
    165160      !                                                 using an exponential decay from the seafloor. 
    166       DO_2D( 0, 0, 0, 0 )             ! part independent of the level 
     161      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )             ! part independent of the level 
    167162         zhdep(ji,jj) = gdepw_0(ji,jj,mbkt(ji,jj)+1)       ! depth of the ocean 
    168163         zfact(ji,jj) = rho0 * (  1._wp - EXP( -zhdep(ji,jj) / hcri_iwm(ji,jj) )  ) 
     
    170165      END_2D 
    171166!!gm gde3w ==>>>  check for ssh taken into account.... seem OK gde3w_n=gdept(:,:,:,Kmm) - ssh(:,:,Kmm) 
    172       DO_3D( 0, 0, 0, 0, 2, jpkm1 )   ! complete with the level-dependent part 
     167      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )   ! complete with the level-dependent part 
    173168         IF ( zfact(ji,jj) == 0._wp .OR. wmask(ji,jj,jk) == 0._wp ) THEN   ! optimization 
    174169            zemx_iwm(ji,jj,jk) = 0._wp 
     
    190185      CASE ( 1 )               ! Dissipation scales as N (recommended) 
    191186         ! 
    192          DO_2D( 0, 0, 0, 0 ) 
     187         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    193188            zfact(ji,jj) = 0._wp 
    194189         END_2D 
    195          DO_3D( 0, 0, 0, 0, 2, jpkm1 )       ! part independent of the level 
     190         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )       ! part independent of the level 
    196191            zfact(ji,jj) = zfact(ji,jj) + e3w(ji,jj,jk,Kmm) * SQRT(  MAX( 0._wp, rn2(ji,jj,jk) )  ) * wmask(ji,jj,jk) 
    197192         END_3D 
    198193         ! 
    199          DO_2D( 0, 0, 0, 0 ) 
     194         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    200195            IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = epyc_iwm(ji,jj) / ( rho0 * zfact(ji,jj) ) 
    201196         END_2D 
    202197         ! 
    203          DO_3D( 0, 0, 0, 0, 2, jpkm1 )       ! complete with the level-dependent part 
     198         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )       ! complete with the level-dependent part 
    204199            zemx_iwm(ji,jj,jk) = zemx_iwm(ji,jj,jk) + zfact(ji,jj) * SQRT(  MAX( 0._wp, rn2(ji,jj,jk) )  ) * wmask(ji,jj,jk) 
    205200         END_3D 
     
    207202      CASE ( 2 )               ! Dissipation scales as N^2 
    208203         ! 
    209          DO_2D( 0, 0, 0, 0 ) 
     204         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    210205            zfact(ji,jj) = 0._wp 
    211206         END_2D 
    212          DO_3D( 0, 0, 0, 0, 2, jpkm1 )       ! part independent of the level 
     207         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )       ! part independent of the level 
    213208            zfact(ji,jj) = zfact(ji,jj) + e3w(ji,jj,jk,Kmm) * MAX( 0._wp, rn2(ji,jj,jk) ) * wmask(ji,jj,jk) 
    214209         END_3D 
    215210         ! 
    216          DO_2D( 0, 0, 0, 0 ) 
     211         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    217212            IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = epyc_iwm(ji,jj) / ( rho0 * zfact(ji,jj) ) 
    218213         END_2D 
    219214         ! 
    220          DO_3D( 0, 0, 0, 0, 2, jpkm1 )       ! complete with the level-dependent part 
     215         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    221216            zemx_iwm(ji,jj,jk) = zemx_iwm(ji,jj,jk) + zfact(ji,jj) * MAX( 0._wp, rn2(ji,jj,jk) ) * wmask(ji,jj,jk) 
    222217         END_3D 
     
    227222      !                        !* ocean depth as proportional to rn2 * exp(-z_wkb/rn_hbot) 
    228223      ! 
    229       DO_2D( 0, 0, 0, 0 ) 
     224      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    230225         zwkb(ji,jj,1) = 0._wp 
    231226      END_2D 
    232       DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     227      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    233228         zwkb(ji,jj,jk) = zwkb(ji,jj,jk-1) + e3w(ji,jj,jk,Kmm) * SQRT(  MAX( 0._wp, rn2(ji,jj,jk) )  ) * wmask(ji,jj,jk) 
    234229      END_3D 
    235       DO_2D( 0, 0, 0, 0 ) 
     230      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    236231         zfact(ji,jj) = zwkb(ji,jj,jpkm1) 
    237232      END_2D 
    238233      ! 
    239       DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     234      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    240235         IF( zfact(ji,jj) /= 0 )   zwkb(ji,jj,jk) = zhdep(ji,jj) * ( zfact(ji,jj) - zwkb(ji,jj,jk) )   & 
    241236            &                                     * wmask(ji,jj,jk) / zfact(ji,jj) 
    242237      END_3D 
    243       DO_2D( 0, 0, 0, 0 ) 
     238      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    244239         zwkb (ji,jj,1) = zhdep(ji,jj) * wmask(ji,jj,1) 
    245240      END_2D 
    246241      ! 
    247       DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     242      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    248243         IF ( rn2(ji,jj,jk) <= 0._wp .OR. wmask(ji,jj,jk) == 0._wp ) THEN   ! optimization: EXP coast a lot 
    249244            zweight(ji,jj,jk) = 0._wp 
     
    254249      END_3D 
    255250      ! 
    256       DO_2D( 0, 0, 0, 0 ) 
     251      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    257252         zfact(ji,jj) = 0._wp 
    258253      END_2D 
    259       DO_3D( 0, 0, 0, 0, 2, jpkm1 )       ! part independent of the level 
     254      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )       ! part independent of the level 
    260255         zfact(ji,jj) = zfact(ji,jj) + zweight(ji,jj,jk) 
    261256      END_3D 
    262257      ! 
    263       DO_2D( 0, 0, 0, 0 ) 
     258      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    264259         IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = ebot_iwm(ji,jj) / ( rho0 * zfact(ji,jj) ) 
    265260      END_2D 
    266261      ! 
    267       DO_3D( 0, 0, 0, 0, 2, jpkm1 )       ! complete with the level-dependent part 
     262      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )       ! complete with the level-dependent part 
    268263         zemx_iwm(ji,jj,jk) = zemx_iwm(ji,jj,jk) + zweight(ji,jj,jk) * zfact(ji,jj) * wmask(ji,jj,jk)   & 
    269264            &                                                        / ( gde3w(ji,jj,jk) - gde3w(ji,jj,jk-1) ) 
     
    273268!!gm  this is to be replaced by just a constant value znu=1.e-6 m2/s 
    274269      ! Calculate molecular kinematic viscosity 
    275       DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     270      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
    276271         znu_t(ji,jj,jk) = 1.e-4_wp * (  17.91_wp - 0.53810_wp * ts(ji,jj,jk,jp_tem,Kmm)   & 
    277272            &                                     + 0.00694_wp * ts(ji,jj,jk,jp_tem,Kmm) * ts(ji,jj,jk,jp_tem,Kmm)  & 
    278273            &                                     + 0.02305_wp * ts(ji,jj,jk,jp_sal,Kmm)  ) * tmask(ji,jj,jk) * r1_rho0 
    279274      END_3D 
    280       DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     275      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    281276         znu_w(ji,jj,jk) = 0.5_wp * ( znu_t(ji,jj,jk-1) + znu_t(ji,jj,jk) ) * wmask(ji,jj,jk) 
    282277      END_3D 
     
    284279      ! 
    285280      ! Calculate turbulence intensity parameter Reb 
    286       DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     281      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    287282         zReb(ji,jj,jk) = zemx_iwm(ji,jj,jk) / MAX( 1.e-20_wp, znu_w(ji,jj,jk) * rn2(ji,jj,jk) ) 
    288283      END_3D 
    289284      ! 
    290285      ! Define internal wave-induced diffusivity 
    291       DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     286      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    292287         zav_wave(ji,jj,jk) = znu_w(ji,jj,jk) * zReb(ji,jj,jk) * r1_6   ! This corresponds to a constant mixing efficiency of 1/6 
    293288      END_3D 
    294289      ! 
    295290      IF( ln_mevar ) THEN                ! Variable mixing efficiency case : modify zav_wave in the 
    296          DO_3D( 0, 0, 0, 0, 2, jpkm1 )   ! energetic (Reb > 480) and buoyancy-controlled (Reb <10.224 ) regimes 
     291         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )   ! energetic (Reb > 480) and buoyancy-controlled (Reb <10.224 ) regimes 
    297292            IF( zReb(ji,jj,jk) > 480.00_wp ) THEN 
    298293               zav_wave(ji,jj,jk) = 3.6515_wp * znu_w(ji,jj,jk) * SQRT( zReb(ji,jj,jk) ) 
     
    303298      ENDIF 
    304299      ! 
    305       DO_3D( 0, 0, 0, 0, 2, jpkm1 )      ! Bound diffusivity by molecular value and 100 cm2/s 
     300      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )      ! Bound diffusivity by molecular value and 100 cm2/s 
    306301         zav_wave(ji,jj,jk) = MIN(  MAX( 1.4e-7_wp, zav_wave(ji,jj,jk) ), 1.e-2_wp  ) * wmask(ji,jj,jk) 
    307302      END_3D 
    308303      ! 
    309304      IF( kt == nit000 ) THEN        !* Control print at first time-step: diagnose the energy consumed by zav_wave 
    310          zztmp = 0._wp 
     305         IF( .NOT. l_istiled .OR. ntile == 1 ) zztmp = 0._wp                    ! Do only on the first tile 
    311306!!gm used of glosum 3D.... 
    312307         DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     
    314309               &          * MAX( 0._wp, rn2(ji,jj,jk) ) * zav_wave(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj) 
    315310         END_3D 
    316          CALL mpp_sum( 'zdfiwm', zztmp ) 
    317          zztmp = rho0 * zztmp ! Global integral of rauo * Kz * N^2 = power contributing to mixing  
    318          ! 
    319          IF(lwp) THEN 
    320             WRITE(numout,*) 
    321             WRITE(numout,*) 'zdf_iwm : Internal wave-driven mixing (iwm)' 
    322             WRITE(numout,*) '~~~~~~~ ' 
    323             WRITE(numout,*) 
    324             WRITE(numout,*) '      Total power consumption by av_wave =  ', zztmp * 1.e-12_wp, 'TW' 
     311 
     312         IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN                       ! Do only on the last tile 
     313            CALL mpp_sum( 'zdfiwm', zztmp ) 
     314            zztmp = rho0 * zztmp ! Global integral of rauo * Kz * N^2 = power contributing to mixing 
     315            ! 
     316            IF(lwp) THEN 
     317               WRITE(numout,*) 
     318               WRITE(numout,*) 'zdf_iwm : Internal wave-driven mixing (iwm)' 
     319               WRITE(numout,*) '~~~~~~~ ' 
     320               WRITE(numout,*) 
     321               WRITE(numout,*) '      Total power consumption by av_wave =  ', zztmp * 1.e-12_wp, 'TW' 
     322            ENDIF 
    325323         ENDIF 
    326324      ENDIF 
     
    332330      IF( ln_tsdiff ) THEN                !* Option for differential mixing of salinity and temperature 
    333331         ztmp1 = 0.505_wp + 0.495_wp * TANH( 0.92_wp * ( LOG10( 1.e-20_wp ) - 0.60_wp ) ) 
    334          DO_3D( 0, 0, 0, 0, 2, jpkm1 )       ! Calculate S/T diffusivity ratio as a function of Reb 
     332         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )       ! Calculate S/T diffusivity ratio as a function of Reb 
    335333            ztmp2 = zReb(ji,jj,jk) * 5._wp * r1_6 
    336334            IF ( ztmp2 > 1.e-20_wp .AND. wmask(ji,jj,jk) == 1._wp ) THEN 
     
    341339         END_3D 
    342340         CALL iom_put( "av_ratio", zav_ratio ) 
    343          DO_3D( 0, 0, 0, 0, 2, jpkm1 )    !* update momentum & tracer diffusivity with wave-driven mixing 
     341         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )    !* update momentum & tracer diffusivity with wave-driven mixing 
    344342            p_avs(ji,jj,jk) = p_avs(ji,jj,jk) + zav_wave(ji,jj,jk) * zav_ratio(ji,jj,jk) 
    345343            p_avt(ji,jj,jk) = p_avt(ji,jj,jk) + zav_wave(ji,jj,jk) 
     
    348346         ! 
    349347      ELSE                                !* update momentum & tracer diffusivity with wave-driven mixing 
    350          DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     348         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    351349            p_avs(ji,jj,jk) = p_avs(ji,jj,jk) + zav_wave(ji,jj,jk) 
    352350            p_avt(ji,jj,jk) = p_avt(ji,jj,jk) + zav_wave(ji,jj,jk) 
     
    361359                                          !  vertical integral of rho0 * Kz * N^2 , energy density (zemx_iwm) 
    362360      IF( iom_use("bflx_iwm") .OR. iom_use("pcmap_iwm") ) THEN 
    363          ALLOCATE( z2d(jpi,jpj) , z3d(jpi,jpj,jpk) ) 
     361         ALLOCATE( z2d(A2D(nn_hls)) , z3d(A2D(nn_hls),jpk) ) 
    364362         ! Initialisation for iom_put 
    365          DO_2D( 0, 0, 0, 0 ) 
    366             z3d(ji,jj,1) = 0._wp   ;   z3d(ji,jj,jpk) = 0._wp 
    367          END_2D 
    368          z3d(           1:nn_hls,:,:) = 0._wp   ;   z3d(:,           1:nn_hls,:) = 0._wp 
    369          z3d(jpi-nn_hls+1:jpi   ,:,:) = 0._wp   ;   z3d(:,jpj-nn_hls+1:   jpj,:) = 0._wp 
    370          z2d(           1:nn_hls,:  ) = 0._wp   ;   z2d(:,           1:nn_hls  ) = 0._wp 
    371          z2d(jpi-nn_hls+1:jpi   ,:  ) = 0._wp   ;   z2d(:,jpj-nn_hls+1:   jpj  ) = 0._wp 
     363         z2d(:,:) = 0._wp ; z3d(:,:,:) = 0._wp 
    372364 
    373365         DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    374366            z3d(ji,jj,jk) = MAX( 0._wp, rn2(ji,jj,jk) ) * zav_wave(ji,jj,jk) 
    375          END_3D 
    376          DO_2D( 0, 0, 0, 0 ) 
    377             z2d(ji,jj) = 0._wp 
    378          END_2D 
    379          DO_3D( 0, 0, 0, 0, 2, jpkm1 )  
    380367            z2d(ji,jj) = z2d(ji,jj) + e3w(ji,jj,jk,Kmm) * z3d(ji,jj,jk) * wmask(ji,jj,jk) 
    381368         END_3D 
Note: See TracChangeset for help on using the changeset viewer.