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/ICE/icevar.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/ICE/icevar.F90

    r12182 r12340  
    8282   END INTERFACE 
    8383 
     84   !! * Substitutions 
     85#  include "do_loop_substitute.h90" 
    8486   !!---------------------------------------------------------------------- 
    8587   !! NEMO/ICE 4.0 , NEMO Consortium (2018) 
    … …  
    241243      zlay_i   = REAL( nlay_i , wp )    ! number of layers 
    242244      DO jl = 1, jpl 
    243          DO jk = 1, nlay_i 
    244             DO jj = 1, jpj 
    245                DO ji = 1, jpi 
    246                   IF ( v_i(ji,jj,jl) > epsi20 ) THEN     !--- icy area  
    247                      ! 
    248                      ze_i             =   e_i (ji,jj,jk,jl) * z1_v_i(ji,jj,jl) * zlay_i             ! Energy of melting e(S,T) [J.m-3] 
    249                      ztmelts          = - sz_i(ji,jj,jk,jl) * rTmlt                                 ! Ice layer melt temperature [C] 
    250                      ! Conversion q(S,T) -> T (second order equation) 
    251                      zbbb             = ( rcp - rcpi ) * ztmelts + ze_i * r1_rhoi - rLfus 
    252                      zccc             = SQRT( MAX( zbbb * zbbb - 4._wp * rcpi * rLfus * ztmelts , 0._wp) ) 
    253                      t_i(ji,jj,jk,jl) = MAX( -100._wp , MIN( -( zbbb + zccc ) * 0.5_wp * r1_rcpi , ztmelts ) ) + rt0   ! [K] with bounds: -100 < t_i < ztmelts 
    254                      ! 
    255                   ELSE                                   !--- no ice 
    256                      t_i(ji,jj,jk,jl) = rt0 
    257                   ENDIF 
    258                END DO 
    259             END DO 
    260          END DO 
     245         DO_3D_11_11( 1, nlay_i ) 
     246            IF ( v_i(ji,jj,jl) > epsi20 ) THEN     !--- icy area  
     247               ! 
     248               ze_i             =   e_i (ji,jj,jk,jl) * z1_v_i(ji,jj,jl) * zlay_i             ! Energy of melting e(S,T) [J.m-3] 
     249               ztmelts          = - sz_i(ji,jj,jk,jl) * rTmlt                                 ! Ice layer melt temperature [C] 
     250               ! Conversion q(S,T) -> T (second order equation) 
     251               zbbb             = ( rcp - rcpi ) * ztmelts + ze_i * r1_rhoi - rLfus 
     252               zccc             = SQRT( MAX( zbbb * zbbb - 4._wp * rcpi * rLfus * ztmelts , 0._wp) ) 
     253               t_i(ji,jj,jk,jl) = MAX( -100._wp , MIN( -( zbbb + zccc ) * 0.5_wp * r1_rcpi , ztmelts ) ) + rt0   ! [K] with bounds: -100 < t_i < ztmelts 
     254               ! 
     255            ELSE                                   !--- no ice 
     256               t_i(ji,jj,jk,jl) = rt0 
     257            ENDIF 
     258         END_3D 
    261259      END DO 
    262260 
    … …  
    349347         z1_dS = 1._wp / ( zsi1 - zsi0 ) 
    350348         DO jl = 1, jpl 
    351             DO jj = 1, jpj 
    352                DO ji = 1, jpi 
    353                   zalpha(ji,jj,jl) = MAX(  0._wp , MIN( ( zsi1 - s_i(ji,jj,jl) ) * z1_dS , 1._wp )  ) 
    354                   !                             ! force a constant profile when SSS too low (Baltic Sea) 
    355                   IF( 2._wp * s_i(ji,jj,jl) >= sss_m(ji,jj) )   zalpha(ji,jj,jl) = 0._wp   
    356                END DO 
    357             END DO 
     349            DO_2D_11_11 
     350               zalpha(ji,jj,jl) = MAX(  0._wp , MIN( ( zsi1 - s_i(ji,jj,jl) ) * z1_dS , 1._wp )  ) 
     351               !                             ! force a constant profile when SSS too low (Baltic Sea) 
     352               IF( 2._wp * s_i(ji,jj,jl) >= sss_m(ji,jj) )   zalpha(ji,jj,jl) = 0._wp   
     353            END_2D 
    358354         END DO 
    359355         ! 
    360356         ! Computation of the profile 
    361357         DO jl = 1, jpl 
    362             DO jk = 1, nlay_i 
    363                DO jj = 1, jpj 
    364                   DO ji = 1, jpi 
    365                      !                          ! linear profile with 0 surface value 
    366                      zs0 = z_slope_s(ji,jj,jl) * ( REAL(jk,wp) - 0.5_wp ) * h_i(ji,jj,jl) * r1_nlay_i 
    367                      zs  = zalpha(ji,jj,jl) * zs0 + ( 1._wp - zalpha(ji,jj,jl) ) * s_i(ji,jj,jl)     ! weighting the profile 
    368                      sz_i(ji,jj,jk,jl) = MIN( rn_simax, MAX( zs, rn_simin ) ) 
    369                   END DO 
    370                END DO 
    371             END DO 
     358            DO_3D_11_11( 1, nlay_i ) 
     359               !                          ! linear profile with 0 surface value 
     360               zs0 = z_slope_s(ji,jj,jl) * ( REAL(jk,wp) - 0.5_wp ) * h_i(ji,jj,jl) * r1_nlay_i 
     361               zs  = zalpha(ji,jj,jl) * zs0 + ( 1._wp - zalpha(ji,jj,jl) ) * s_i(ji,jj,jl)     ! weighting the profile 
     362               sz_i(ji,jj,jk,jl) = MIN( rn_simax, MAX( zs, rn_simin ) ) 
     363            END_3D 
    372364         END DO 
    373365         ! 
    … …  
    494486         ! Zap ice energy and use ocean heat to melt ice 
    495487         !----------------------------------------------------------------- 
    496          DO jk = 1, nlay_i 
    497             DO jj = 1 , jpj 
    498                DO ji = 1 , jpi 
    499                   ! update exchanges with ocean 
    500                   hfx_res(ji,jj)   = hfx_res(ji,jj) - (1._wp - zswitch(ji,jj) ) * e_i(ji,jj,jk,jl) * r1_rdtice ! W.m-2 <0 
    501                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * zswitch(ji,jj) 
    502                   t_i(ji,jj,jk,jl) = t_i(ji,jj,jk,jl) * zswitch(ji,jj) + rt0 * ( 1._wp - zswitch(ji,jj) ) 
    503                END DO 
    504             END DO 
    505          END DO 
    506          ! 
    507          DO jk = 1, nlay_s 
    508             DO jj = 1 , jpj 
    509                DO ji = 1 , jpi 
    510                   ! update exchanges with ocean 
    511                   hfx_res(ji,jj)   = hfx_res(ji,jj) - (1._wp - zswitch(ji,jj) ) * e_s(ji,jj,jk,jl) * r1_rdtice ! W.m-2 <0 
    512                   e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * zswitch(ji,jj) 
    513                   t_s(ji,jj,jk,jl) = t_s(ji,jj,jk,jl) * zswitch(ji,jj) + rt0 * ( 1._wp - zswitch(ji,jj) ) 
    514                END DO 
    515             END DO 
    516          END DO 
     488         DO_3D_11_11( 1, nlay_i ) 
     489            ! update exchanges with ocean 
     490            hfx_res(ji,jj)   = hfx_res(ji,jj) - (1._wp - zswitch(ji,jj) ) * e_i(ji,jj,jk,jl) * r1_rdtice ! W.m-2 <0 
     491            e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * zswitch(ji,jj) 
     492            t_i(ji,jj,jk,jl) = t_i(ji,jj,jk,jl) * zswitch(ji,jj) + rt0 * ( 1._wp - zswitch(ji,jj) ) 
     493         END_3D 
     494         ! 
     495         DO_3D_11_11( 1, nlay_s ) 
     496            ! update exchanges with ocean 
     497            hfx_res(ji,jj)   = hfx_res(ji,jj) - (1._wp - zswitch(ji,jj) ) * e_s(ji,jj,jk,jl) * r1_rdtice ! W.m-2 <0 
     498            e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * zswitch(ji,jj) 
     499            t_s(ji,jj,jk,jl) = t_s(ji,jj,jk,jl) * zswitch(ji,jj) + rt0 * ( 1._wp - zswitch(ji,jj) ) 
     500         END_3D 
    517501         ! 
    518502         !----------------------------------------------------------------- 
    519503         ! zap ice and snow volume, add water and salt to ocean 
    520504         !----------------------------------------------------------------- 
    521          DO jj = 1 , jpj 
    522             DO ji = 1 , jpi 
    523                ! update exchanges with ocean 
    524                sfx_res(ji,jj)  = sfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * sv_i(ji,jj,jl)   * rhoi * r1_rdtice 
    525                wfx_res(ji,jj)  = wfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * v_i (ji,jj,jl)   * rhoi * r1_rdtice 
    526                wfx_res(ji,jj)  = wfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * v_s (ji,jj,jl)   * rhos * r1_rdtice 
    527                ! 
    528                a_i  (ji,jj,jl) = a_i (ji,jj,jl) * zswitch(ji,jj) 
    529                v_i  (ji,jj,jl) = v_i (ji,jj,jl) * zswitch(ji,jj) 
    530                v_s  (ji,jj,jl) = v_s (ji,jj,jl) * zswitch(ji,jj) 
    531                t_su (ji,jj,jl) = t_su(ji,jj,jl) * zswitch(ji,jj) + t_bo(ji,jj) * ( 1._wp - zswitch(ji,jj) ) 
    532                oa_i (ji,jj,jl) = oa_i(ji,jj,jl) * zswitch(ji,jj) 
    533                sv_i (ji,jj,jl) = sv_i(ji,jj,jl) * zswitch(ji,jj) 
    534                ! 
    535                h_i (ji,jj,jl) = h_i (ji,jj,jl) * zswitch(ji,jj) 
    536                h_s (ji,jj,jl) = h_s (ji,jj,jl) * zswitch(ji,jj) 
    537                ! 
    538                a_ip (ji,jj,jl) = a_ip (ji,jj,jl) * zswitch(ji,jj) 
    539                v_ip (ji,jj,jl) = v_ip (ji,jj,jl) * zswitch(ji,jj) 
    540                ! 
    541             END DO 
    542          END DO 
     505         DO_2D_11_11 
     506            ! update exchanges with ocean 
     507            sfx_res(ji,jj)  = sfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * sv_i(ji,jj,jl)   * rhoi * r1_rdtice 
     508            wfx_res(ji,jj)  = wfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * v_i (ji,jj,jl)   * rhoi * r1_rdtice 
     509            wfx_res(ji,jj)  = wfx_res(ji,jj) + (1._wp - zswitch(ji,jj) ) * v_s (ji,jj,jl)   * rhos * r1_rdtice 
     510            ! 
     511            a_i  (ji,jj,jl) = a_i (ji,jj,jl) * zswitch(ji,jj) 
     512            v_i  (ji,jj,jl) = v_i (ji,jj,jl) * zswitch(ji,jj) 
     513            v_s  (ji,jj,jl) = v_s (ji,jj,jl) * zswitch(ji,jj) 
     514            t_su (ji,jj,jl) = t_su(ji,jj,jl) * zswitch(ji,jj) + t_bo(ji,jj) * ( 1._wp - zswitch(ji,jj) ) 
     515            oa_i (ji,jj,jl) = oa_i(ji,jj,jl) * zswitch(ji,jj) 
     516            sv_i (ji,jj,jl) = sv_i(ji,jj,jl) * zswitch(ji,jj) 
     517            ! 
     518            h_i (ji,jj,jl) = h_i (ji,jj,jl) * zswitch(ji,jj) 
     519            h_s (ji,jj,jl) = h_s (ji,jj,jl) * zswitch(ji,jj) 
     520            ! 
     521            a_ip (ji,jj,jl) = a_ip (ji,jj,jl) * zswitch(ji,jj) 
     522            v_ip (ji,jj,jl) = v_ip (ji,jj,jl) * zswitch(ji,jj) 
     523            ! 
     524         END_2D 
    543525         ! 
    544526      END DO  
    … …  
    592574         ! zap ice energy and send it to the ocean 
    593575         !---------------------------------------- 
    594          DO jk = 1, nlay_i 
    595             DO jj = 1 , jpj 
    596                DO ji = 1 , jpi 
    597                   IF( pe_i(ji,jj,jk,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN 
    598                      hfx_res(ji,jj)   = hfx_res(ji,jj) - pe_i(ji,jj,jk,jl) * z1_dt ! W.m-2 >0 
    599                      pe_i(ji,jj,jk,jl) = 0._wp 
    600                   ENDIF 
    601                END DO 
    602             END DO 
    603          END DO 
    604          ! 
    605          DO jk = 1, nlay_s 
    606             DO jj = 1 , jpj 
    607                DO ji = 1 , jpi 
    608                   IF( pe_s(ji,jj,jk,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN 
    609                      hfx_res(ji,jj)   = hfx_res(ji,jj) - pe_s(ji,jj,jk,jl) * z1_dt ! W.m-2 <0 
    610                      pe_s(ji,jj,jk,jl) = 0._wp 
    611                   ENDIF 
    612                END DO 
    613             END DO 
    614          END DO 
     576         DO_3D_11_11( 1, nlay_i ) 
     577            IF( pe_i(ji,jj,jk,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN 
     578               hfx_res(ji,jj)   = hfx_res(ji,jj) - pe_i(ji,jj,jk,jl) * z1_dt ! W.m-2 >0 
     579               pe_i(ji,jj,jk,jl) = 0._wp 
     580            ENDIF 
     581         END_3D 
     582         ! 
     583         DO_3D_11_11( 1, nlay_s ) 
     584            IF( pe_s(ji,jj,jk,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN 
     585               hfx_res(ji,jj)   = hfx_res(ji,jj) - pe_s(ji,jj,jk,jl) * z1_dt ! W.m-2 <0 
     586               pe_s(ji,jj,jk,jl) = 0._wp 
     587            ENDIF 
     588         END_3D 
    615589         ! 
    616590         !----------------------------------------------------- 
    617591         ! zap ice and snow volume, add water and salt to ocean 
    618592         !----------------------------------------------------- 
    619          DO jj = 1 , jpj 
    620             DO ji = 1 , jpi 
    621                IF( pv_i(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN 
    622                   wfx_res(ji,jj)    = wfx_res(ji,jj) + pv_i (ji,jj,jl) * rhoi * z1_dt 
    623                   pv_i   (ji,jj,jl) = 0._wp 
    624                ENDIF 
    625                IF( pv_s(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN 
    626                   wfx_res(ji,jj)    = wfx_res(ji,jj) + pv_s (ji,jj,jl) * rhos * z1_dt 
    627                   pv_s   (ji,jj,jl) = 0._wp 
    628                ENDIF 
    629                IF( psv_i(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp .OR. pv_i(ji,jj,jl) <= 0._wp ) THEN 
    630                   sfx_res(ji,jj)    = sfx_res(ji,jj) + psv_i(ji,jj,jl) * rhoi * z1_dt 
    631                   psv_i  (ji,jj,jl) = 0._wp 
    632                ENDIF 
    633             END DO 
    634          END DO 
     593         DO_2D_11_11 
     594            IF( pv_i(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN 
     595               wfx_res(ji,jj)    = wfx_res(ji,jj) + pv_i (ji,jj,jl) * rhoi * z1_dt 
     596               pv_i   (ji,jj,jl) = 0._wp 
     597            ENDIF 
     598            IF( pv_s(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN 
     599               wfx_res(ji,jj)    = wfx_res(ji,jj) + pv_s (ji,jj,jl) * rhos * z1_dt 
     600               pv_s   (ji,jj,jl) = 0._wp 
     601            ENDIF 
     602            IF( psv_i(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp .OR. pv_i(ji,jj,jl) <= 0._wp ) THEN 
     603               sfx_res(ji,jj)    = sfx_res(ji,jj) + psv_i(ji,jj,jl) * rhoi * z1_dt 
     604               psv_i  (ji,jj,jl) = 0._wp 
     605            ENDIF 
     606         END_2D 
    635607         ! 
    636608      END DO  
Note: See TracChangeset for help on using the changeset viewer.