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 13295 for NEMO/trunk/src/OCE/TRA/traadv_ubs.F90 – NEMO

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

Legend:

Unmodified
Added
Removed
  • NEMO/trunk/src/OCE/TRA/traadv_ubs.F90

    r13237 r13295  
    125125         !                                               
    126126         DO jk = 1, jpkm1        !==  horizontal laplacian of before tracer ==! 
    127             DO_2D_10_10 
     127            DO_2D( 1, 0, 1, 0 ) 
    128128               zeeu = e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm) * umask(ji,jj,jk) 
    129129               zeev = e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm) * vmask(ji,jj,jk) 
     
    131131               ztv(ji,jj,jk) = zeev * ( pt(ji  ,jj+1,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) ) 
    132132            END_2D 
    133             DO_2D_00_00 
     133            DO_2D( 0, 0, 0, 0 ) 
    134134               zcoef = 1._wp / ( 6._wp * e3t(ji,jj,jk,Kmm) ) 
    135135               zltu(ji,jj,jk) = (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)  ) * zcoef 
     
    140140         CALL lbc_lnk( 'traadv_ubs', zltu, 'T', 1.0_wp )   ;    CALL lbc_lnk( 'traadv_ubs', zltv, 'T', 1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
    141141         !     
    142          DO_3D_10_10( 1, jpkm1 ) 
     142         DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 
    143143            zfp_ui = pU(ji,jj,jk) + ABS( pU(ji,jj,jk) )      ! upstream transport (x2) 
    144144            zfm_ui = pU(ji,jj,jk) - ABS( pU(ji,jj,jk) ) 
     
    156156         ! 
    157157         DO jk = 1, jpkm1        !==  add the horizontal advective trend  ==! 
    158             DO_2D_00_00 
     158            DO_2D( 0, 0, 0, 0 ) 
    159159               pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs)                        & 
    160160                  &             - (  ztu(ji,jj,jk) - ztu(ji-1,jj  ,jk)    & 
     
    188188            ! 
    189189            !                          !*  upstream advection with initial mass fluxes & intermediate update  ==! 
    190             DO_3D_11_11( 2, jpkm1 ) 
     190            DO_3D( 1, 1, 1, 1, 2, jpkm1 ) 
    191191               zfp_wk = pW(ji,jj,jk) + ABS( pW(ji,jj,jk) ) 
    192192               zfm_wk = pW(ji,jj,jk) - ABS( pW(ji,jj,jk) ) 
     
    195195            IF( ln_linssh ) THEN             ! top ocean value (only in linear free surface as ztw has been w-masked) 
    196196               IF( ln_isfcav ) THEN                ! top of the ice-shelf cavities and at the ocean surface 
    197                   DO_2D_11_11 
     197                  DO_2D( 1, 1, 1, 1 ) 
    198198                     ztw(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kbb)   ! linear free surface  
    199199                  END_2D 
     
    203203            ENDIF 
    204204            ! 
    205             DO_3D_00_00( 1, jpkm1 ) 
     205            DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    206206               ztak = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) )    & 
    207207                  &     * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 
     
    212212            ! 
    213213            !                          !*  anti-diffusive flux : high order minus low order 
    214             DO_3D_11_11( 2, jpkm1 ) 
     214            DO_3D( 1, 1, 1, 1, 2, jpkm1 ) 
    215215               ztw(ji,jj,jk) = (   0.5_wp * pW(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj,jk-1,jn,Kmm) )   & 
    216216                  &              - ztw(ji,jj,jk)   ) * wmask(ji,jj,jk) 
     
    223223         CASE(  4  )                               ! 4th order COMPACT 
    224224            CALL interp_4th_cpt( pt(:,:,:,jn,Kmm) , ztw )         ! 4th order compact interpolation of T at w-point 
    225             DO_3D_00_00( 2, jpkm1 ) 
     225            DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    226226               ztw(ji,jj,jk) = pW(ji,jj,jk) * ztw(ji,jj,jk) * wmask(ji,jj,jk) 
    227227            END_3D 
     
    230230         END SELECT 
    231231         ! 
    232          DO_3D_00_00( 1, jpkm1 ) 
     232         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    233233            pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) )    & 
    234234               &                                        * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 
     
    236236         ! 
    237237         IF( l_trd )  THEN       ! vertical advective trend diagnostics 
    238             DO_3D_00_00( 1, jpkm1 ) 
     238            DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    239239               zltv(ji,jj,jk) = pt(ji,jj,jk,jn,Krhs) - zltv(ji,jj,jk)                          & 
    240240                  &           + pt(ji,jj,jk,jn,Kmm) * (  pW(ji,jj,jk) - pW(ji,jj,jk+1)  )   & 
     
    286286      DO jk = 1, jpkm1     ! search maximum in neighbourhood 
    287287         ikm1 = MAX(jk-1,1) 
    288          DO_2D_00_00 
     288         DO_2D( 0, 0, 0, 0 ) 
    289289            zbetup(ji,jj,jk) = MAX(  pbef(ji  ,jj  ,jk  ), paft(ji  ,jj  ,jk  ),   & 
    290290               &                     pbef(ji  ,jj  ,ikm1), pbef(ji  ,jj  ,jk+1),   & 
     
    298298      DO jk = 1, jpkm1     ! search minimum in neighbourhood 
    299299         ikm1 = MAX(jk-1,1) 
    300          DO_2D_00_00 
     300         DO_2D( 0, 0, 0, 0 ) 
    301301            zbetdo(ji,jj,jk) = MIN(  pbef(ji  ,jj  ,jk  ), paft(ji  ,jj  ,jk  ),   & 
    302302               &                     pbef(ji  ,jj  ,ikm1), pbef(ji  ,jj  ,jk+1),   & 
     
    310310      ! Positive and negative part of fluxes and beta terms 
    311311      ! --------------------------------------------------- 
    312       DO_3D_00_00( 1, jpkm1 ) 
     312      DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    313313         ! positive & negative part of the flux 
    314314         zpos = MAX( 0., pcc(ji  ,jj  ,jk+1) ) - MIN( 0., pcc(ji  ,jj  ,jk  ) ) 
     
    322322      ! monotonic flux in the k direction, i.e. pcc 
    323323      ! ------------------------------------------- 
    324       DO_3D_00_00( 2, jpkm1 ) 
     324      DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    325325         za = MIN( 1., zbetdo(ji,jj,jk), zbetup(ji,jj,jk-1) ) 
    326326         zb = MIN( 1., zbetup(ji,jj,jk), zbetdo(ji,jj,jk-1) ) 
Note: See TracChangeset for help on using the changeset viewer.