Changeset 13295 for NEMO/trunk/src/OCE/ZDF/zdfosm.F90

Timestamp:

2020-07-10T20:24:21+02:00 (4 years ago)

Author:

acc

Message:

Replace do-loop macros in the trunk with alternative forms with greater flexibility for extra halo applications. This alters a lot of routines but does not change any behaviour or results. do_loop_substitute.h90 is greatly simplified by this change. SETTE results are identical to those with the previous revision

File:

• NEMO/trunk/src/OCE/ZDF/zdfosm.F90 (modified) (40 diffs)

NEMO/trunk/src/OCE/ZDF/zdfosm.F90

@@ -300 +300 @@
      zz0 =       rn_abs       ! surface equi-partition in 2-bands
      zz1 =  1. - rn_abs
-     DO_2D_00_00
+     DO_2D( 0, 0, 0, 0 )
         ! Surface downward irradiance (so always +ve)
         zrad0(ji,jj) = qsr(ji,jj) * r1_rho0_rcp
@@ -310 +310 @@
      END_2D
      ! Turbulent surface fluxes and fluxes averaged over depth of the OSBL
-     DO_2D_00_00
+     DO_2D( 0, 0, 0, 0 )
         zthermal = rab_n(ji,jj,1,jp_tem)
         zbeta    = rab_n(ji,jj,1,jp_sal)
@@ -337 +337 @@
      ! Assume constant La#=0.3
      CASE(0)
-        DO_2D_00_00
+        DO_2D( 0, 0, 0, 0 )
            zus_x = zcos_wind(ji,jj) * zustar(ji,jj) / 0.3**2
            zus_y = zsin_wind(ji,jj) * zustar(ji,jj) / 0.3**2
@@ -345 +345 @@
      ! Assume Pierson-Moskovitz wind-wave spectrum
      CASE(1)
-        DO_2D_00_00
+        DO_2D( 0, 0, 0, 0 )
            ! Use wind speed wndm included in sbc_oce module
            zustke(ji,jj) = MAX ( 0.016 * wndm(ji,jj), 1.0e-8 )
@@ -353 +353 @@
      CASE(2)
         zfac =  2.0_wp * rpi / 16.0_wp
-        DO_2D_00_00
+        DO_2D( 0, 0, 0, 0 )
            ! The Langmur number from the ECMWF model appears to give La<0.3 for wind-driven seas.
            !    The coefficient 0.8 gives La=0.3  in this situation.
@@ -366 +366 @@
      ! Langmuir velocity scale (zwstrl), La # (zla)
      ! mixed scale (zvstr), convective velocity scale (zwstrc)
-     DO_2D_00_00
+     DO_2D( 0, 0, 0, 0 )
         ! Langmuir velocity scale (zwstrl), at T-point
         zwstrl(ji,jj) = ( zustar(ji,jj) * zustar(ji,jj) * zustke(ji,jj) )**pthird
@@ -402 +402 @@
       hbl(:,:) = MAX(hbl(:,:), gdepw(:,:,3,Kmm) )
       ibld(:,:) = 3
-      DO_3D_00_00( 4, jpkm1 )
+      DO_3D( 0, 0, 0, 0, 4, jpkm1 )
          IF ( hbl(ji,jj) >= gdepw(ji,jj,jk,Kmm) ) THEN
             ibld(ji,jj) = MIN(mbkt(ji,jj), jk)
@@ -408 +408 @@
       END_3D
 
-      DO_2D_00_00
+      DO_2D( 0, 0, 0, 0 )
             zthermal = rab_n(ji,jj,1,jp_tem) !ideally use ibld not 1??
             zbeta    = rab_n(ji,jj,1,jp_sal)
@@ -478 +478 @@
       zdhdt(:,:) = MIN(zdhdt(:,:), (zhbl_t(:,:) - hbl(:,:))/rn_Dt + ww(ji,jj,ibld(ji,jj))) ! adjustment to represent limiting by ocean bottom
 
-      DO_3D_00_00( 4, jpkm1 )
+      DO_3D( 0, 0, 0, 0, 4, jpkm1 )
          IF ( zhbl_t(ji,jj) >= gdepw(ji,jj,jk,Kmm) ) THEN
             ibld(ji,jj) =  MIN(mbkt(ji,jj), jk)
@@ -487 +487 @@
 ! Step through model levels taking account of buoyancy change to determine the effect on dhdt
 !
-      DO_2D_00_00
+      DO_2D( 0, 0, 0, 0 )
          IF ( ibld(ji,jj) - imld(ji,jj) > 1 ) THEN
 !
@@ -552 +552 @@
      ! Consider later  combining this into the loop above and looking for columns
      ! where the index for base of the boundary layer have changed
-      DO_2D_00_00
+      DO_2D( 0, 0, 0, 0 )
             zthermal = rab_n(ji,jj,1,jp_tem) !ideally use ibld not 1??
             zbeta    = rab_n(ji,jj,1,jp_sal)
@@ -635 +635 @@
       ! Average over the depth of the mixed layer in the convective boundary layer
       ! Also calculate entrainment fluxes for temperature and salinity
