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 13470 for NEMO/branches/2020/temporary_r4_trunk/src/OCE/DYN/dynspg_ts.F90 – NEMO

Ignore:
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:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/temporary_r4_trunk/src/OCE/DYN/dynspg_ts.F90

    r13469 r13470  
    253253         IF( ln_wd_il ) THEN                       ! W/D : limiter applied to spgspg 
    254254            CALL wad_spg( sshn, zcpx, zcpy )          ! Calculating W/D gravity filters, zcpx and zcpy 
    255             DO_2D_00_00 
     255            DO_2D( 0, 0, 0, 0 ) 
    256256               zu_trd(ji,jj) = zu_trd(ji,jj) - grav * ( sshn(ji+1,jj  ) - sshn(ji  ,jj ) )   & 
    257257                  &                          * r1_e1u(ji,jj) * zcpx(ji,jj)  * wdrampu(ji,jj)  !jth 
     
    260260            END_2D 
    261261         ELSE                                      ! now suface pressure gradient 
    262             DO_2D_00_00 
     262            DO_2D( 0, 0, 0, 0 ) 
    263263               zu_trd(ji,jj) = zu_trd(ji,jj) - grav * (  sshn(ji+1,jj  ) - sshn(ji  ,jj  )  ) * r1_e1u(ji,jj) 
    264264               zv_trd(ji,jj) = zv_trd(ji,jj) - grav * (  sshn(ji  ,jj+1) - sshn(ji  ,jj  )  ) * r1_e2v(ji,jj)  
     
    268268      ENDIF 
    269269      ! 
    270       DO_2D_00_00 
     270      DO_2D( 0, 0, 0, 0 ) 
    271271          zu_frc(ji,jj) = zu_frc(ji,jj) - zu_trd(ji,jj) * ssumask(ji,jj) 
    272272          zv_frc(ji,jj) = zv_frc(ji,jj) - zv_trd(ji,jj) * ssvmask(ji,jj) 
     
    281281      IF( ln_apr_dyn ) THEN 
    282282         IF( ln_bt_fw ) THEN                          ! FORWARD integration: use kt+1/2 pressure (NOW+1/2) 
    283             DO_2D_00_00 
     283            DO_2D( 0, 0, 0, 0 ) 
    284284               zu_frc(ji,jj) = zu_frc(ji,jj) + grav * (  ssh_ib (ji+1,jj  ) - ssh_ib (ji,jj) ) * r1_e1u(ji,jj) 
    285285               zv_frc(ji,jj) = zv_frc(ji,jj) + grav * (  ssh_ib (ji  ,jj+1) - ssh_ib (ji,jj) ) * r1_e2v(ji,jj) 
     
    287287         ELSE                                         ! CENTRED integration: use kt-1/2 + kt+1/2 pressure (NOW) 
    288288            zztmp = grav * r1_2 
    289             DO_2D_00_00 
     289            DO_2D( 0, 0, 0, 0 ) 
    290290               zu_frc(ji,jj) = zu_frc(ji,jj) + zztmp * (  ssh_ib (ji+1,jj  ) - ssh_ib (ji,jj)  & 
    291291                    &                                   + ssh_ibb(ji+1,jj  ) - ssh_ibb(ji,jj)  ) * r1_e1u(ji,jj) 
     
    299299      !                                   !  ----------------------------------  ! 
    300300      IF( ln_bt_fw ) THEN                        ! Add wind forcing 
    301          DO_2D_00_00 
     301         DO_2D( 0, 0, 0, 0 ) 
    302302            zu_frc(ji,jj) =  zu_frc(ji,jj) + r1_rau0 * utau(ji,jj) * r1_hu_n(ji,jj) 
    303303            zv_frc(ji,jj) =  zv_frc(ji,jj) + r1_rau0 * vtau(ji,jj) * r1_hv_n(ji,jj) 
     
    305305      ELSE 
    306306         zztmp = r1_rau0 * r1_2 
    307          DO_2D_00_00 
     307         DO_2D( 0, 0, 0, 0 ) 
    308308            zu_frc(ji,jj) =  zu_frc(ji,jj) + zztmp * ( utau_b(ji,jj) + utau(ji,jj) ) * r1_hu_n(ji,jj) 
    309309            zv_frc(ji,jj) =  zv_frc(ji,jj) + zztmp * ( vtau_b(ji,jj) + vtau(ji,jj) ) * r1_hv_n(ji,jj) 
     
    443443            ! 
    444444            !                          ! ocean u- and v-depth at mid-step   (separate DO-loops remove the need of a lbc_lnk) 
    445             DO_2D_11_10 
     445            DO_2D( 1, 1, 1, 0 ) 
    446446               zhup2_e(ji,jj) = hu_0(ji,jj) + r1_2 * r1_e1e2u(ji,jj)                        & 
    447447                    &                              * (  e1e2t(ji  ,jj) * zsshp2_e(ji  ,jj)  & 
    448448                    &                                 + e1e2t(ji+1,jj) * zsshp2_e(ji+1,jj)  ) * ssumask(ji,jj) 
    449449            END_2D 
    450             DO_2D_10_11 
     450            DO_2D( 1, 0, 1, 1 ) 
    451451               zhvp2_e(ji,jj) = hv_0(ji,jj) + r1_2 * r1_e1e2v(ji,jj)                        & 
    452452                    &                              * (  e1e2t(ji,jj  ) * zsshp2_e(ji,jj  )  & 
     
    508508         !--        ssh    =  ssh   - delta_t' * [ frc + div( flux      ) ]      --! 
    509509         !-------------------------------------------------------------------------! 
    510          DO_2D_00_00 
     510         DO_2D( 0, 0, 0, 0 ) 
    511511            zhdiv = (   zhU(ji,jj) - zhU(ji-1,jj) + zhV(ji,jj) - zhV(ji,jj-1)   ) * r1_e1e2t(ji,jj) 
    512512            ssha_e(ji,jj) = (  sshn_e(ji,jj) - rdtbt * ( zssh_frc(ji,jj) + zhdiv )  ) * ssmask(ji,jj) 
     
    533533         ! Sea Surface Height at u-,v-points (vvl case only) 
    534534         IF( .NOT.ln_linssh ) THEN                                 
    535             DO_2D_00_00 
     535            DO_2D( 0, 0, 0, 0 ) 
    536536               zsshu_a(ji,jj) = r1_2 * ssumask(ji,jj) * r1_e1e2u(ji,jj)    & 
    537537                  &              * ( e1e2t(ji  ,jj  )  * ssha_e(ji  ,jj  ) & 
     
    553553         !                             ! Surface pressure gradient 
    554554         zldg = ( 1._wp - rn_scal_load ) * grav    ! local factor 
    555          DO_2D_00_00 
     555         DO_2D( 0, 0, 0, 0 ) 
    556556            zu_spg(ji,jj) = - zldg * ( zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj) ) * r1_e1u(ji,jj) 
    557557            zv_spg(ji,jj) = - zldg * ( zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj) ) * r1_e2v(ji,jj) 
     
    571571         ! Add tidal astronomical forcing if defined 
    572572         IF ( ln_tide .AND. ln_tide_pot ) THEN 
    573             DO_2D_00_00 
     573            DO_2D( 0, 0, 0, 0 ) 
    574574               zu_trd(ji,jj) = zu_trd(ji,jj) + grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) * r1_e1u(ji,jj) 
    575575               zv_trd(ji,jj) = zv_trd(ji,jj) + grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) * r1_e2v(ji,jj) 
     
    580580!jth do implicitly instead 
    581581         IF ( .NOT. ll_wd ) THEN ! Revert to explicit for bit comparison tests in non wad runs 
    582             DO_2D_00_00 
     582            DO_2D( 0, 0, 0, 0 ) 
    583583               zu_trd(ji,jj) = zu_trd(ji,jj) + zCdU_u(ji,jj) * un_e(ji,jj) * hur_e(ji,jj) 
    584584               zv_trd(ji,jj) = zv_trd(ji,jj) + zCdU_v(ji,jj) * vn_e(ji,jj) * hvr_e(ji,jj) 
     
    598598         !------------------------------------------------------------------------------------------------------------------------! 
    599599         IF( ln_dynadv_vec .OR. ln_linssh ) THEN      !* Vector form 
    600             DO_2D_00_00 
     600            DO_2D( 0, 0, 0, 0 ) 
    601601               ua_e(ji,jj) = (                                 un_e(ji,jj)   &  
    602602                         &     + rdtbt * (                   zu_spg(ji,jj)   & 
     
    613613            ! 
    614614         ELSE                           !* Flux form 
    615             DO_2D_00_00 
     615            DO_2D( 0, 0, 0, 0 ) 
    616616               !                    ! hu_e, hv_e hold depth at jn,  zhup2_e, zhvp2_e hold extrapolated depth at jn+1/2 
    617617               !                    ! backward interpolated depth used in spg terms at jn+1/2 
     
    637637!jth implicit bottom friction: 
    638638         IF ( ll_wd ) THEN ! revert to explicit for bit comparison tests in non wad runs 
    639             DO_2D_00_00 
     639            DO_2D( 0, 0, 0, 0 ) 
    640640                  ua_e(ji,jj) =  ua_e(ji,jj) /(1.0 -   rdtbt * zCdU_u(ji,jj) * hur_e(ji,jj)) 
    641641                  va_e(ji,jj) =  va_e(ji,jj) /(1.0 -   rdtbt * zCdU_v(ji,jj) * hvr_e(ji,jj)) 
     
    703703      IF (ln_bt_fw) THEN 
    704704         IF( .NOT.( kt == nit000 .AND. neuler==0 ) ) THEN 
    705             DO_2D_11_11 
     705            DO_2D( 1, 1, 1, 1 ) 
    706706               zun_save = un_adv(ji,jj) 
    707707               zvn_save = vn_adv(ji,jj) 
     
    734734      ELSE 
    735735         ! At this stage, ssha has been corrected: compute new depths at velocity points 
    736          DO_2D_10_10 
     736         DO_2D( 1, 0, 1, 0 ) 
    737737            zsshu_a(ji,jj) = r1_2 * ssumask(ji,jj)  * r1_e1e2u(ji,jj) & 
    738738               &              * ( e1e2t(ji  ,jj) * ssha(ji  ,jj)      & 
     
    969969      ! Max courant number for ext. grav. waves 
    970970      ! 
    971       DO_2D_11_11 
     971      DO_2D( 1, 1, 1, 1 ) 
    972972         zxr2 = r1_e1t(ji,jj) * r1_e1t(ji,jj) 
    973973         zyr2 = r1_e2t(ji,jj) * r1_e2t(ji,jj) 
     
    10931093         SELECT CASE( nn_een_e3f )              !* ff_f/e3 at F-point 
    10941094         CASE ( 0 )                                   ! original formulation  (masked averaging of e3t divided by 4) 
    1095             DO_2D_10_10 
     1095            DO_2D( 1, 0, 1, 0 ) 
    10961096               zwz(ji,jj) =   ( ht_n(ji  ,jj+1) + ht_n(ji+1,jj+1) +                    & 
    10971097                    &             ht_n(ji  ,jj  ) + ht_n(ji+1,jj  )   ) * 0.25_wp   
     
    10991099            END_2D 
    11001100         CASE ( 1 )                                   ! new formulation  (masked averaging of e3t divided by the sum of mask) 
    1101             DO_2D_10_10 
     1101            DO_2D( 1, 0, 1, 0 ) 
    11021102               zwz(ji,jj) =             (  ht_n  (ji  ,jj+1) + ht_n  (ji+1,jj+1)      & 
    11031103                    &                      + ht_n  (ji  ,jj  ) + ht_n  (ji+1,jj  )  )   & 
     
    11101110         ! 
    11111111         ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp 
    1112          DO_2D_01_01 
     1112         DO_2D( 0, 1, 0, 1 ) 
    11131113            ftne(ji,jj) = zwz(ji-1,jj  ) + zwz(ji  ,jj  ) + zwz(ji  ,jj-1) 
    11141114            ftnw(ji,jj) = zwz(ji-1,jj-1) + zwz(ji-1,jj  ) + zwz(ji  ,jj  ) 
     
    11191119      CASE( np_EET )                  != EEN scheme using e3t (energy conserving scheme) 
    11201120         ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp 
    1121          DO_2D_01_01 
     1121         DO_2D( 0, 1, 0, 1 ) 
    11221122            z1_ht = ssmask(ji,jj) / ( ht_n(ji,jj) + 1._wp - ssmask(ji,jj) ) 
    11231123            ftne(ji,jj) = ( ff_f(ji-1,jj  ) + ff_f(ji  ,jj  ) + ff_f(ji  ,jj-1) ) * z1_ht 
     
    11521152            ! 
    11531153            !zhf(:,:) = hbatf(:,:) 
    1154             DO_2D_10_10 
     1154            DO_2D( 1, 0, 1, 0 ) 
    11551155               zhf(ji,jj) =    (   ht_0  (ji,jj  ) + ht_0  (ji+1,jj  )          & 
    11561156                    &            + ht_0  (ji,jj+1) + ht_0  (ji+1,jj+1)   )      & 
     
    11711171         CALL lbc_lnk( 'dynspg_ts', zhf, 'F', 1._wp ) 
    11721172         ! JC: TBC. hf should be greater than 0  
    1173          DO_2D_11_11 
     1173         DO_2D( 1, 1, 1, 1 ) 
    11741174            IF( zhf(ji,jj) /= 0._wp )   zwz(ji,jj) = 1._wp / zhf(ji,jj) 
    11751175         END_2D 
     
    11941194      SELECT CASE( nvor_scheme ) 
    11951195      CASE( np_ENT )                ! enstrophy conserving scheme (f-point) 
    1196          DO_2D_00_00 
     1196         DO_2D( 0, 0, 0, 0 ) 
    11971197            z1_hu = ssumask(ji,jj) / ( hu_n(ji,jj) + 1._wp - ssumask(ji,jj) ) 
    11981198            z1_hv = ssvmask(ji,jj) / ( hv_n(ji,jj) + 1._wp - ssvmask(ji,jj) ) 
     
    12071207         !          
    12081208      CASE( np_ENE , np_MIX )        ! energy conserving scheme (t-point) ENE or MIX 
    1209          DO_2D_00_00 
     1209         DO_2D( 0, 0, 0, 0 ) 
    12101210            zy1 = ( zhV(ji,jj-1) + zhV(ji+1,jj-1) ) * r1_e1u(ji,jj) 
    12111211            zy2 = ( zhV(ji,jj  ) + zhV(ji+1,jj  ) ) * r1_e1u(ji,jj) 
     
    12181218         ! 
    12191219      CASE( np_ENS )                ! enstrophy conserving scheme (f-point) 
    1220          DO_2D_00_00 
     1220         DO_2D( 0, 0, 0, 0 ) 
    12211221            zy1 =   r1_8 * ( zhV(ji  ,jj-1) + zhV(ji+1,jj-1) & 
    12221222              &            + zhV(ji  ,jj  ) + zhV(ji+1,jj  ) ) * r1_e1u(ji,jj) 
     
    12281228         ! 
    12291229      CASE( np_EET , np_EEN )      ! energy & enstrophy scheme (using e3t or e3f)          
    1230          DO_2D_00_00 
     1230         DO_2D( 0, 0, 0, 0 ) 
    12311231            zu_trd(ji,jj) = + r1_12 * r1_e1u(ji,jj) * (  ftne(ji,jj  ) * zhV(ji  ,jj  ) & 
    12321232             &                                         + ftnw(ji+1,jj) * zhV(ji+1,jj  ) & 
     
    12621262      ! 
    12631263      IF( ln_wd_dl_rmp ) THEN      
    1264          DO_2D_11_11 
     1264         DO_2D( 1, 1, 1, 1 ) 
    12651265            IF    ( pssh(ji,jj) + ht_0(ji,jj) >  2._wp * rn_wdmin1 ) THEN  
    12661266               !           IF    ( pssh(ji,jj) + ht_0(ji,jj) >          rn_wdmin2 ) THEN  
     
    12731273         END_2D 
    12741274      ELSE   
    1275          DO_2D_11_11 
     1275         DO_2D( 1, 1, 1, 1 ) 
    12761276            IF ( pssh(ji,jj) + ht_0(ji,jj) >  rn_wdmin1 ) THEN   ;   ptmsk(ji,jj) = 1._wp 
    12771277            ELSE                                                 ;   ptmsk(ji,jj) = 0._wp 
     
    13011301      !!---------------------------------------------------------------------- 
    13021302      ! 
    1303       DO_2D_11_10 
     1303      DO_2D( 1, 1, 1, 0 ) 
    13041304         IF ( phU(ji,jj) > 0._wp ) THEN   ;   pUmsk(ji,jj) = pTmsk(ji  ,jj)  
    13051305         ELSE                             ;   pUmsk(ji,jj) = pTmsk(ji+1,jj)   
     
    13091309      END_2D 
    13101310      ! 
    1311       DO_2D_10_11 
     1311      DO_2D( 1, 0, 1, 1 ) 
    13121312         IF ( phV(ji,jj) > 0._wp ) THEN   ;   pVmsk(ji,jj) = pTmsk(ji,jj  ) 
    13131313         ELSE                             ;   pVmsk(ji,jj) = pTmsk(ji,jj+1)   
     
    13311331      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: zcpx, zcpy 
    13321332      !!---------------------------------------------------------------------- 
    1333       DO_2D_00_00 
     1333      DO_2D( 0, 0, 0, 0 ) 
    13341334         ll_tmp1 = MIN(  sshn(ji,jj)               ,  sshn(ji+1,jj) ) >                & 
    13351335              &      MAX( -ht_0(ji,jj)               , -ht_0(ji+1,jj) ) .AND.            & 
     
    13971397      IF( ln_isfcav.OR.ln_drgice_imp ) THEN          ! top+bottom friction (ocean cavities) 
    13981398          
    1399          DO_2D_00_00 
     1399         DO_2D( 0, 0, 0, 0 ) 
    14001400            pCdU_u(ji,jj) = r1_2*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) + rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) 
    14011401            pCdU_v(ji,jj) = r1_2*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) + rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) 
    14021402         END_2D 
    14031403      ELSE                          ! bottom friction only 
    1404          DO_2D_00_00 
     1404         DO_2D( 0, 0, 0, 0 ) 
    14051405            pCdU_u(ji,jj) = r1_2*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) 
    14061406            pCdU_v(ji,jj) = r1_2*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) 
     
    14121412      IF( ln_bt_fw ) THEN                 ! FORWARD integration: use NOW bottom baroclinic velocities 
    14131413          
    1414          DO_2D_00_00 
     1414         DO_2D( 0, 0, 0, 0 ) 
    14151415            ikbu = mbku(ji,jj)        
    14161416            ikbv = mbkv(ji,jj)     
     
    14201420      ELSE                                ! CENTRED integration: use BEFORE bottom baroclinic velocities 
    14211421          
    1422          DO_2D_00_00 
     1422         DO_2D( 0, 0, 0, 0 ) 
    14231423            ikbu = mbku(ji,jj)        
    14241424            ikbv = mbkv(ji,jj)     
     
    14301430      IF( ln_wd_il ) THEN      ! W/D : use the "clipped" bottom friction   !!gm   explain WHY, please ! 
    14311431         zztmp = -1._wp / rdtbt 
    1432          DO_2D_00_00 
     1432         DO_2D( 0, 0, 0, 0 ) 
    14331433            pu_RHSi(ji,jj) = pu_RHSi(ji,jj) + zu_i(ji,jj) *  wdrampu(ji,jj) * MAX(                                 &  
    14341434                 &                              r1_hu_n(ji,jj) * r1_2*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) , zztmp  ) 
     
    14381438      ELSE                    ! use "unclipped" drag (even if explicit friction is used in 3D calculation) 
    14391439          
    1440          DO_2D_00_00 
     1440         DO_2D( 0, 0, 0, 0 ) 
    14411441            pu_RHSi(ji,jj) = pu_RHSi(ji,jj) + r1_hu_n(ji,jj) * r1_2*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * zu_i(ji,jj) 
    14421442            pv_RHSi(ji,jj) = pv_RHSi(ji,jj) + r1_hv_n(ji,jj) * r1_2*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * zv_i(ji,jj) 
     
    14501450         IF( ln_bt_fw ) THEN                ! FORWARD integration: use NOW top baroclinic velocity 
    14511451             
    1452             DO_2D_00_00 
     1452            DO_2D( 0, 0, 0, 0 ) 
    14531453               iktu = miku(ji,jj) 
    14541454               iktv = mikv(ji,jj) 
     
    14581458         ELSE                                ! CENTRED integration: use BEFORE top baroclinic velocity 
    14591459             
    1460             DO_2D_00_00 
     1460            DO_2D( 0, 0, 0, 0 ) 
    14611461               iktu = miku(ji,jj) 
    14621462               iktv = mikv(ji,jj) 
     
    14681468         !                    ! use "unclipped" top drag (even if explicit friction is used in 3D calculation) 
    14691469          
    1470          DO_2D_00_00 
     1470         DO_2D( 0, 0, 0, 0 ) 
    14711471            pu_RHSi(ji,jj) = pu_RHSi(ji,jj) + r1_hu_n(ji,jj) * r1_2*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * zu_i(ji,jj) 
    14721472            pv_RHSi(ji,jj) = pv_RHSi(ji,jj) + r1_hv_n(ji,jj) * r1_2*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) * zv_i(ji,jj) 
Note: See TracChangeset for help on using the changeset viewer.