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 12377 for NEMO/trunk/src/OCE/ZDF/zdfiwm.F90 – NEMO

Ignore:
Timestamp:
2020-02-12T15:39:06+01:00 (4 years 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:
2 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/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' ) 
Note: See TracChangeset for help on using the changeset viewer.