Changeset 13470 for NEMO/branches/2020/temporary_r4_trunk/src/ICE/icedyn_rhg_evp.F90

Timestamp:

2020-09-15T12:56:56+02:00 (4 years ago)

Author:

smasson

Message:

r4_trunk: second change of DO loops for routines to be merged, see #2523

File:

• NEMO/branches/2020/temporary_r4_trunk/src/ICE/icedyn_rhg_evp.F90 (modified) (20 diffs)

NEMO/branches/2020/temporary_r4_trunk/src/ICE/icedyn_rhg_evp.F90

@@ -182 +182 @@
       ! for diagnostics and convergence tests
       ALLOCATE( zmsk00(jpi,jpj), zmsk15(jpi,jpj) )
-      DO_2D_11_11
+      DO_2D( 1, 1, 1, 1 )
          zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06  ) ) ! 1 if ice    , 0 if no ice
          zmsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less
@@ -192 +192 @@
       !------------------------------------------------------------------------------!
       ! ocean/land mask
-      DO_2D_10_10
+      DO_2D( 1, 0, 1, 0 )
          zfmask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1)
       END_2D
@@ -198 +198 @@
 
       ! Lateral boundary conditions on velocity (modify zfmask)
-      DO_2D_00_00
+      DO_2D( 0, 0, 0, 0 )
          IF( zfmask(ji,jj) == 0._wp ) THEN
             zfmask(ji,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(ji,jj,1), umask(ji,jj+1,1), &
@@ -266 +266 @@
       zsshdyn(:,:) = ice_var_sshdyn( ssh_m, snwice_mass, snwice_mass_b)
 
-      DO_2D_00_00
+      DO_2D( 0, 0, 0, 0 )
 
          ! ice fraction at U-V points
@@ -317 +317 @@
       !
       IF( ln_landfast_L16 ) THEN         !-- Lemieux 2016
-         DO_2D_00_00
+         DO_2D( 0, 0, 0, 0 )
             ! ice thickness at U-V points
             zvU = 0.5_wp * ( vt_i(ji,jj) * e1e2t(ji,jj) + vt_i(ji+1,jj) * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1)
@@ -334 +334 @@
          !
       ELSE                               !-- no landfast
-         DO_2D_00_00
+         DO_2D( 0, 0, 0, 0 )
             ztaux_base(ji,jj) = 0._wp
             ztauy_base(ji,jj) = 0._wp
@@ -351 +351 @@
          ! convergence test
          IF( nn_rhg_chkcvg == 1 .OR. nn_rhg_chkcvg == 2  ) THEN
-            DO_2D_11_11
+            DO_2D( 1, 1, 1, 1 )
                zu_ice(ji,jj) = u_ice(ji,jj) * umask(ji,jj,1) ! velocity at previous time step
                zv_ice(ji,jj) = v_ice(ji,jj) * vmask(ji,jj,1)
@@ -358 +358 @@
 
          ! --- divergence, tension & shear (Appendix B of Hunke & Dukowicz, 2002) --- !
-         DO_2D_10_10
+         DO_2D( 1, 0, 1, 0 )
 
             ! shear at F points
@@ -368 +368 @@
          CALL lbc_lnk( 'icedyn_rhg_evp', zds, 'F', 1. )
 
-         DO_2D_01_01
+         DO_2D( 0, 1, 0, 1 )
 
             ! shear**2 at T points (doc eq. A16)
@@ -417 +417 @@
          ! Save beta at T-points for further computations
          IF( ln_aEVP ) THEN
-            DO_2D_11_11
+            DO_2D( 1, 1, 1, 1 )
                zbeta(ji,jj) = MAX( 50._wp, rpi * SQRT( 0.5_wp * zp_delt(ji,jj) * r1_e1e2t(ji,jj) * zdt_m(ji,jj) ) )
             END_2D
          ENDIF
          
-         DO_2D_10_10
+         DO_2D( 1, 0, 1, 0 )
 
             ! alpha for aEVP
@@ -442 +442 @@
 
          ! --- Ice internal stresses (Appendix C of Hunke and Dukowicz, 2002) --- !
-         DO_2D_00_00
+         DO_2D( 0, 0, 0, 0 )
             !                   !--- U points
             zfU(ji,jj) = 0.5_wp * ( ( zs1(ji+1,jj) - zs1(ji,jj) ) * e2u(ji,jj)                                             &
@@ -470 +470 @@
          IF( MOD(jter,2) == 0 ) THEN ! even iterations
             !
-            DO_2D_00_00
+            DO_2D( 0, 0, 0, 0 )
                !                 !--- tau_io/(v_oce - v_ice)
                zTauO = zaV(ji,jj) * zrhoco * SQRT( ( v_ice (ji,jj) - v_oce (ji,jj) ) * ( v_ice (ji,jj) - v_oce (ji,jj) )  &
@@ -522 +522 @@
             IF( ln_bdy )   CALL bdy_ice_dyn( 'V' )
             !
-            DO_2D_00_00
+            DO_2D( 0, 0, 0, 0 )
                !                 !--- tau_io/(u_oce - u_ice)
                zTauO = zaU(ji,jj) * zrhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) )  &
@@ -576 +576 @@
          ELSE ! odd iterations
             !
-            DO_2D_00_00
+            DO_2D( 0, 0, 0, 0 )
                !                 !--- tau_io/(u_oce - u_ice)
                zTauO = zaU(ji,jj) * zrhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) )  &
