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/TOP/PISCES/P2Z/p2zexp.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/TOP/PISCES/P2Z/p2zexp.F90

    r12236 r12340  
    3939   !! * Substitutions 
    4040#  include "vectopt_loop_substitute.h90" 
     41#  include "do_loop_substitute.h90" 
    4142   !!---------------------------------------------------------------------- 
    4243   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    8182      ! LAYERS IS DETERMINED BY DMIN3 DEFINED IN sms_p2z.F90 
    8283      ! ---------------------------------------------------------------------- 
    83       DO jk = 1, jpkm1 
    84          DO jj = 2, jpjm1 
    85             DO ji = fs_2, fs_jpim1 
    86                ze3t = 1. / e3t(ji,jj,jk,Kmm) 
    87                tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) + ze3t * dmin3(ji,jj,jk) * xksi(ji,jj) 
    88             END DO 
    89          END DO 
    90       END DO 
     84      DO_3D_00_00( 1, jpkm1 ) 
     85         ze3t = 1. / e3t(ji,jj,jk,Kmm) 
     86         tr(ji,jj,jk,jpno3,Krhs) = tr(ji,jj,jk,jpno3,Krhs) + ze3t * dmin3(ji,jj,jk) * xksi(ji,jj) 
     87      END_3D 
    9188 
    9289      ! Find the last level of the water column 
    … …  
    9693      zgeolpoc = 0.e0         !     Initialization 
    9794      ! Release of nutrients from the "simple" sediment 
    98       DO jj = 2, jpjm1 
    99          DO ji = fs_2, fs_jpim1 
    100             ikt = mbkt(ji,jj)  
    101             tr(ji,jj,ikt,jpno3,Krhs) = tr(ji,jj,ikt,jpno3,Krhs) + sedlam * sedpocn(ji,jj) / e3t(ji,jj,ikt,Kmm)  
    102             ! Deposition of organic matter in the sediment 
    103             zwork = vsed * tr(ji,jj,ikt,jpdet,Kmm) 
    104             zsedpoca(ji,jj) = ( zwork + dminl(ji,jj) * xksi(ji,jj)   & 
    105                &           - sedlam * sedpocn(ji,jj) - sedlostpoc * sedpocn(ji,jj) ) * rdt 
    106             zgeolpoc = zgeolpoc + sedlostpoc * sedpocn(ji,jj) * e1e2t(ji,jj) 
    107          END DO 
    108       END DO 
    109  
    110       DO jj = 2, jpjm1 
    111          DO ji = fs_2, fs_jpim1 
    112             tr(ji,jj,1,jpno3,Krhs) = tr(ji,jj,1,jpno3,Krhs) + zgeolpoc * cmask(ji,jj) / areacot / e3t(ji,jj,1,Kmm) 
    113          END DO 
    114       END DO 
     95      DO_2D_00_00 
     96         ikt = mbkt(ji,jj)  
     97         tr(ji,jj,ikt,jpno3,Krhs) = tr(ji,jj,ikt,jpno3,Krhs) + sedlam * sedpocn(ji,jj) / e3t(ji,jj,ikt,Kmm)  
     98         ! Deposition of organic matter in the sediment 
     99         zwork = vsed * tr(ji,jj,ikt,jpdet,Kmm) 
     100         zsedpoca(ji,jj) = ( zwork + dminl(ji,jj) * xksi(ji,jj)   & 
     101            &           - sedlam * sedpocn(ji,jj) - sedlostpoc * sedpocn(ji,jj) ) * rdt 
     102         zgeolpoc = zgeolpoc + sedlostpoc * sedpocn(ji,jj) * e1e2t(ji,jj) 
     103      END_2D 
     104 
     105      DO_2D_00_00 
     106         tr(ji,jj,1,jpno3,Krhs) = tr(ji,jj,1,jpno3,Krhs) + zgeolpoc * cmask(ji,jj) / areacot / e3t(ji,jj,1,Kmm) 
     107      END_2D 
    115108 
    116109      CALL lbc_lnk( 'p2zexp', sedpocn, 'T', 1. ) 
    … …  
    128121      ELSE 
    129122        ! 
    130         DO jj = 1, jpj 
    131            DO ji = 1, jpi 
    132               zsedpocd = zsedpoca(ji,jj) - 2. * sedpocn(ji,jj) + sedpocb(ji,jj)      ! time laplacian on tracers 
    133               sedpocb(ji,jj) = sedpocn(ji,jj) + atfp * zsedpocd                     ! sedpocb <-- filtered sedpocn 
    134               sedpocn(ji,jj) = zsedpoca(ji,jj)                                       ! sedpocn <-- sedpoca 
    135            END DO 
    136         END DO 
     123        DO_2D_11_11 
     124           zsedpocd = zsedpoca(ji,jj) - 2. * sedpocn(ji,jj) + sedpocb(ji,jj)      ! time laplacian on tracers 
     125           sedpocb(ji,jj) = sedpocn(ji,jj) + atfp * zsedpocd                     ! sedpocb <-- filtered sedpocn 
     126           sedpocn(ji,jj) = zsedpoca(ji,jj)                                       ! sedpocn <-- sedpoca 
     127        END_2D 
    137128        !  
    138129      ENDIF 
    … …  
    183174      zdm0 = 0._wp 
    184175      zrro = 1._wp 
    185       DO jk = jpkb, jpkm1 
    186          DO jj = 1, jpj 
    187             DO ji = 1, jpi 
    188                zfluo = ( gdepw(ji,jj,jk  ,Kmm) / gdepw(ji,jj,jpkb,Kmm) )**xhr 
    189                zfluu = ( gdepw(ji,jj,jk+1,Kmm) / gdepw(ji,jj,jpkb,Kmm) )**xhr 
    190                IF( zfluo.GT.1. )   zfluo = 1._wp 
    191                zdm0(ji,jj,jk) = zfluo - zfluu 
    192                IF( jk <= jpkb-1 )   zdm0(ji,jj,jk) = 0._wp 
    193                zrro(ji,jj) = zrro(ji,jj) - zdm0(ji,jj,jk) 
    194             END DO 
    195          END DO 
    196       END DO 
     176      DO_3D_11_11( jpkb, jpkm1 ) 
     177         zfluo = ( gdepw(ji,jj,jk  ,Kmm) / gdepw(ji,jj,jpkb,Kmm) )**xhr 
     178         zfluu = ( gdepw(ji,jj,jk+1,Kmm) / gdepw(ji,jj,jpkb,Kmm) )**xhr 
     179         IF( zfluo.GT.1. )   zfluo = 1._wp 
     180         zdm0(ji,jj,jk) = zfluo - zfluu 
     181         IF( jk <= jpkb-1 )   zdm0(ji,jj,jk) = 0._wp 
     182         zrro(ji,jj) = zrro(ji,jj) - zdm0(ji,jj,jk) 
     183      END_3D 
    197184      ! 
    198185      zdm0(:,:,jpk) = zrro(:,:) 
    … …  
    204191      dminl(:,:)   = 0._wp 
    205192      dmin3(:,:,:) = zdm0 
    206       DO jk = 1, jpk 
    207          DO jj = 1, jpj 
    208             DO ji = 1, jpi 
    209                IF( tmask(ji,jj,jk) == 0._wp ) THEN 
    210                   dminl(ji,jj) = dminl(ji,jj) + dmin3(ji,jj,jk) 
    211                   dmin3(ji,jj,jk) = 0._wp 
    212                ENDIF 
    213             END DO 
    214          END DO 
    215       END DO 
    216  
    217       DO jj = 1, jpj 
    218          DO ji = 1, jpi 
    219             IF( tmask(ji,jj,1) == 0 )   dmin3(ji,jj,1) = 0._wp 
    220          END DO 
    221       END DO 
     193      DO_3D_11_11( 1, jpk ) 
     194         IF( tmask(ji,jj,jk) == 0._wp ) THEN 
     195            dminl(ji,jj) = dminl(ji,jj) + dmin3(ji,jj,jk) 
     196            dmin3(ji,jj,jk) = 0._wp 
     197         ENDIF 
     198      END_3D 
     199 
     200      DO_2D_11_11 
     201         IF( tmask(ji,jj,1) == 0 )   dmin3(ji,jj,1) = 0._wp 
     202      END_2D 
    222203 
    223204      ! Coastal mask  
    224205      cmask(:,:) = 0._wp 
    225       DO jj = 2, jpjm1 
    226          DO ji = fs_2, fs_jpim1 
    227             IF( tmask(ji,jj,1) /= 0. ) THEN 
    228                zmaskt = tmask(ji+1,jj,1) * tmask(ji-1,jj,1) * tmask(ji,jj+1,1) * tmask(ji,jj-1,1)  
    229                IF( zmaskt == 0. )   cmask(ji,jj) = 1._wp 
    230             END IF 
    231          END DO 
    232       END DO 
     206      DO_2D_00_00 
     207         IF( tmask(ji,jj,1) /= 0. ) THEN 
     208            zmaskt = tmask(ji+1,jj,1) * tmask(ji-1,jj,1) * tmask(ji,jj+1,1) * tmask(ji,jj-1,1)  
     209            IF( zmaskt == 0. )   cmask(ji,jj) = 1._wp 
     210         END IF 
     211      END_2D 
    233212      CALL lbc_lnk( 'p2zexp', cmask , 'T', 1. )      ! lateral boundary conditions on cmask   (sign unchanged) 
    234213      areacot = glob_sum( 'p2zexp', e1e2t(:,:) * cmask(:,:) ) 
Note: See TracChangeset for help on using the changeset viewer.