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 12340 for NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/TRA/traqsr.F90 – NEMO

Ignore:
Timestamp:
2020-01-27T15:31:53+01:00 (4 years ago)
Author:
acc
Message:

Branch 2019/dev_r11943_MERGE_2019. This commit introduces basic do loop macro
substitution to the 2019 option 1, merge branch. These changes have been SETTE
tested. The only addition is the do_loop_substitute.h90 file in the OCE directory but
the macros defined therein are used throughout the code to replace identifiable, 2D-
and 3D- nested loop opening and closing statements with single-line alternatives. Code
indents are also adjusted accordingly.

The following explanation is taken from comments in the new header file:

This header file contains preprocessor definitions and macros used in the do-loop
substitutions introduced between version 4.0 and 4.2. The primary aim of these macros
is to assist in future applications of tiling to improve performance. This is expected
to be achieved by alternative versions of these macros in selected locations. The
initial introduction of these macros simply replaces all identifiable nested 2D- and
3D-loops with single line statements (and adjusts indenting accordingly). Do loops
are identifiable if they comform to either:

DO jk = ....

DO jj = .... DO jj = ...

DO ji = .... DO ji = ...
. OR .
. .

END DO END DO

END DO END DO

END DO

and white-space variants thereof.

Additionally, only loops with recognised jj and ji loops limits are treated; these are:
Lower limits of 1, 2 or fs_2
Upper limits of jpi, jpim1 or fs_jpim1 (for ji) or jpj, jpjm1 or fs_jpjm1 (for jj)

The macro naming convention takes the form: DO_2D_BT_LR where:

B is the Bottom offset from the PE's inner domain;
T is the Top offset from the PE's inner domain;
L is the Left offset from the PE's inner domain;
R is the Right offset from the PE's inner domain

So, given an inner domain of 2,jpim1 and 2,jpjm1, a typical example would replace:

DO jj = 2, jpj

DO ji = 1, jpim1
.
.

END DO

END DO

with:

DO_2D_01_10
.
.
END_2D

similar conventions apply to the 3D loops macros. jk loop limits are retained
through macro arguments and are not restricted. This includes the possibility of
strides for which an extra set of DO_3DS macros are defined.

In the example definition below the inner PE domain is defined by start indices of
(kIs, kJs) and end indices of (kIe, KJe)

#define DO_2D_00_00 DO jj = kJs, kJe ; DO ji = kIs, kIe
#define END_2D END DO ; END DO

TO DO:

Only conventional nested loops have been identified and replaced by this step. There are constructs such as:

DO jk = 2, jpkm1

z2d(:,:) = z2d(:,:) + e3w(:,:,jk,Kmm) * z3d(:,:,jk) * wmask(:,:,jk)

END DO

