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/lib_fortran.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/lib_fortran.F90

    r10425 r12340  
    6363#endif 
    6464 
     65   !! * Substitutions 
     66#  include "do_loop_substitute.h90" 
    6567   !!---------------------------------------------------------------------- 
    6668   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    215217      IF( SIZE(p2d,2) /= jpj ) CALL ctl_stop( 'STOP', 'wrong call of sum3x3_2d, the second dimension is not equal to jpj' )  
    216218      ! 
    217       DO jj = 1, jpj 
    218          DO ji = 1, jpi  
     219      DO_2D_11_11 
     220         IF( MOD(mig(ji), 3) == 1 .AND. MOD(mjg(jj), 3) == 1 ) THEN   ! bottom left corber of a 3x3 box 
     221            ji2 = MIN(mig(ji)+2, jpiglo) - nimpp + 1                  ! right position of the box 
     222            jj2 = MIN(mjg(jj)+2, jpjglo) - njmpp + 1                  ! upper position of the box 
     223            IF( ji2 <= jpi .AND. jj2 <= jpj ) THEN                    ! the box is fully included in the local mpi domain 
     224               p2d(ji:ji2,jj:jj2) = SUM(p2d(ji:ji2,jj:jj2)) 
     225            ENDIF 
     226         ENDIF 
     227      END_2D 
     228      CALL lbc_lnk( 'lib_fortran', p2d, 'T', 1. ) 
     229      IF( nbondi /= -1 ) THEN 
     230         IF( MOD(mig(    1), 3) == 1 )   p2d(    1,:) = p2d(    2,:) 
     231         IF( MOD(mig(    1), 3) == 2 )   p2d(    2,:) = p2d(    1,:) 
     232      ENDIF 
     233      IF( nbondi /=  1 ) THEN 
     234         IF( MOD(mig(jpi-2), 3) == 1 )   p2d(  jpi,:) = p2d(jpi-1,:) 
     235         IF( MOD(mig(jpi-2), 3) == 0 )   p2d(jpi-1,:) = p2d(  jpi,:) 
     236      ENDIF 
     237      IF( nbondj /= -1 ) THEN 
     238         IF( MOD(mjg(    1), 3) == 1 )   p2d(:,    1) = p2d(:,    2) 
     239         IF( MOD(mjg(    1), 3) == 2 )   p2d(:,    2) = p2d(:,    1) 
     240      ENDIF 
     241      IF( nbondj /=  1 ) THEN 
     242         IF( MOD(mjg(jpj-2), 3) == 1 )   p2d(:,  jpj) = p2d(:,jpj-1) 
     243         IF( MOD(mjg(jpj-2), 3) == 0 )   p2d(:,jpj-1) = p2d(:,  jpj) 
     244      ENDIF 
     245      CALL lbc_lnk( 'lib_fortran', p2d, 'T', 1. ) 
     246 
     247   END SUBROUTINE sum3x3_2d 
     248 
     249   SUBROUTINE sum3x3_3d( p3d ) 
     250      !!----------------------------------------------------------------------- 
     251      !!                  ***  routine sum3x3_3d  *** 
     252      !! 
     253      !! ** Purpose : sum over 3x3 boxes 
     254      !!---------------------------------------------------------------------- 
     255      REAL(wp), DIMENSION (:,:,:), INTENT(inout) ::   p3d 
     256      ! 
     257      INTEGER ::   ji, ji2, jj, jj2, jn     ! dummy loop indices 
     258      INTEGER ::   ipn                      ! Third dimension size 
     259      !!---------------------------------------------------------------------- 
     260      ! 
     261      IF( SIZE(p3d,1) /= jpi ) CALL ctl_stop( 'STOP', 'wrong call of sum3x3_3d, the first dimension is not equal to jpi' )  
     262      IF( SIZE(p3d,2) /= jpj ) CALL ctl_stop( 'STOP', 'wrong call of sum3x3_3d, the second dimension is not equal to jpj' )  
     263      ipn = SIZE(p3d,3) 
     264      ! 
     265      DO jn = 1, ipn 
     266         DO_2D_11_11 
    219267            IF( MOD(mig(ji), 3) == 1 .AND. MOD(mjg(jj), 3) == 1 ) THEN   ! bottom left corber of a 3x3 box 
    220268               ji2 = MIN(mig(ji)+2, jpiglo) - nimpp + 1                  ! right position of the box 
    221269               jj2 = MIN(mjg(jj)+2, jpjglo) - njmpp + 1                  ! upper position of the box 
    222270               IF( ji2 <= jpi .AND. jj2 <= jpj ) THEN                    ! the box is fully included in the local mpi domain 
    223                   p2d(ji:ji2,jj:jj2) = SUM(p2d(ji:ji2,jj:jj2)) 
     271                  p3d(ji:ji2,jj:jj2,jn) = SUM(p3d(ji:ji2,jj:jj2,jn)) 
    224272               ENDIF 
    225273            ENDIF 
    226          END DO 
    227       END DO 
    228       CALL lbc_lnk( 'lib_fortran', p2d, 'T', 1. ) 
    229       IF( nbondi /= -1 ) THEN 
    230          IF( MOD(mig(    1), 3) == 1 )   p2d(    1,:) = p2d(    2,:) 
    231          IF( MOD(mig(    1), 3) == 2 )   p2d(    2,:) = p2d(    1,:) 
    232       ENDIF 
    233       IF( nbondi /=  1 ) THEN 
    234          IF( MOD(mig(jpi-2), 3) == 1 )   p2d(  jpi,:) = p2d(jpi-1,:) 
    235          IF( MOD(mig(jpi-2), 3) == 0 )   p2d(jpi-1,:) = p2d(  jpi,:) 
    236       ENDIF 
    237       IF( nbondj /= -1 ) THEN 
    238          IF( MOD(mjg(    1), 3) == 1 )   p2d(:,    1) = p2d(:,    2) 
    239          IF( MOD(mjg(    1), 3) == 2 )   p2d(:,    2) = p2d(:,    1) 
    240       ENDIF 
    241       IF( nbondj /=  1 ) THEN 
    242          IF( MOD(mjg(jpj-2), 3) == 1 )   p2d(:,  jpj) = p2d(:,jpj-1) 
    243          IF( MOD(mjg(jpj-2), 3) == 0 )   p2d(:,jpj-1) = p2d(:,  jpj) 
    244       ENDIF 
    245       CALL lbc_lnk( 'lib_fortran', p2d, 'T', 1. ) 
    246  
    247    END SUBROUTINE sum3x3_2d 
    248  
    249    SUBROUTINE sum3x3_3d( p3d ) 
    250       !!----------------------------------------------------------------------- 
    251       !!                  ***  routine sum3x3_3d  *** 
    252       !! 
    253       !! ** Purpose : sum over 3x3 boxes 
    254       !!---------------------------------------------------------------------- 
    255       REAL(wp), DIMENSION (:,:,:), INTENT(inout) ::   p3d 
    256       ! 
    257       INTEGER ::   ji, ji2, jj, jj2, jn     ! dummy loop indices 
    258       INTEGER ::   ipn                      ! Third dimension size 
    259       !!---------------------------------------------------------------------- 
    260       ! 
    261       IF( SIZE(p3d,1) /= jpi ) CALL ctl_stop( 'STOP', 'wrong call of sum3x3_3d, the first dimension is not equal to jpi' )  
    262       IF( SIZE(p3d,2) /= jpj ) CALL ctl_stop( 'STOP', 'wrong call of sum3x3_3d, the second dimension is not equal to jpj' )  
    263       ipn = SIZE(p3d,3) 
    264       ! 
    265       DO jn = 1, ipn 
    266          DO jj = 1, jpj 
    267             DO ji = 1, jpi  
    268                IF( MOD(mig(ji), 3) == 1 .AND. MOD(mjg(jj), 3) == 1 ) THEN   ! bottom left corber of a 3x3 box 
    269                   ji2 = MIN(mig(ji)+2, jpiglo) - nimpp + 1                  ! right position of the box 
    270                   jj2 = MIN(mjg(jj)+2, jpjglo) - njmpp + 1                  ! upper position of the box 
    271                   IF( ji2 <= jpi .AND. jj2 <= jpj ) THEN                    ! the box is fully included in the local mpi domain 
    272                      p3d(ji:ji2,jj:jj2,jn) = SUM(p3d(ji:ji2,jj:jj2,jn)) 
    273                   ENDIF 
    274                ENDIF 
    275             END DO 
    276          END DO 
     274         END_2D 
    277275      END DO 
    278276      CALL lbc_lnk( 'lib_fortran', p3d, 'T', 1. ) 
Note: See TracChangeset for help on using the changeset viewer.