@@ -628 +628 @@
             IF( ln_bdy )   CALL bdy_ice_dyn( 'U' )
             !
-            DO_2D_00_00
+            DO_2D( 0, 0, 0, 0 )
                !                 !--- tau_io/(v_oce - v_ice)
                zTauO = zaV(ji,jj) * zrhoco * SQRT( ( v_ice (ji,jj) - v_oce (ji,jj) ) * ( v_ice (ji,jj) - v_oce (ji,jj) )  &
@@ -693 +693 @@
       ! 4) Recompute delta, shear and div (inputs for mechanical redistribution) 
       !------------------------------------------------------------------------------!
-      DO_2D_10_10
+      DO_2D( 1, 0, 1, 0 )
 
          ! shear at F points
@@ -702 +702 @@
       END_2D
       
-      DO_2D_00_00
+      DO_2D( 0, 0, 0, 0 )
          
          ! tension**2 at T points
@@ -766 +766 @@
          ALLOCATE( zsig1(jpi,jpj) , zsig2(jpi,jpj) , zsig3(jpi,jpj) )
          !         
-         DO_2D_00_00
+         DO_2D( 0, 0, 0, 0 )
             zdum1 = ( zmsk00(ji-1,jj) * pstress12_i(ji-1,jj) + zmsk00(ji  ,jj-1) * pstress12_i(ji  ,jj-1) +  &  ! stress12_i at T-point
                &      zmsk00(ji  ,jj) * pstress12_i(ji  ,jj) + zmsk00(ji-1,jj-1) * pstress12_i(ji-1,jj-1) )  &
@@ -817 +817 @@
             &      zdiag_xmtrp_snw(jpi,jpj) , zdiag_ymtrp_snw(jpi,jpj) , zdiag_xatrp(jpi,jpj) , zdiag_yatrp(jpi,jpj) )
          !
-         DO_2D_00_00
+         DO_2D( 0, 0, 0, 0 )
             ! 2D ice mass, snow mass, area transport arrays (X, Y)
             zfac_x = 0.5 * u_ice(ji,jj) * e2u(ji,jj) * zmsk00(ji,jj)
@@ -917 +917 @@
          zresm = 0._wp
       ELSE
-         DO_2D_11_11
+         DO_2D( 1, 1, 1, 1 )
             zres(ji,jj) = MAX( ABS( pu(ji,jj) - pub(ji,jj) ) * umask(ji,jj,1), &
                &               ABS( pv(ji,jj) - pvb(ji,jj) ) * vmask(ji,jj,1) ) * zmsk15(ji,jj)