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/DIA/diaptr.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/DIA/diaptr.F90

    r12193 r12340  
    6262   !! * Substitutions 
    6363#  include "vectopt_loop_substitute.h90" 
     64#  include "do_loop_substitute.h90" 
    6465   !!---------------------------------------------------------------------- 
    6566   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    117118            zmask(:,:,:) = 0._wp 
    118119            zts(:,:,:,:) = 0._wp 
    119             DO jk = 1, jpkm1 
    120                DO jj = 1, jpjm1 
    121                   DO ji = 1, jpi 
    122                      zvfc = e1v(ji,jj) * e3v(ji,jj,jk,Kmm) 
    123                      zmask(ji,jj,jk)      = vmask(ji,jj,jk)      * zvfc 
    124                      zts(ji,jj,jk,jp_tem) = (ts(ji,jj,jk,jp_tem,Kmm)+ts(ji,jj+1,jk,jp_tem,Kmm)) * 0.5 * zvfc  !Tracers averaged onto V grid 
    125                      zts(ji,jj,jk,jp_sal) = (ts(ji,jj,jk,jp_sal,Kmm)+ts(ji,jj+1,jk,jp_sal,Kmm)) * 0.5 * zvfc 
    126                   ENDDO 
    127                ENDDO 
    128              ENDDO 
     120            DO_3D_10_11( 1, jpkm1 ) 
     121               zvfc = e1v(ji,jj) * e3v(ji,jj,jk,Kmm) 
     122               zmask(ji,jj,jk)      = vmask(ji,jj,jk)      * zvfc 
     123               zts(ji,jj,jk,jp_tem) = (ts(ji,jj,jk,jp_tem,Kmm)+ts(ji,jj+1,jk,jp_tem,Kmm)) * 0.5 * zvfc  !Tracers averaged onto V grid 
     124               zts(ji,jj,jk,jp_sal) = (ts(ji,jj,jk,jp_sal,Kmm)+ts(ji,jj+1,jk,jp_sal,Kmm)) * 0.5 * zvfc 
     125            END_3D 
    129126         ENDIF 
    130127         IF( iom_use( 'sopstove' ) .OR. iom_use( 'sophtove' ) ) THEN 
    … …  
    192189         zts(:,:,:,:) = 0._wp 
    193190         IF( iom_use( 'zotem' ) .OR. iom_use( 'zosal' ) .OR. iom_use( 'zosrf' )  ) THEN    ! i-mean i-k-surface  
    194             DO jk = 1, jpkm1 
    195                DO jj = 1, jpj 
    196                   DO ji = 1, jpi 
    197                      zsfc = e1t(ji,jj) * e3t(ji,jj,jk,Kmm) 
    198                      zmask(ji,jj,jk)      = tmask(ji,jj,jk)      * zsfc 
    199                      zts(ji,jj,jk,jp_tem) = ts(ji,jj,jk,jp_tem,Kmm) * zsfc 
    200                      zts(ji,jj,jk,jp_sal) = ts(ji,jj,jk,jp_sal,Kmm) * zsfc 
    201                   END DO 
    202                END DO 
    203             END DO 
     191            DO_3D_11_11( 1, jpkm1 ) 
     192               zsfc = e1t(ji,jj) * e3t(ji,jj,jk,Kmm) 
     193               zmask(ji,jj,jk)      = tmask(ji,jj,jk)      * zsfc 
     194               zts(ji,jj,jk,jp_tem) = ts(ji,jj,jk,jp_tem,Kmm) * zsfc 
     195               zts(ji,jj,jk,jp_sal) = ts(ji,jj,jk,jp_sal,Kmm) * zsfc 
     196            END_3D 
    204197            ! 
    205198            DO jn = 1, nptr 
    … …  
    286279         IF( iom_use( 'sopstvtr' ) .OR. iom_use( 'sophtvtr' ) ) THEN 
    287280            zts(:,:,:,:) = 0._wp 
    288             DO jk = 1, jpkm1 
    289                DO jj = 1, jpjm1 
    290                   DO ji = 1, jpi 
    291                      zvfc = e1v(ji,jj) * e3v(ji,jj,jk,Kmm) 
    292                      zts(ji,jj,jk,jp_tem) = (ts(ji,jj,jk,jp_tem,Kmm)+ts(ji,jj+1,jk,jp_tem,Kmm)) * 0.5 * zvfc  !Tracers averaged onto V grid 
    293                      zts(ji,jj,jk,jp_sal) = (ts(ji,jj,jk,jp_sal,Kmm)+ts(ji,jj+1,jk,jp_sal,Kmm)) * 0.5 * zvfc 
    294                   ENDDO 
    295                ENDDO 
    296              ENDDO 
     281            DO_3D_10_11( 1, jpkm1 ) 
     282               zvfc = e1v(ji,jj) * e3v(ji,jj,jk,Kmm) 
     283               zts(ji,jj,jk,jp_tem) = (ts(ji,jj,jk,jp_tem,Kmm)+ts(ji,jj+1,jk,jp_tem,Kmm)) * 0.5 * zvfc  !Tracers averaged onto V grid 
     284               zts(ji,jj,jk,jp_sal) = (ts(ji,jj,jk,jp_sal,Kmm)+ts(ji,jj+1,jk,jp_sal,Kmm)) * 0.5 * zvfc 
     285            END_3D 
    297286             CALL dia_ptr_hst( jp_tem, 'vtr', zts(:,:,:,jp_tem) ) 
    298287             CALL dia_ptr_hst( jp_sal, 'vtr', zts(:,:,:,jp_sal) ) 
    … …  
    515504      ijpj = jpj 
    516505      p_fval(:) = 0._wp 
    517       DO jk = 1, jpkm1 
    518          DO jj = 2, jpjm1 
    519             DO ji = fs_2, fs_jpim1   ! Vector opt. 
    520                p_fval(jj) = p_fval(jj) + pvflx(ji,jj,jk) * pmsk(ji,jj) * tmask_i(ji,jj) 
    521             END DO 
    522          END DO 
    523       END DO 
     506      DO_3D_00_00( 1, jpkm1 ) 
     507         p_fval(jj) = p_fval(jj) + pvflx(ji,jj,jk) * pmsk(ji,jj) * tmask_i(ji,jj) 
     508      END_3D 
    524509#if defined key_mpp_mpi 
    525510      CALL mpp_sum( 'diaptr', p_fval, ijpj, ncomm_znl) 
    … …  
    552537      ijpj = jpj 
    553538      p_fval(:) = 0._wp 
    554       DO jj = 2, jpjm1 
    555          DO ji = fs_2, fs_jpim1   ! Vector opt. 
    556             p_fval(jj) = p_fval(jj) + pvflx(ji,jj) * pmsk(ji,jj) * tmask_i(ji,jj) 
    557          END DO 
    558       END DO 
     539      DO_2D_00_00 
     540         p_fval(jj) = p_fval(jj) + pvflx(ji,jj) * pmsk(ji,jj) * tmask_i(ji,jj) 
     541      END_2D 
    559542#if defined key_mpp_mpi 
    560543      CALL mpp_sum( 'diaptr', p_fval, ijpj, ncomm_znl ) 
    … …  
    583566      p_fval(:,:) = 0._wp 
    584567      DO jc = 1, jpnj ! looping over all processors in j axis 
    585          DO jj = 2, jpjm1 
    586             DO ji = fs_2, fs_jpim1   ! Vector opt. 
    587                p_fval(ji,jj) = p_fval(ji,jj-1) + pva(ji,jj) * tmask_i(ji,jj) 
    588             END DO 
    589          END DO 
     568         DO_2D_00_00 
     569            p_fval(ji,jj) = p_fval(ji,jj-1) + pva(ji,jj) * tmask_i(ji,jj) 
     570         END_2D 
    590571         CALL lbc_lnk( 'diaptr', p_fval, 'U', -1. ) 
    591572      END DO 
    … …  
    624605      p_fval(:,:) = 0._wp 
    625606      ! 
    626       DO jk = 1, jpkm1 
    627          DO jj = 2, jpjm1 
    628             DO ji = fs_2, fs_jpim1   ! Vector opt. 
    629                p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) * pmsk(ji,jj) * tmask_i(ji,jj) 
    630             END DO 
    631          END DO 
    632       END DO 
     607      DO_3D_00_00( 1, jpkm1 ) 
     608         p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) * pmsk(ji,jj) * tmask_i(ji,jj) 
     609      END_3D 
    633610      ! 
    634611#if defined key_mpp_mpi 
Note: See TracChangeset for help on using the changeset viewer.