which may need to be considered.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/TRA/traqsr.F90

    r12236 r12340  
    6868   !! * Substitutions 
    6969#  include "vectopt_loop_substitute.h90" 
     70#  include "do_loop_substitute.h90" 
    7071   !!---------------------------------------------------------------------- 
    7172   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    197198         ! 
    198199         zcoef  = ( 1. - rn_abs ) / 3._wp    !* surface equi-partition in R-G-B 
    199          DO jj = 2, jpjm1 
    200             DO ji = fs_2, fs_jpim1 
    201                ze0(ji,jj,1) = rn_abs * qsr(ji,jj) 
    202                ze1(ji,jj,1) = zcoef  * qsr(ji,jj) 
    203                ze2(ji,jj,1) = zcoef  * qsr(ji,jj) 
    204                ze3(ji,jj,1) = zcoef  * qsr(ji,jj) 
    205                zea(ji,jj,1) =          qsr(ji,jj) 
    206             END DO 
     200         DO_2D_00_00 
     201            ze0(ji,jj,1) = rn_abs * qsr(ji,jj) 
     202            ze1(ji,jj,1) = zcoef  * qsr(ji,jj) 
     203            ze2(ji,jj,1) = zcoef  * qsr(ji,jj) 
     204            ze3(ji,jj,1) = zcoef  * qsr(ji,jj) 
     205            zea(ji,jj,1) =          qsr(ji,jj) 
     206         END_2D 
     207         ! 
     208         DO jk = 2, nksr+1                   !* interior equi-partition in R-G-B depending of vertical profile of Chl 
     209            DO_2D_00_00 
     210               zchl = MIN( 10. , MAX( 0.03, zchl3d(ji,jj,jk) ) ) 
     211               irgb = NINT( 41 + 20.*LOG10(zchl) + 1.e-15 ) 
     212               zekb(ji,jj) = rkrgb(1,irgb) 
     213               zekg(ji,jj) = rkrgb(2,irgb) 
     214               zekr(ji,jj) = rkrgb(3,irgb) 
     215            END_2D 
     216 
     217            DO_2D_00_00 
     218               zc0 = ze0(ji,jj,jk-1) * EXP( - e3t(ji,jj,jk-1,Kmm) * xsi0r       ) 
     219               zc1 = ze1(ji,jj,jk-1) * EXP( - e3t(ji,jj,jk-1,Kmm) * zekb(ji,jj) ) 
     220               zc2 = ze2(ji,jj,jk-1) * EXP( - e3t(ji,jj,jk-1,Kmm) * zekg(ji,jj) ) 
     221               zc3 = ze3(ji,jj,jk-1) * EXP( - e3t(ji,jj,jk-1,Kmm) * zekr(ji,jj) ) 
     222               ze0(ji,jj,jk) = zc0 
     223               ze1(ji,jj,jk) = zc1 
     224               ze2(ji,jj,jk) = zc2 
     225               ze3(ji,jj,jk) = zc3 
     226               zea(ji,jj,jk) = ( zc0 + zc1 + zc2 + zc3 ) * wmask(ji,jj,jk) 
     227            END_2D 
    207228         END DO 
    208229         ! 
    209          DO jk = 2, nksr+1                   !* interior equi-partition in R-G-B depending of vertical profile of Chl 
    210             DO jj = 2, jpjm1 
    211                DO ji = fs_2, fs_jpim1 
    212                   zchl = MIN( 10. , MAX( 0.03, zchl3d(ji,jj,jk) ) ) 
    213                   irgb = NINT( 41 + 20.*LOG10(zchl) + 1.e-15 ) 
    214                   zekb(ji,jj) = rkrgb(1,irgb) 
    215                   zekg(ji,jj) = rkrgb(2,irgb) 
    216                   zekr(ji,jj) = rkrgb(3,irgb) 
    217                END DO 
    218             END DO 
    219  
    220             DO jj = 2, jpjm1 
    221                DO ji = fs_2, fs_jpim1 
    222                   zc0 = ze0(ji,jj,jk-1) * EXP( - e3t(ji,jj,jk-1,Kmm) * xsi0r       ) 
    223                   zc1 = ze1(ji,jj,jk-1) * EXP( - e3t(ji,jj,jk-1,Kmm) * zekb(ji,jj) ) 
    224                   zc2 = ze2(ji,jj,jk-1) * EXP( - e3t(ji,jj,jk-1,Kmm) * zekg(ji,jj) ) 
    225                   zc3 = ze3(ji,jj,jk-1) * EXP( - e3t(ji,jj,jk-1,Kmm) * zekr(ji,jj) ) 
    226                   ze0(ji,jj,jk) = zc0 
    227                   ze1(ji,jj,jk) = zc1 
    228                   ze2(ji,jj,jk) = zc2 
    229                   ze3(ji,jj,jk) = zc3 
    230                   zea(ji,jj,jk) = ( zc0 + zc1 + zc2 + zc3 ) * wmask(ji,jj,jk) 
    231                END DO 
    232             END DO 
    233          END DO 
    234          ! 
    235          DO jk = 1, nksr                     !* now qsr induced heat content 
    236             DO jj = 2, jpjm1 
    237                DO ji = fs_2, fs_jpim1 
    238                   qsr_hc(ji,jj,jk) = r1_rau0_rcp * ( zea(ji,jj,jk) - zea(ji,jj,jk+1) ) 
    239                END DO 
    240             END DO 
    241          END DO 
     230         DO_3D_00_00( 1, nksr ) 
     231            qsr_hc(ji,jj,jk) = r1_rau0_rcp * ( zea(ji,jj,jk) - zea(ji,jj,jk+1) ) 
     232         END_3D 
    242233         ! 
    243234         DEALLOCATE( zekb , zekg , zekr , ze0 , ze1 , ze2 , ze3 , zea , zchl3d )  
    … …  
    247238         zz0 =        rn_abs   * r1_rau0_rcp      ! surface equi-partition in 2-bands 
    248239         zz1 = ( 1. - rn_abs ) * r1_rau0_rcp 
    249          DO jk = 1, nksr                          ! solar heat absorbed at T-point in the top 400m  
    250             DO jj = 2, jpjm1 
    251                DO ji = fs_2, fs_jpim1 
    252                   zc0 = zz0 * EXP( -gdepw(ji,jj,jk  ,Kmm)*xsi0r ) + zz1 * EXP( -gdepw(ji,jj,jk  ,Kmm)*xsi1r ) 
    253                   zc1 = zz0 * EXP( -gdepw(ji,jj,jk+1,Kmm)*xsi0r ) + zz1 * EXP( -gdepw(ji,jj,jk+1,Kmm)*xsi1r ) 
    254                   qsr_hc(ji,jj,jk) = qsr(ji,jj) * ( zc0 * wmask(ji,jj,jk) - zc1 * wmask(ji,jj,jk+1) )  
    255                END DO 
    256             END DO 
    257          END DO 
     240         DO_3D_00_00( 1, nksr ) 
     241            zc0 = zz0 * EXP( -gdepw(ji,jj,jk  ,Kmm)*xsi0r ) + zz1 * EXP( -gdepw(ji,jj,jk  ,Kmm)*xsi1r ) 
     242            zc1 = zz0 * EXP( -gdepw(ji,jj,jk+1,Kmm)*xsi0r ) + zz1 * EXP( -gdepw(ji,jj,jk+1,Kmm)*xsi1r ) 
     243            qsr_hc(ji,jj,jk) = qsr(ji,jj) * ( zc0 * wmask(ji,jj,jk) - zc1 * wmask(ji,jj,jk+1) )  
     244         END_3D 
    258245         ! 
    259246      END SELECT 
    260247      ! 
    261248      !                          !-----------------------------! 
    262       DO jk = 1, nksr            !  update to the temp. trend  ! 
    263          DO jj = 2, jpjm1        !-----------------------------! 
    264             DO ji = fs_2, fs_jpim1   ! vector opt. 
    265                pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs)   & 
    266                   &                      + z1_2 * ( qsr_hc_b(ji,jj,jk) + qsr_hc(ji,jj,jk) ) / e3t(ji,jj,jk,Kmm) 
    267             END DO 
    268          END DO 
    269       END DO 
     249      DO_3D_00_00( 1, nksr ) 
     250         pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs)   & 
     251            &                      + z1_2 * ( qsr_hc_b(ji,jj,jk) + qsr_hc(ji,jj,jk) ) / e3t(ji,jj,jk,Kmm) 
     252      END_3D 
    270253      ! 
    271254      ! sea-ice: store the 1st ocean level attenuation coefficient 
    272       DO jj = 2, jpjm1  
    273          DO ji = fs_2, fs_jpim1   ! vector opt. 
    274             IF( qsr(ji,jj) /= 0._wp ) THEN   ;   fraqsr_1lev(ji,jj) = qsr_hc(ji,jj,1) / ( r1_rau0_rcp * qsr(ji,jj) ) 
    275             ELSE                             ;   fraqsr_1lev(ji,jj) = 1._wp 
    276             ENDIF 
    277          END DO 
    278       END DO 
     255      DO_2D_00_00 
     256         IF( qsr(ji,jj) /= 0._wp ) THEN   ;   fraqsr_1lev(ji,jj) = qsr_hc(ji,jj,1) / ( r1_rau0_rcp * qsr(ji,jj) ) 
     257         ELSE                             ;   fraqsr_1lev(ji,jj) = 1._wp 
     258         ENDIF 
     259      END_2D 
    279260      CALL lbc_lnk( 'traqsr', fraqsr_1lev(:,:), 'T', 1._wp ) 
    280261      ! 
Note: See TracChangeset for help on using the changeset viewer.