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/SBC/sbcdcy.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/SBC/sbcdcy.F90

    r12182 r12340  
    3737   PUBLIC   sbc_dcy_param  ! routine used here and called by warm-layer parameterization (sbcblk_skin_coare*) 
    3838 
     39   !! * Substitutions 
     40#  include "do_loop_substitute.h90" 
    3941   !!---------------------------------------------------------------------- 
    4042   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    108110 
    109111      imask_night(:,:) = 0 
    110       DO jj = 1, jpj 
    111          DO ji = 1, jpi 
    112             ztmpm = 0._wp 
    113             IF( ABS(rab(ji,jj)) < 1. ) THEN         ! day duration is less than 24h 
     112      DO_2D_11_11 
     113         ztmpm = 0._wp 
     114         IF( ABS(rab(ji,jj)) < 1. ) THEN         ! day duration is less than 24h 
     115            ! 
     116            IF( rdawn_dcy(ji,jj) < rdusk_dcy(ji,jj) ) THEN       ! day time in one part 
     117               zlousd = MAX(zlo, rdawn_dcy(ji,jj)) 
     118               zlousd = MIN(zlousd, zup) 
     119               zupusd = MIN(zup, rdusk_dcy(ji,jj)) 
     120               zupusd = MAX(zupusd, zlo) 
     121               ztmp = fintegral(zlousd, zupusd, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
     122               zqsrout(ji,jj) = pqsrin(ji,jj) * ztmp * rscal(ji,jj) 
     123               ztmpm = zupusd - zlousd 
     124               IF( ztmpm .EQ. 0 ) imask_night(ji,jj) = 1 
    114125               ! 
    115                IF( rdawn_dcy(ji,jj) < rdusk_dcy(ji,jj) ) THEN       ! day time in one part 
    116                   zlousd = MAX(zlo, rdawn_dcy(ji,jj)) 
    117                   zlousd = MIN(zlousd, zup) 
    118                   zupusd = MIN(zup, rdusk_dcy(ji,jj)) 
    119                   zupusd = MAX(zupusd, zlo) 
    120                   ztmp = fintegral(zlousd, zupusd, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
    121                   zqsrout(ji,jj) = pqsrin(ji,jj) * ztmp * rscal(ji,jj) 
    122                   ztmpm = zupusd - zlousd 
    123                   IF( ztmpm .EQ. 0 ) imask_night(ji,jj) = 1 
    124                   ! 
    125                ELSE                                         ! day time in two parts 
    126                   zlousd = MIN(zlo, rdusk_dcy(ji,jj)) 
    127                   zupusd = MIN(zup, rdusk_dcy(ji,jj)) 
    128                   ztmp1 = fintegral(zlousd, zupusd, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
    129                   ztmpm1=zupusd-zlousd 
    130                   zlousd = MAX(zlo, rdawn_dcy(ji,jj)) 
    131                   zupusd = MAX(zup, rdawn_dcy(ji,jj)) 
    132                   ztmp2 = fintegral(zlousd, zupusd, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
    133                   ztmpm2 =zupusd-zlousd 
    134                   ztmp = ztmp1 + ztmp2 
    135                   ztmpm = ztmpm1 + ztmpm2 
    136                   zqsrout(ji,jj) = pqsrin(ji,jj) * ztmp * rscal(ji,jj) 
    137                   IF(ztmpm .EQ. 0.) imask_night(ji,jj) = 1 
    138                ENDIF 
    139             ELSE                                   ! 24h light or 24h night 
     126            ELSE                                         ! day time in two parts 
     127               zlousd = MIN(zlo, rdusk_dcy(ji,jj)) 
     128               zupusd = MIN(zup, rdusk_dcy(ji,jj)) 
     129               ztmp1 = fintegral(zlousd, zupusd, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
     130               ztmpm1=zupusd-zlousd 
     131               zlousd = MAX(zlo, rdawn_dcy(ji,jj)) 
     132               zupusd = MAX(zup, rdawn_dcy(ji,jj)) 
     133               ztmp2 = fintegral(zlousd, zupusd, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
     134               ztmpm2 =zupusd-zlousd 
     135               ztmp = ztmp1 + ztmp2 
     136               ztmpm = ztmpm1 + ztmpm2 
     137               zqsrout(ji,jj) = pqsrin(ji,jj) * ztmp * rscal(ji,jj) 
     138               IF(ztmpm .EQ. 0.) imask_night(ji,jj) = 1 
     139            ENDIF 
     140         ELSE                                   ! 24h light or 24h night 
     141            ! 
     142            IF( raa(ji,jj) > rbb(ji,jj) ) THEN           ! 24h day 
     143               ztmp = fintegral(zlo, zup, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
     144               zqsrout(ji,jj) = pqsrin(ji,jj) * ztmp * rscal(ji,jj) 
     145               imask_night(ji,jj) = 0 
    140146               ! 
    141                IF( raa(ji,jj) > rbb(ji,jj) ) THEN           ! 24h day 
    142                   ztmp = fintegral(zlo, zup, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
    143                   zqsrout(ji,jj) = pqsrin(ji,jj) * ztmp * rscal(ji,jj) 
    144                   imask_night(ji,jj) = 0 
    145                   ! 
    146                ELSE                                         ! No day 
    147                   zqsrout(ji,jj) = 0.0_wp 
    148                   imask_night(ji,jj) = 1 
    149                ENDIF 
    150             ENDIF 
    151          END DO 
    152       END DO 
     147            ELSE                                         ! No day 
     148               zqsrout(ji,jj) = 0.0_wp 
     149               imask_night(ji,jj) = 1 
     150            ENDIF 
     151         ENDIF 
     152      END_2D 
    153153      ! 
    154154      IF( PRESENT(l_mask) .AND. l_mask ) THEN 
    … …  
    193193 
    194194         zsin = SIN( zdecrad )   ;   zcos = COS( zdecrad ) 
    195          DO jj = 1, jpj 
    196             DO ji = 1, jpi 
    197                ztmp = rad * gphit(ji,jj) 
    198                raa(ji,jj) = SIN( ztmp ) * zsin 
    199                rbb(ji,jj) = COS( ztmp ) * zcos 
    200             END DO 
    201          END DO 
     195         DO_2D_11_11 
     196            ztmp = rad * gphit(ji,jj) 
     197            raa(ji,jj) = SIN( ztmp ) * zsin 
     198            rbb(ji,jj) = COS( ztmp ) * zcos 
     199         END_2D 
    202200         ! Compute the time of dawn and dusk 
    203201 
    204202         ! rab to test if the day time is equal to 0, less than 24h of full day 
    205203         rab(:,:) = -raa(:,:) / rbb(:,:) 
    206          DO jj = 1, jpj 
    207             DO ji = 1, jpi 
    208                IF( ABS(rab(ji,jj)) < 1._wp ) THEN         ! day duration is less than 24h 
    209                   ! When is it night? 
    210                   ztx = 1._wp/(2._wp*rpi) * (ACOS(rab(ji,jj)) - rcc(ji,jj)) 
    211                   ztest = -rbb(ji,jj) * SIN( rcc(ji,jj) + 2._wp*rpi * ztx ) 
    212                   ! is it dawn or dusk? 
    213                   IF( ztest > 0._wp ) THEN 
    214                      rdawn_dcy(ji,jj) = ztx 
    215                      rdusk_dcy(ji,jj) = rtmd(ji,jj) + ( rtmd(ji,jj) - rdawn_dcy(ji,jj) ) 
    216                   ELSE 
    217                      rdusk_dcy(ji,jj) = ztx 
    218                      rdawn_dcy(ji,jj) = rtmd(ji,jj) - ( rdusk_dcy(ji,jj) - rtmd(ji,jj) ) 
    219                   ENDIF 
     204         DO_2D_11_11 
     205            IF( ABS(rab(ji,jj)) < 1._wp ) THEN         ! day duration is less than 24h 
     206               ! When is it night? 
     207               ztx = 1._wp/(2._wp*rpi) * (ACOS(rab(ji,jj)) - rcc(ji,jj)) 
     208               ztest = -rbb(ji,jj) * SIN( rcc(ji,jj) + 2._wp*rpi * ztx ) 
     209               ! is it dawn or dusk? 
     210               IF( ztest > 0._wp ) THEN 
     211                  rdawn_dcy(ji,jj) = ztx 
     212                  rdusk_dcy(ji,jj) = rtmd(ji,jj) + ( rtmd(ji,jj) - rdawn_dcy(ji,jj) ) 
    220213               ELSE 
    221                   rdawn_dcy(ji,jj) = rtmd(ji,jj) + 0.5_wp 
    222                   rdusk_dcy(ji,jj) = rdawn_dcy(ji,jj) 
     214                  rdusk_dcy(ji,jj) = ztx 
     215                  rdawn_dcy(ji,jj) = rtmd(ji,jj) - ( rdusk_dcy(ji,jj) - rtmd(ji,jj) ) 
    223216               ENDIF 
    224             END DO 
    225          END DO 
     217            ELSE 
     218               rdawn_dcy(ji,jj) = rtmd(ji,jj) + 0.5_wp 
     219               rdusk_dcy(ji,jj) = rdawn_dcy(ji,jj) 
     220            ENDIF 
     221         END_2D 
    226222         rdawn_dcy(:,:) = MOD( (rdawn_dcy(:,:) + 1._wp), 1._wp ) 
    227223         rdusk_dcy(:,:) = MOD( (rdusk_dcy(:,:) + 1._wp), 1._wp ) 
    … …  
    230226         !         Avoid possible infinite scaling factor, associated with very short daylight 
    231227         !         periods, by ignoring periods less than 1/1000th of a day (ticket #1040) 
    232          DO jj = 1, jpj 
    233             DO ji = 1, jpi 
    234                IF( ABS(rab(ji,jj)) < 1._wp ) THEN         ! day duration is less than 24h 
    235                   rscal(ji,jj) = 0.0_wp 
    236                   IF( rdawn_dcy(ji,jj) < rdusk_dcy(ji,jj) ) THEN      ! day time in one part 
    237                      IF( (rdusk_dcy(ji,jj) - rdawn_dcy(ji,jj) ) .ge. 0.001_wp ) THEN 
    238                         rscal(ji,jj) = fintegral(rdawn_dcy(ji,jj), rdusk_dcy(ji,jj), raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
    239                         rscal(ji,jj) = 1._wp / rscal(ji,jj) 
    240                      ENDIF 
    241                   ELSE                                         ! day time in two parts 
    242                      IF( (rdusk_dcy(ji,jj) + (1._wp - rdawn_dcy(ji,jj)) ) .ge. 0.001_wp ) THEN 
    243                         rscal(ji,jj) = fintegral(0._wp, rdusk_dcy(ji,jj), raa(ji,jj), rbb(ji,jj), rcc(ji,jj))   & 
    244                            &         + fintegral(rdawn_dcy(ji,jj), 1._wp, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
    245                         rscal(ji,jj) = 1. / rscal(ji,jj) 
    246                      ENDIF 
     228         DO_2D_11_11 
     229            IF( ABS(rab(ji,jj)) < 1._wp ) THEN         ! day duration is less than 24h 
     230               rscal(ji,jj) = 0.0_wp 
     231               IF( rdawn_dcy(ji,jj) < rdusk_dcy(ji,jj) ) THEN      ! day time in one part 
     232                  IF( (rdusk_dcy(ji,jj) - rdawn_dcy(ji,jj) ) .ge. 0.001_wp ) THEN 
     233                     rscal(ji,jj) = fintegral(rdawn_dcy(ji,jj), rdusk_dcy(ji,jj), raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
     234                     rscal(ji,jj) = 1._wp / rscal(ji,jj) 
    247235                  ENDIF 
    248                ELSE 
    249                   IF( raa(ji,jj) > rbb(ji,jj) ) THEN         ! 24h day 
    250                      rscal(ji,jj) = fintegral(0._wp, 1._wp, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
    251                      rscal(ji,jj) = 1._wp / rscal(ji,jj) 
    252                   ELSE                                          ! No day 
    253                      rscal(ji,jj) = 0.0_wp 
     236               ELSE                                         ! day time in two parts 
     237                  IF( (rdusk_dcy(ji,jj) + (1._wp - rdawn_dcy(ji,jj)) ) .ge. 0.001_wp ) THEN 
     238                     rscal(ji,jj) = fintegral(0._wp, rdusk_dcy(ji,jj), raa(ji,jj), rbb(ji,jj), rcc(ji,jj))   & 
     239                        &         + fintegral(rdawn_dcy(ji,jj), 1._wp, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
     240                     rscal(ji,jj) = 1. / rscal(ji,jj) 
    254241                  ENDIF 
    255242               ENDIF 
    256             END DO 
    257          END DO 
     243            ELSE 
     244               IF( raa(ji,jj) > rbb(ji,jj) ) THEN         ! 24h day 
     245                  rscal(ji,jj) = fintegral(0._wp, 1._wp, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
     246                  rscal(ji,jj) = 1._wp / rscal(ji,jj) 
     247               ELSE                                          ! No day 
     248                  rscal(ji,jj) = 0.0_wp 
     249               ENDIF 
     250            ENDIF 
     251         END_2D 
    258252         ! 
    259253         ztmp = rday / ( rdt * REAL(nn_fsbc, wp) ) 
Note: See TracChangeset for help on using the changeset viewer.