-      DO_2D_00_00
+      DO_2D( 0, 0, 0, 0 )
          zthermal = rab_n(ji,jj,1,jp_tem) !ideally use ibld not 1??
          zbeta    = rab_n(ji,jj,1,jp_sal)
@@ -705 +705 @@
     !
 
-      DO_2D_00_00
+      DO_2D( 0, 0, 0, 0 )
          ztemp = zu_ml(ji,jj)
          zu_ml(ji,jj) = zu_ml(ji,jj) * zcos_wind(ji,jj) + zv_ml(ji,jj) * zsin_wind(ji,jj)
@@ -723 +723 @@
      zuw_bse = 0._wp
      zvw_bse = 0._wp
-     DO_2D_00_00
+     DO_2D( 0, 0, 0, 0 )
 
         IF ( lconv(ji,jj) ) THEN
@@ -740 +740 @@
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 
-       DO_2D_00_00
+       DO_2D( 0, 0, 0, 0 )
        !
           IF ( lconv (ji,jj) ) THEN
@@ -788 +788 @@
        END_2D
 !
-       DO_2D_00_00
+       DO_2D( 0, 0, 0, 0 )
        !
           IF ( lconv (ji,jj) ) THEN
@@ -832 +832 @@
       !     zvisml_sc = zwstrl * zhbl * EXP ( -( zhol / 0.183_wp )**2 )
       !  ENDWHERE
-       DO_2D_00_00
+       DO_2D( 0, 0, 0, 0 )
           IF ( lconv(ji,jj) ) THEN
             zdifml_sc(ji,jj) = zhml(ji,jj) * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird
@@ -846 +846 @@
        END_2D
 !
-       DO_2D_00_00
+       DO_2D( 0, 0, 0, 0 )
           IF ( lconv(ji,jj) ) THEN
              DO jk = 2, imld(ji,jj)   ! mixed layer diffusivity
@@ -896 +896 @@
 
 
-       DO_2D_00_00
+       DO_2D( 0, 0, 0, 0 )
          IF ( lconv(ji,jj) ) THEN
            DO jk = 2, imld(ji,jj)
@@ -929 +929 @@
        ENDWHERE
 
-       DO_2D_00_00
+       DO_2D( 0, 0, 0, 0 )
           IF ( lconv(ji,jj) ) THEN
              DO jk = 2, imld(ji,jj)
@@ -961 +961 @@
        ENDWHERE
 
-       DO_2D_00_00
+       DO_2D( 0, 0, 0, 0 )
           IF (lconv(ji,jj) ) THEN
              DO jk = 2, imld(ji,jj)
@@ -993 +993 @@
        ENDWHERE
 
-       DO_2D_00_00
+       DO_2D( 0, 0, 0, 0 )
           IF ( lconv(ji,jj) ) THEN
              DO jk = 2 , imld(ji,jj)
@@ -1021 +1021 @@
        ENDWHERE
 
-       DO_2D_00_00
+       DO_2D( 0, 0, 0, 0 )
          IF ( lconv(ji,jj) ) THEN
             DO jk = 2, imld(ji,jj)
@@ -1058 +1058 @@
        ENDWHERE
 
-       DO_2D_00_00
+       DO_2D( 0, 0, 0, 0 )
           IF ( lconv(ji,jj) ) THEN
             DO jk = 2, imld(ji,jj)
@@ -1093 +1093 @@
 ! Make surface forced velocity non-gradient terms go to zero at the base of the mixed layer.
 
-      DO_2D_00_00
+      DO_2D( 0, 0, 0, 0 )
          IF ( lconv(ji,jj) ) THEN
             DO jk = 2, ibld(ji,jj)
@@ -1122 +1122 @@
        ! Temporary fix to avoid instabilities when zdb_bl becomes very very small
        zsc_uw_1 = 0._wp ! 50.0 * zla**(8.0/3.0) * zustar**2 * zhbl / ( zdb_bl + epsln )
-       DO_2D_00_00
+       DO_2D( 0, 0, 0, 0 )
           DO jk= 2, ibld(ji,jj)
              znd = gdepw(ji,jj,jk,Kmm) / zhbl(ji,jj)
@@ -1135 +1135 @@
 ! Entrainment contribution.
 
-       DO_2D_00_00
+       DO_2D( 0, 0, 0, 0 )
           IF ( lconv(ji,jj) ) THEN
             DO jk = 1, imld(ji,jj) - 1
@@ -1170 +1170 @@
        ! rotate non-gradient velocity terms back to model reference frame
 
-       DO_2D_00_00
+       DO_2D( 0, 0, 0, 0 )
           DO jk = 2, ibld(ji,jj)
              ztemp = ghamu(ji,jj,jk)
@@ -1184 +1184 @@
 ! KPP-style Ri# mixing
        IF( ln_kpprimix) THEN
