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/TRD/trdglo.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/TRD/trdglo.F90

    r11949 r12340  
    5252   !! * Substitutions 
    5353#  include "vectopt_loop_substitute.h90" 
     54#  include "do_loop_substitute.h90" 
    5455   !!---------------------------------------------------------------------- 
    5556   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    8586         ! 
    8687         CASE( 'TRA' )          !==  Tracers (T & S)  ==! 
    87             DO jk = 1, jpkm1       ! global sum of mask volume trend and trend*T (including interior mask) 
    88                DO jj = 1, jpj 
    89                   DO ji = 1, jpi         
    90                      zvm = e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
    91                      zvt = ptrdx(ji,jj,jk) * zvm 
    92                      zvs = ptrdy(ji,jj,jk) * zvm 
    93                      tmo(ktrd) = tmo(ktrd) + zvt    
    94                      smo(ktrd) = smo(ktrd) + zvs 
    95                      t2 (ktrd) = t2(ktrd)  + zvt * ts(ji,jj,jk,jp_tem,Kmm) 
    96                      s2 (ktrd) = s2(ktrd)  + zvs * ts(ji,jj,jk,jp_sal,Kmm) 
    97                   END DO 
    98                END DO 
    99             END DO 
     88            DO_3D_11_11( 1, jpkm1 ) 
     89               zvm = e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
     90               zvt = ptrdx(ji,jj,jk) * zvm 
     91               zvs = ptrdy(ji,jj,jk) * zvm 
     92               tmo(ktrd) = tmo(ktrd) + zvt    
     93               smo(ktrd) = smo(ktrd) + zvs 
     94               t2 (ktrd) = t2(ktrd)  + zvt * ts(ji,jj,jk,jp_tem,Kmm) 
     95               s2 (ktrd) = s2(ktrd)  + zvs * ts(ji,jj,jk,jp_sal,Kmm) 
     96            END_3D 
    10097            !                       ! linear free surface: diagnose advective flux trough the fixed k=1 w-surface 
    10198            IF( ln_linssh .AND. ktrd == jptra_zad ) THEN   
    … …  
    118115            ! 
    119116         CASE( 'DYN' )          !==  Momentum and KE  ==!         
    120             DO jk = 1, jpkm1 
    121                DO jj = 1, jpjm1 
    122                   DO ji = 1, jpim1 
    123                      zvt = ptrdx(ji,jj,jk) * tmask_i(ji+1,jj) * tmask_i(ji,jj) * umask(ji,jj,jk)   & 
    124                         &                                     * e1e2u  (ji,jj) * e3u(ji,jj,jk,Kmm) 
    125                      zvs = ptrdy(ji,jj,jk) * tmask_i(ji,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)   & 
    126                         &                                     * e1e2v  (ji,jj) * e3u(ji,jj,jk,Kmm) 
    127                      umo(ktrd) = umo(ktrd) + zvt 
    128                      vmo(ktrd) = vmo(ktrd) + zvs 
    129                      hke(ktrd) = hke(ktrd) + uu(ji,jj,jk,Kmm) * zvt + vv(ji,jj,jk,Kmm) * zvs 
    130                   END DO 
    131                END DO 
    132             END DO 
     117            DO_3D_10_10( 1, jpkm1 ) 
     118               zvt = ptrdx(ji,jj,jk) * tmask_i(ji+1,jj) * tmask_i(ji,jj) * umask(ji,jj,jk)   & 
     119                  &                                     * e1e2u  (ji,jj) * e3u(ji,jj,jk,Kmm) 
     120               zvs = ptrdy(ji,jj,jk) * tmask_i(ji,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)   & 
     121                  &                                     * e1e2v  (ji,jj) * e3u(ji,jj,jk,Kmm) 
     122               umo(ktrd) = umo(ktrd) + zvt 
     123               vmo(ktrd) = vmo(ktrd) + zvs 
     124               hke(ktrd) = hke(ktrd) + uu(ji,jj,jk,Kmm) * zvt + vv(ji,jj,jk,Kmm) * zvs 
     125            END_3D 
    133126            !                  
    134127            IF( ktrd == jpdyn_zdf ) THEN      ! zdf trend: compute separately the surface forcing trend 
    135128               z1_2rau0 = 0.5_wp / rau0 
    136                DO jj = 1, jpjm1 
    137                   DO ji = 1, jpim1 
    138                      zvt = ( utau_b(ji,jj) + utau(ji,jj) ) * tmask_i(ji+1,jj) * tmask_i(ji,jj) * umask(ji,jj,jk)   & 
    139                         &                                                     * z1_2rau0       * e1e2u(ji,jj) 
    140                      zvs = ( vtau_b(ji,jj) + vtau(ji,jj) ) * tmask_i(ji,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)   & 
    141                         &                                                     * z1_2rau0       * e1e2v(ji,jj) 
    142                      umo(jpdyn_tau) = umo(jpdyn_tau) + zvt 
    143                      vmo(jpdyn_tau) = vmo(jpdyn_tau) + zvs 
    144                      hke(jpdyn_tau) = hke(jpdyn_tau) + uu(ji,jj,1,Kmm) * zvt + vv(ji,jj,1,Kmm) * zvs 
    145                   END DO 
    146                END DO 
     129               DO_2D_10_10 
     130                  zvt = ( utau_b(ji,jj) + utau(ji,jj) ) * tmask_i(ji+1,jj) * tmask_i(ji,jj) * umask(ji,jj,jk)   & 
     131                     &                                                     * z1_2rau0       * e1e2u(ji,jj) 
     132                  zvs = ( vtau_b(ji,jj) + vtau(ji,jj) ) * tmask_i(ji,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)   & 
     133                     &                                                     * z1_2rau0       * e1e2v(ji,jj) 
     134                  umo(jpdyn_tau) = umo(jpdyn_tau) + zvt 
     135                  vmo(jpdyn_tau) = vmo(jpdyn_tau) + zvs 
     136                  hke(jpdyn_tau) = hke(jpdyn_tau) + uu(ji,jj,1,Kmm) * zvt + vv(ji,jj,1,Kmm) * zvs 
     137               END_2D 
    147138            ENDIF 
    148139            !                        
    … …  
    220211          
    221212         zcof   = 0.5_wp / rau0           ! Density flux at u and v-points 
    222          DO jk = 1, jpkm1 
    223             DO jj = 1, jpjm1 
    224                DO ji = 1, jpim1 
    225                   zkx(ji,jj,jk) = zcof * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) * ( rhop(ji,jj,jk) + rhop(ji+1,jj,jk) ) 
    226                   zky(ji,jj,jk) = zcof * e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) * ( rhop(ji,jj,jk) + rhop(ji,jj+1,jk) ) 
    227                END DO 
    228             END DO 
    229          END DO 
     213         DO_3D_10_10( 1, jpkm1 ) 
     214            zkx(ji,jj,jk) = zcof * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) * ( rhop(ji,jj,jk) + rhop(ji+1,jj,jk) ) 
     215            zky(ji,jj,jk) = zcof * e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) * ( rhop(ji,jj,jk) + rhop(ji,jj+1,jk) ) 
     216         END_3D 
    230217          
    231          DO jk = 1, jpkm1                 ! Density flux divergence at t-point 
    232             DO jj = 2, jpjm1 
    233                DO ji = 2, jpim1 
    234                   zkepe(ji,jj,jk) = - (  zkz(ji,jj,jk) - zkz(ji  ,jj  ,jk+1)               & 
    235                      &                 + zkx(ji,jj,jk) - zkx(ji-1,jj  ,jk  )               & 
    236                      &                 + zky(ji,jj,jk) - zky(ji  ,jj-1,jk  )   )           & 
    237                      &              / ( e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) ) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
    238                END DO 
    239             END DO 
    240          END DO 
     218         DO_3D_00_00( 1, jpkm1 ) 
     219            zkepe(ji,jj,jk) = - (  zkz(ji,jj,jk) - zkz(ji  ,jj  ,jk+1)               & 
     220               &                 + zkx(ji,jj,jk) - zkx(ji-1,jj  ,jk  )               & 
     221               &                 + zky(ji,jj,jk) - zky(ji  ,jj-1,jk  )   )           & 
     222               &              / ( e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) ) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
     223         END_3D 
    241224 
    242225         ! I.2 Basin averaged kinetic energy trend 
    … …  
    541524      tvolv = 0._wp 
    542525 
    543       DO jk = 1, jpk 
    544          DO jj = 2, jpjm1 
    545             DO ji = fs_2, fs_jpim1   ! vector opt. 
    546                tvolu = tvolu + e1u(ji,jj) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,jk) 
    547                tvolv = tvolv + e1v(ji,jj) * e2v(ji,jj) * e3v(ji,jj,jk,Kmm) * tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) 
    548             END DO 
    549          END DO 
    550       END DO 
     526      DO_3D_00_00( 1, jpk ) 
     527         tvolu = tvolu + e1u(ji,jj) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,jk) 
     528         tvolv = tvolv + e1v(ji,jj) * e2v(ji,jj) * e3v(ji,jj,jk,Kmm) * tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) 
     529      END_3D 
    551530      CALL mpp_sum( 'trdglo', tvolu )   ! sums over the global domain 
    552531      CALL mpp_sum( 'trdglo', tvolv ) 
Note: See TracChangeset for help on using the changeset viewer.