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 14215 for NEMO/trunk/src/OCE/TRA – NEMO

Ignore:
Timestamp:
2020-12-18T14:49:22+01:00 (3 years ago)
Author:
acc
Message:

trunk changes to swap the order of arguments to the DO LOOP macros. These changes result in a more natural i-j-k ordering as explained in #2595. SETTE is passed before and after these changes and results are unchanged. This fixes #2595

Location:
NEMO/trunk/src/OCE/TRA
Files:
7 edited

Legend:

Unmodified
Added
Removed

  • NEMO/trunk/src/OCE/TRA/traadv_qck.F90

    r14189 r14215  
    145145         ! 
    146146!!gm why not using a SHIFT instruction... 
    147          DO_3D( 0, 0, nn_hls-1, nn_hls-1, 1, jpkm1 )     !--- Computation of the ustream and downstream value of the tracer and the mask 
     147         DO_3D( nn_hls-1, nn_hls-1, 0, 0, 1, jpkm1 )     !--- Computation of the ustream and downstream value of the tracer and the mask 
    148148            zfc(ji,jj,jk) = pt(ji-1,jj,jk,jn,Kbb)        ! Upstream   in the x-direction for the tracer 
    149149            zfd(ji,jj,jk) = pt(ji+1,jj,jk,jn,Kbb)        ! Downstream in the x-direction for the tracer 
    … …  
    154154         ! Horizontal advective fluxes 
    155155         ! --------------------------- 
    156          DO_3D( 0, 0, nn_hls-1, 0, 1, jpkm1 ) 
     156         DO_3D( nn_hls-1, 0, 0, 0, 1, jpkm1 ) 
    157157            zdir = 0.5 + SIGN( 0.5_wp, pU(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0 
    158158            zfu(ji,jj,jk) = zdir * zfc(ji,jj,jk ) + ( 1. - zdir ) * zfd(ji+1,jj,jk)  ! FU in the x-direction for T 
    159159         END_3D 
    160160         ! 
    161          DO_3D( 0, 0, nn_hls-1, 0, 1, jpkm1 ) 
     161         DO_3D( nn_hls-1, 0, 0, 0, 1, jpkm1 ) 
    162162            zdir = 0.5 + SIGN( 0.5_wp, pU(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0 
    163163            zdx = ( zdir * e1t(ji,jj) + ( 1. - zdir ) * e1t(ji+1,jj) ) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) 
    … …  
    173173         ! 
    174174         ! Mask at the T-points in the x-direction (mask=0 or mask=1) 
    175          DO_3D( 0, 0, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
     175         DO_3D( nn_hls-1, nn_hls-1, 0, 0, 1, jpkm1 ) 
    176176            zfu(ji,jj,jk) = tmask(ji-1,jj,jk) + tmask(ji,jj,jk) + tmask(ji+1,jj,jk) - 2. 
    177177         END_3D 
    … …  
    180180         ! 
    181181         ! Tracer flux on the x-direction 
    182          DO_3D( 0, 0, 1, 0, 1, jpkm1 ) 
     182         DO_3D( 1, 0, 0, 0, 1, jpkm1 ) 
    183183            zdir = 0.5 + SIGN( 0.5_wp, pU(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0 
    184184            !--- If the second ustream point is a land point 
    … …  
    232232            ! 
    233233            !--- Computation of the ustream and downstream value of the tracer and the mask 
    234             DO_2D( nn_hls-1, nn_hls-1, 0, 0 ) 
     234            DO_2D( 0, 0, nn_hls-1, nn_hls-1 ) 
    235235               ! Upstream in the x-direction for the tracer 
    236236               zfc(ji,jj,jk) = pt(ji,jj-1,jk,jn,Kbb) 
    … …  
    245245         ! --------------------------- 
    246246         ! 
    247          DO_3D( nn_hls-1, 0, 0, 0, 1, jpkm1 ) 
     247         DO_3D( 0, 0, nn_hls-1, 0, 1, jpkm1 ) 
    248248            zdir = 0.5 + SIGN( 0.5_wp, pV(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0 
    249249            zfu(ji,jj,jk) = zdir * zfc(ji,jj,jk ) + ( 1. - zdir ) * zfd(ji,jj+1,jk)  ! FU in the x-direction for T 
    250250         END_3D 
    251251         ! 
    252          DO_3D( nn_hls-1, 0, 0, 0, 1, jpkm1 ) 
     252         DO_3D( 0, 0, nn_hls-1, 0, 1, jpkm1 ) 
    253253            zdir = 0.5 + SIGN( 0.5_wp, pV(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0 
    254254            zdx = ( zdir * e2t(ji,jj) + ( 1. - zdir ) * e2t(ji,jj+1) ) * e1v(ji,jj) * e3v(ji,jj,jk,Kmm) 
    … …  
    265265         ! 
    266266         ! Mask at the T-points in the x-direction (mask=0 or mask=1) 
    267          DO_3D( nn_hls-1, nn_hls-1, 0, 0, 1, jpkm1 ) 
     267         DO_3D( 0, 0, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
    268268            zfu(ji,jj,jk) = tmask(ji,jj-1,jk) + tmask(ji,jj,jk) + tmask(ji,jj+1,jk) - 2. 
    269269         END_3D 
    … …  
    271271         ! 
    272272         ! Tracer flux on the x-direction 
    273          DO_3D( 1, 0, 0, 0, 1, jpkm1 ) 
     273         DO_3D( 0, 0, 1, 0, 1, jpkm1 ) 
    274274            zdir = 0.5 + SIGN( 0.5_wp, pV(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0 
    275275            !--- If the second ustream point is a land point 

  • NEMO/trunk/src/OCE/TRA/trabbl.F90

    r14189 r14215  
    248248      DO jn = 1, kjpt                                            ! tracer loop 
    249249         !                                                       ! =========== 
    250          DO_2D( isj, 0, isi, 0 )            ! CAUTION start from i=1 to update i=2 when cyclic east-west 
     250         DO_2D( isi, 0, isj, 0 )            ! CAUTION start from i=1 to update i=2 when cyclic east-west 
    251251            IF( utr_bbl(ji,jj) /= 0.e0 ) THEN            ! non-zero i-direction bbl advection 
    252252               ! down-slope i/k-indices (deep)      &   up-slope i/k indices (shelf) 

  • NEMO/trunk/src/OCE/TRA/traldf_lap_blp.F90

    r14189 r14215  
    158158         ENDIF 
    159159         ! 
    160          DO_3D( isj, iej, isi, iei, 1, jpkm1 )            !== Second derivative (divergence) added to the general tracer trends  ==! 
     160         DO_3D( isi, iei, isj, iej, 1, jpkm1 )            !== Second derivative (divergence) added to the general tracer trends  ==! 
    161161            pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) + (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)     & 
    162162               &                                      +    ztv(ji,jj,jk) - ztv(ji,jj-1,jk) )   & 

  • NEMO/trunk/src/OCE/TRA/traldf_triad.F90

    r14090 r14215  
    387387         !                                !==  add the vertical 33 flux  ==! 
    388388         IF( ln_traldf_lap ) THEN               ! laplacian case: eddy coef = ah_wslp2 - akz 
    389             DO_3D( 1, 0, 0, 0, 2, jpkm1 ) 
     389            DO_3D( 0, 0, 1, 0, 2, jpkm1 ) 
    390390               ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk)   & 
    391391                  &                            * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) )             & 
    … …  
    395395            SELECT CASE( kpass ) 
    396396            CASE(  1  )                            ! 1st pass : eddy coef = ah_wslp2 
    397                DO_3D( 1, 0, 0, 0, 2, jpkm1 ) 
     397               DO_3D( 0, 0, 1, 0, 2, jpkm1 ) 
    398398                  ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk)             & 
    399399                     &                            * ah_wslp2(ji,jj,jk) * ( pt(ji,jj,jk-1,jn) - pt(ji,jj,jk,jn) ) 
    400400               END_3D 
    401401            CASE(  2  )                            ! 2nd pass : eddy flux = ah_wslp2 and akz applied on pt  and pt2 gradients, resp. 
    402                DO_3D( 1, 0, 0, 0, 2, jpkm1 ) 
     402               DO_3D( 0, 0, 1, 0, 2, jpkm1 ) 
    403403                  ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk)                      & 
    404404                     &                            * (  ah_wslp2(ji,jj,jk) * ( pt (ji,jj,jk-1,jn) - pt (ji,jj,jk,jn) )   & 

  • NEMO/trunk/src/OCE/TRA/tranpc.F90

    r14189 r14215  
    112112         IF( ntej == Nje0 ) THEN ; iej = nn_hls ; ELSE ; iej = 0 ; ENDIF 
    113113         ! 
    114          DO_2D( isj, iej, isi, iei )                        ! interior column only 
     114         DO_2D( isi, iei, isj, iej )                        ! interior column only 
    115115            ! 
    116116            IF( tmask(ji,jj,2) == 1 ) THEN      ! At least 2 ocean points 

  • NEMO/trunk/src/OCE/TRA/traqsr.F90

    r14189 r14215  
    151151         ELSE                                           ! No restart or Euler forward at 1st time step 
    152152            z1_2 = 1._wp 
    153             DO_3D( isj, iej, isi, iei, 1, jpk ) 
     153            DO_3D( isi, iei, isj, iej, 1, jpk ) 
    154154               qsr_hc_b(ji,jj,jk) = 0._wp 
    155155            END_3D 
    … …  
    157157      ELSE                             !==  Swap of qsr heat content  ==! 
    158158         z1_2 = 0.5_wp 
    159          DO_3D( isj, iej, isi, iei, 1, jpk ) 
     159         DO_3D( isi, iei, isj, iej, 1, jpk ) 
    160160            qsr_hc_b(ji,jj,jk) = qsr_hc(ji,jj,jk) 
    161161         END_3D 
    … …  
    168168      CASE( np_BIO )                   !==  bio-model fluxes  ==! 
    169169         ! 
    170          DO_3D( isj, iej, isi, iei, 1, nksr ) 
     170         DO_3D( isi, iei, isj, iej, 1, nksr ) 
    171171            qsr_hc(ji,jj,jk) = r1_rho0_rcp * ( etot3(ji,jj,jk) - etot3(ji,jj,jk+1) ) 
    172172         END_3D 
    … …  
    190190            ! most expensive calculations) 
    191191            ! 
    192             DO_2D( isj, iej, isi, iei ) 
     192            DO_2D( isi, iei, isj, iej ) 
    193193                       ! zlogc = log(zchl) 
    194194               zlogc = LOG ( MIN( 10. , MAX( 0.03, sf_chl(1)%fnow(ji,jj,1) ) ) ) 
    … …  
    209209 
    210210! 
    211             DO_3D( isj, iej, isi, iei, 1, nksr + 1 ) 
     211            DO_3D( isi, iei, isj, iej, 1, nksr + 1 ) 
    212212               ! zchl    = ALOG( ze0(ji,jj) ) 
    213213               zlogc = ze0(ji,jj) 
    … …  
    239239         ! 
    240240         zcoef  = ( 1. - rn_abs ) / 3._wp    !* surface equi-partition in R-G-B 
    241          DO_2D( isj, iej, isi, iei ) 
     241         DO_2D( isi, iei, isj, iej ) 
    242242            ze0(ji,jj) = rn_abs * qsr(ji,jj) 
    243243            ze1(ji,jj) = zcoef  * qsr(ji,jj) 
    … …  
    250250         ! 
    251251         !                                    !* interior equi-partition in R-G-B depending on vertical profile of Chl 
    252          DO_3D( isj, iej, isi, iei, 2, nksr + 1 ) 
     252         DO_3D( isi, iei, isj, iej, 2, nksr + 1 ) 
    253253            ze3t = e3t(ji,jj,jk-1,Kmm) 
    254254            irgb = NINT( ztmp3d(ji,jj,jk) ) 
    … …  
    264264         END_3D 
    265265         ! 
    266          DO_3D( isj, iej, isi, iei, 1, nksr )          !* now qsr induced heat content 
     266         DO_3D( isi, iei, isj, iej, 1, nksr )          !* now qsr induced heat content 
    267267            qsr_hc(ji,jj,jk) = r1_rho0_rcp * ( ztmp3d(ji,jj,jk) - ztmp3d(ji,jj,jk+1) ) 
    268268         END_3D 
    … …  
    274274         zz0 =        rn_abs   * r1_rho0_rcp      ! surface equi-partition in 2-bands 
    275275         zz1 = ( 1. - rn_abs ) * r1_rho0_rcp 
    276          DO_3D( isj, iej, isi, iei, 1, nksr )          !* now qsr induced heat content 
     276         DO_3D( isi, iei, isj, iej, 1, nksr )          !* now qsr induced heat content 
    277277            zc0 = zz0 * EXP( -gdepw(ji,jj,jk  ,Kmm)*xsi0r ) + zz1 * EXP( -gdepw(ji,jj,jk  ,Kmm)*xsi1r ) 
    278278            zc1 = zz0 * EXP( -gdepw(ji,jj,jk+1,Kmm)*xsi0r ) + zz1 * EXP( -gdepw(ji,jj,jk+1,Kmm)*xsi1r ) 
    … …  
    292292      ! 
    293293      ! sea-ice: store the 1st ocean level attenuation coefficient 
    294       DO_2D( isj, iej, isi, iei ) 
     294      DO_2D( isi, iei, isj, iej ) 
    295295         IF( qsr(ji,jj) /= 0._wp ) THEN   ;   fraqsr_1lev(ji,jj) = qsr_hc(ji,jj,1) / ( r1_rho0_rcp * qsr(ji,jj) ) 
    296296         ELSE                             ;   fraqsr_1lev(ji,jj) = 1._wp 

  • NEMO/trunk/src/OCE/TRA/trasbc.F90

    r14189 r14215  
    105105!!gm  This should be moved into sbcmod.F90 module ? (especially now that ln_traqsr is read in namsbc namelist) 
    106106      IF( .NOT.ln_traqsr ) THEN     ! no solar radiation penetration 
    107          DO_2D( isj, iej, isi, iei ) 
     107         DO_2D( isi, iei, isj, iej ) 
    108108            qns(ji,jj) = qns(ji,jj) + qsr(ji,jj)      ! total heat flux in qns 
    109109            qsr(ji,jj) = 0._wp                        ! qsr set to zero 
    … …  
    126126         ELSE                                             ! No restart or restart not found: Euler forward time stepping 
    127127            zfact = 1._wp 
    128             DO_2D( isj, iej, isi, iei ) 
     128            DO_2D( isi, iei, isj, iej ) 
    129129               sbc_tsc(ji,jj,:) = 0._wp 
    130130               sbc_tsc_b(ji,jj,:) = 0._wp 
    … …  
    133133      ELSE                                !* other time-steps: swap of forcing fields 
    134134         zfact = 0.5_wp 
    135          DO_2D( isj, iej, isi, iei ) 
     135         DO_2D( isi, iei, isj, iej ) 
    136136            sbc_tsc_b(ji,jj,:) = sbc_tsc(ji,jj,:) 
    137137         END_2D 
    138138      ENDIF 
    139139      !                             !==  Now sbc tracer content fields  ==! 
    140       DO_2D( isj, iej, isi, iei ) 
     140      DO_2D( isi, iei, isj, iej ) 
    141141         sbc_tsc(ji,jj,jp_tem) = r1_rho0_rcp * qns(ji,jj)   ! non solar heat flux 
    142142         sbc_tsc(ji,jj,jp_sal) = r1_rho0     * sfx(ji,jj)   ! salt flux due to freezing/melting 
    143143      END_2D 
    144144      IF( ln_linssh ) THEN                !* linear free surface 
    145          DO_2D( isj, iej, isi, iei )                    !==>> add concentration/dilution effect due to constant volume cell 
     145         DO_2D( isi, iei, isj, iej )                    !==>> add concentration/dilution effect due to constant volume cell 
    146146            sbc_tsc(ji,jj,jp_tem) = sbc_tsc(ji,jj,jp_tem) + r1_rho0 * emp(ji,jj) * pts(ji,jj,1,jp_tem,Kmm) 
    147147            sbc_tsc(ji,jj,jp_sal) = sbc_tsc(ji,jj,jp_sal) + r1_rho0 * emp(ji,jj) * pts(ji,jj,1,jp_sal,Kmm) 
Note: See TracChangeset for help on using the changeset viewer.