-          DO_3D_10_10( 2, jpkm1 )
+          DO_3D( 1, 0, 1, 0, 2, jpkm1 )
              z3du(ji,jj,jk) = 0.5 * (  uu(ji,jj,jk-1,Kmm) -  uu(ji  ,jj,jk,Kmm) )   &
                   &                 * (  uu(ji,jj,jk-1,Kbb) -  uu(ji  ,jj,jk,Kbb) ) * wumask(ji,jj,jk) &
@@ -1193 +1193 @@
           END_3D
       !
-         DO_3D_00_00( 2, jpkm1 )
+         DO_3D( 0, 0, 0, 0, 2, jpkm1 )
             !                                          ! shear prod. at w-point weightened by mask
             zesh2  =  ( z3du(ji-1,jj,jk) + z3du(ji,jj,jk) ) / MAX( 1._wp , umask(ji-1,jj,jk) + umask(ji,jj,jk) )   &
@@ -1204 +1204 @@
          END_3D
 
-          DO_2D_00_00
+          DO_2D( 0, 0, 0, 0 )
              DO jk = ibld(ji,jj) + 1, jpkm1
                 zdiffut(ji,jj,jk) = zrimix(ji,jj,jk)*rn_difri
@@ -1215 +1215 @@
 ! KPP-style set diffusivity large if unstable below BL
        IF( ln_convmix) THEN
-          DO_2D_00_00
+          DO_2D( 0, 0, 0, 0 )
              DO jk = ibld(ji,jj) + 1, jpkm1
                IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) zdiffut(ji,jj,jk) = rn_difconv
@@ -1227 +1227 @@
        ! GN 25/8: need to change tmask --> wmask
 
-     DO_3D_00_00( 2, jpkm1 )
+     DO_3D( 0, 0, 0, 0, 2, jpkm1 )
           p_avt(ji,jj,jk) = MAX( zdiffut(ji,jj,jk), avtb(jk) ) * tmask(ji,jj,jk)
           p_avm(ji,jj,jk) = MAX( zviscos(ji,jj,jk), avmb(jk) ) * tmask(ji,jj,jk)
@@ -1234 +1234 @@
      CALL lbc_lnk_multi( 'zdfosm', p_avt, 'W', 1.0_wp , p_avm, 'W', 1.0_wp,   &
       &                  ghamu, 'W', 1.0_wp , ghamv, 'W', 1.0_wp )
-       DO_3D_00_00( 2, jpkm1 )
+       DO_3D( 0, 0, 0, 0, 2, jpkm1 )
             ghamu(ji,jj,jk) = ( ghamu(ji,jj,jk) + ghamu(ji+1,jj,jk) ) &
                &  / MAX( 1., tmask(ji,jj,jk) + tmask (ji + 1,jj,jk) ) * umask(ji,jj,jk)
@@ -1395 +1395 @@
         etmean(:,:,:) = 0.e0
 
-        DO_3D_00_00( 1, jpkm1 )
+        DO_3D( 0, 0, 0, 0, 1, jpkm1 )
            etmean(ji,jj,jk) = tmask(ji,jj,jk)                     &
                 &  / MAX( 1.,  umask(ji-1,jj  ,jk) + umask(ji,jj,jk)   &
@@ -1409 +1409 @@
         etmean(:,:,:) = 0.e0
 
-        DO_3D_00_00( 1, jpkm1 )
+        DO_3D( 0, 0, 0, 0, 1, jpkm1 )
            etmean(ji,jj,jk) = tmask(ji, jj,jk)                           &
                 & / MAX( 1., 2.* tmask(ji,jj,jk)                           &
@@ -1516 +1516 @@
      !
      hbl(:,:)  = 0._wp              ! here hbl used as a dummy variable, integrating vertically N^2
-     DO_3D_11_11( 1, jpkm1 )
+     DO_3D( 1, 1, 1, 1, 1, jpkm1 )
         ikt = mbkt(ji,jj)
         hbl(ji,jj) = hbl(ji,jj) + MAX( rn2(ji,jj,jk) , 0._wp ) * e3w(ji,jj,jk,Kmm)
@@ -1522 +1522 @@
      END_3D
      !
-     DO_2D_11_11
+     DO_2D( 1, 1, 1, 1 )
         iiki = imld_rst(ji,jj)
         hbl (ji,jj) = gdepw(ji,jj,iiki  ,Kmm) * ssmask(ji,jj)    ! Turbocline depth
@@ -1561 +1561 @@
 
       ! add non-local temperature and salinity flux
-      DO_3D_00_00( 1, jpkm1 )
+      DO_3D( 0, 0, 0, 0, 1, jpkm1 )
          pts(ji,jj,jk,jp_tem,Krhs) =  pts(ji,jj,jk,jp_tem,Krhs)                      &
             &                 - (  ghamt(ji,jj,jk  )  &
@@ -1629 +1629 @@
       !code saving tracer trends removed, replace with trdmxl_oce
 
-      DO_3D_00_00( 1, jpkm1 )
+      DO_3D( 0, 0, 0, 0, 1, jpkm1 )
          puu(ji,jj,jk,Krhs) =  puu(ji,jj,jk,Krhs)                      &
             &                 - (  ghamu(ji,jj,jk  )  &