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/TRA/zpshde.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/TRA/zpshde.F90

    r11949 r12340  
    3232   !! * Substitutions 
    3333#  include "vectopt_loop_substitute.h90" 
     34#  include "do_loop_substitute.h90" 
    3435   !!---------------------------------------------------------------------- 
    3536   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    106107      DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==! 
    107108         ! 
    108          DO jj = 1, jpjm1 
    109             DO ji = 1, jpim1 
    110                iku = mbku(ji,jj)   ;   ikum1 = MAX( iku - 1 , 1 )    ! last and before last ocean level at u- & v-points 
    111                ikv = mbkv(ji,jj)   ;   ikvm1 = MAX( ikv - 1 , 1 )    ! if level first is a p-step, ik.m1=1 
     109         DO_2D_10_10 
     110            iku = mbku(ji,jj)   ;   ikum1 = MAX( iku - 1 , 1 )    ! last and before last ocean level at u- & v-points 
     111            ikv = mbkv(ji,jj)   ;   ikvm1 = MAX( ikv - 1 , 1 )    ! if level first is a p-step, ik.m1=1 
    112112!!gm BUG ? when applied to before fields, e3w(:,:,:,Kbb) should be used.... 
    113                ze3wu = e3w(ji+1,jj  ,iku,Kmm) - e3w(ji,jj,iku,Kmm) 
    114                ze3wv = e3w(ji  ,jj+1,ikv,Kmm) - e3w(ji,jj,ikv,Kmm) 
    115                ! 
    116                ! i- direction 
    117                IF( ze3wu >= 0._wp ) THEN      ! case 1 
    118                   zmaxu =  ze3wu / e3w(ji+1,jj,iku,Kmm) 
    119                   ! interpolated values of tracers 
    120                   zti (ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) ) 
    121                   ! gradient of  tracers 
    122                   pgtu(ji,jj,jn) = umask(ji,jj,1) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 
    123                ELSE                           ! case 2 
    124                   zmaxu = -ze3wu / e3w(ji,jj,iku,Kmm) 
    125                   ! interpolated values of tracers 
    126                   zti (ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) ) 
    127                   ! gradient of tracers 
    128                   pgtu(ji,jj,jn) = umask(ji,jj,1) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) ) 
    129                ENDIF 
    130                ! 
    131                ! j- direction 
    132                IF( ze3wv >= 0._wp ) THEN      ! case 1 
    133                   zmaxv =  ze3wv / e3w(ji,jj+1,ikv,Kmm) 
    134                   ! interpolated values of tracers 
    135                   ztj (ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) ) 
    136                   ! gradient of tracers 
    137                   pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 
    138                ELSE                           ! case 2 
    139                   zmaxv =  -ze3wv / e3w(ji,jj,ikv,Kmm) 
    140                   ! interpolated values of tracers 
    141                   ztj (ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) ) 
    142                   ! gradient of tracers 
    143                   pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) 
    144                ENDIF 
    145             END DO 
    146          END DO 
     113            ze3wu = e3w(ji+1,jj  ,iku,Kmm) - e3w(ji,jj,iku,Kmm) 
     114            ze3wv = e3w(ji  ,jj+1,ikv,Kmm) - e3w(ji,jj,ikv,Kmm) 
     115            ! 
     116            ! i- direction 
     117            IF( ze3wu >= 0._wp ) THEN      ! case 1 
     118               zmaxu =  ze3wu / e3w(ji+1,jj,iku,Kmm) 
     119               ! interpolated values of tracers 
     120               zti (ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) ) 
     121               ! gradient of  tracers 
     122               pgtu(ji,jj,jn) = umask(ji,jj,1) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 
     123            ELSE                           ! case 2 
     124               zmaxu = -ze3wu / e3w(ji,jj,iku,Kmm) 
     125               ! interpolated values of tracers 
     126               zti (ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) ) 
     127               ! gradient of tracers 
     128               pgtu(ji,jj,jn) = umask(ji,jj,1) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) ) 
     129            ENDIF 
     130            ! 
     131            ! j- direction 
     132            IF( ze3wv >= 0._wp ) THEN      ! case 1 
     133               zmaxv =  ze3wv / e3w(ji,jj+1,ikv,Kmm) 
     134               ! interpolated values of tracers 
     135               ztj (ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) ) 
     136               ! gradient of tracers 
     137               pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 
     138            ELSE                           ! case 2 
     139               zmaxv =  -ze3wv / e3w(ji,jj,ikv,Kmm) 
     140               ! interpolated values of tracers 
     141               ztj (ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) ) 
     142               ! gradient of tracers 
     143               pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) 
     144            ENDIF 
     145         END_2D 
    147146      END DO 
    148147      ! 
    … …  
    152151         pgru(:,:) = 0._wp 
    153152         pgrv(:,:) = 0._wp                ! depth of the partial step level 
    154          DO jj = 1, jpjm1 
    155             DO ji = 1, jpim1 
    156                iku = mbku(ji,jj) 
    157                ikv = mbkv(ji,jj) 
    158                ze3wu  = e3w(ji+1,jj  ,iku,Kmm) - e3w(ji,jj,iku,Kmm) 
    159                ze3wv  = e3w(ji  ,jj+1,ikv,Kmm) - e3w(ji,jj,ikv,Kmm) 
    160                IF( ze3wu >= 0._wp ) THEN   ;   zhi(ji,jj) = gdept(ji  ,jj,iku,Kmm)     ! i-direction: case 1 
    161                ELSE                        ;   zhi(ji,jj) = gdept(ji+1,jj,iku,Kmm)     ! -     -      case 2 
    162                ENDIF 
    163                IF( ze3wv >= 0._wp ) THEN   ;   zhj(ji,jj) = gdept(ji,jj  ,ikv,Kmm)     ! j-direction: case 1 
    164                ELSE                        ;   zhj(ji,jj) = gdept(ji,jj+1,ikv,Kmm)     ! -     -      case 2 
    165                ENDIF 
    166             END DO 
    167          END DO 
     153         DO_2D_10_10 
     154            iku = mbku(ji,jj) 
     155            ikv = mbkv(ji,jj) 
     156            ze3wu  = e3w(ji+1,jj  ,iku,Kmm) - e3w(ji,jj,iku,Kmm) 
     157            ze3wv  = e3w(ji  ,jj+1,ikv,Kmm) - e3w(ji,jj,ikv,Kmm) 
     158            IF( ze3wu >= 0._wp ) THEN   ;   zhi(ji,jj) = gdept(ji  ,jj,iku,Kmm)     ! i-direction: case 1 
     159            ELSE                        ;   zhi(ji,jj) = gdept(ji+1,jj,iku,Kmm)     ! -     -      case 2 
     160            ENDIF 
     161            IF( ze3wv >= 0._wp ) THEN   ;   zhj(ji,jj) = gdept(ji,jj  ,ikv,Kmm)     ! j-direction: case 1 
     162            ELSE                        ;   zhj(ji,jj) = gdept(ji,jj+1,ikv,Kmm)     ! -     -      case 2 
     163            ENDIF 
     164         END_2D 
    168165         ! 
    169166         CALL eos( zti, zhi, zri )        ! interpolated density from zti, ztj  
    170167         CALL eos( ztj, zhj, zrj )        ! at the partial step depth output in  zri, zrj  
    171168         ! 
    172          DO jj = 1, jpjm1                 ! Gradient of density at the last level  
    173             DO ji = 1, jpim1 
    174                iku = mbku(ji,jj) 
    175                ikv = mbkv(ji,jj) 
    176                ze3wu  = e3w(ji+1,jj  ,iku,Kmm) - e3w(ji,jj,iku,Kmm) 
    177                ze3wv  = e3w(ji  ,jj+1,ikv,Kmm) - e3w(ji,jj,ikv,Kmm) 
    178                IF( ze3wu >= 0._wp ) THEN   ;   pgru(ji,jj) = umask(ji,jj,1) * ( zri(ji  ,jj    ) - prd(ji,jj,iku) )   ! i: 1 
    179                ELSE                        ;   pgru(ji,jj) = umask(ji,jj,1) * ( prd(ji+1,jj,iku) - zri(ji,jj    ) )   ! i: 2 
    180                ENDIF 
    181                IF( ze3wv >= 0._wp ) THEN   ;   pgrv(ji,jj) = vmask(ji,jj,1) * ( zrj(ji,jj      ) - prd(ji,jj,ikv) )   ! j: 1 
    182                ELSE                        ;   pgrv(ji,jj) = vmask(ji,jj,1) * ( prd(ji,jj+1,ikv) - zrj(ji,jj    ) )   ! j: 2 
    183                ENDIF 
    184             END DO 
    185          END DO 
     169         DO_2D_10_10 
     170            iku = mbku(ji,jj) 
     171            ikv = mbkv(ji,jj) 
     172            ze3wu  = e3w(ji+1,jj  ,iku,Kmm) - e3w(ji,jj,iku,Kmm) 
     173            ze3wv  = e3w(ji  ,jj+1,ikv,Kmm) - e3w(ji,jj,ikv,Kmm) 
     174            IF( ze3wu >= 0._wp ) THEN   ;   pgru(ji,jj) = umask(ji,jj,1) * ( zri(ji  ,jj    ) - prd(ji,jj,iku) )   ! i: 1 
     175            ELSE                        ;   pgru(ji,jj) = umask(ji,jj,1) * ( prd(ji+1,jj,iku) - zri(ji,jj    ) )   ! i: 2 
     176            ENDIF 
     177            IF( ze3wv >= 0._wp ) THEN   ;   pgrv(ji,jj) = vmask(ji,jj,1) * ( zrj(ji,jj      ) - prd(ji,jj,ikv) )   ! j: 1 
     178            ELSE                        ;   pgrv(ji,jj) = vmask(ji,jj,1) * ( prd(ji,jj+1,ikv) - zrj(ji,jj    ) )   ! j: 2 
     179            ENDIF 
     180         END_2D 
    186181         CALL lbc_lnk_multi( 'zpshde', pgru , 'U', -1. , pgrv , 'V', -1. )   ! Lateral boundary conditions 
    187182         ! 
    … …  
    267262      DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==! 
    268263         ! 
    269          DO jj = 1, jpjm1 
    270             DO ji = 1, jpim1 
    271  
    272                iku = mbku(ji,jj); ikum1 = MAX( iku - 1 , 1 )    ! last and before last ocean level at u- & v-points 
    273                ikv = mbkv(ji,jj); ikvm1 = MAX( ikv - 1 , 1 )    ! if level first is a p-step, ik.m1=1 
    274                ze3wu = gdept(ji+1,jj,iku,Kmm) - gdept(ji,jj,iku,Kmm) 
    275                ze3wv = gdept(ji,jj+1,ikv,Kmm) - gdept(ji,jj,ikv,Kmm) 
    276                ! 
    277                ! i- direction 
    278                IF( ze3wu >= 0._wp ) THEN      ! case 1 
    279                   zmaxu =  ze3wu / e3w(ji+1,jj,iku,Kmm) 
    280                   ! interpolated values of tracers 
    281                   zti (ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) ) 
    282                   ! gradient of  tracers 
    283                   pgtu(ji,jj,jn) = ssumask(ji,jj) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 
    284                ELSE                           ! case 2 
    285                   zmaxu = -ze3wu / e3w(ji,jj,iku,Kmm) 
    286                   ! interpolated values of tracers 
    287                   zti (ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) ) 
    288                   ! gradient of tracers 
    289                   pgtu(ji,jj,jn) = ssumask(ji,jj) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) ) 
    290                ENDIF 
    291                ! 
    292                ! j- direction 
    293                IF( ze3wv >= 0._wp ) THEN      ! case 1 
    294                   zmaxv =  ze3wv / e3w(ji,jj+1,ikv,Kmm) 
    295                   ! interpolated values of tracers 
    296                   ztj (ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) ) 
    297                   ! gradient of tracers 
    298                   pgtv(ji,jj,jn) = ssvmask(ji,jj) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 
    299                ELSE                           ! case 2 
    300                   zmaxv =  -ze3wv / e3w(ji,jj,ikv,Kmm) 
    301                   ! interpolated values of tracers 
    302                   ztj (ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) ) 
    303                   ! gradient of tracers 
    304                   pgtv(ji,jj,jn) = ssvmask(ji,jj) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) 
    305                ENDIF 
    306  
    307             END DO 
    308          END DO 
     264         DO_2D_10_10 
     265 
     266            iku = mbku(ji,jj); ikum1 = MAX( iku - 1 , 1 )    ! last and before last ocean level at u- & v-points 
     267            ikv = mbkv(ji,jj); ikvm1 = MAX( ikv - 1 , 1 )    ! if level first is a p-step, ik.m1=1 
     268            ze3wu = gdept(ji+1,jj,iku,Kmm) - gdept(ji,jj,iku,Kmm) 
     269            ze3wv = gdept(ji,jj+1,ikv,Kmm) - gdept(ji,jj,ikv,Kmm) 
     270            ! 
     271            ! i- direction 
     272            IF( ze3wu >= 0._wp ) THEN      ! case 1 
     273               zmaxu =  ze3wu / e3w(ji+1,jj,iku,Kmm) 
     274               ! interpolated values of tracers 
     275               zti (ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) ) 
     276               ! gradient of  tracers 
     277               pgtu(ji,jj,jn) = ssumask(ji,jj) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 
     278            ELSE                           ! case 2 
     279               zmaxu = -ze3wu / e3w(ji,jj,iku,Kmm) 
     280               ! interpolated values of tracers 
     281               zti (ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) ) 
     282               ! gradient of tracers 
     283               pgtu(ji,jj,jn) = ssumask(ji,jj) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) ) 
     284            ENDIF 
     285            ! 
     286            ! j- direction 
     287            IF( ze3wv >= 0._wp ) THEN      ! case 1 
     288               zmaxv =  ze3wv / e3w(ji,jj+1,ikv,Kmm) 
     289               ! interpolated values of tracers 
     290               ztj (ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) ) 
     291               ! gradient of tracers 
     292               pgtv(ji,jj,jn) = ssvmask(ji,jj) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 
     293            ELSE                           ! case 2 
     294               zmaxv =  -ze3wv / e3w(ji,jj,ikv,Kmm) 
     295               ! interpolated values of tracers 
     296               ztj (ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) ) 
     297               ! gradient of tracers 
     298               pgtv(ji,jj,jn) = ssvmask(ji,jj) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) 
     299            ENDIF 
     300 
     301         END_2D 
    309302      END DO 
    310303      ! 
    … …  
    315308         pgru(:,:)=0.0_wp   ; pgrv(:,:)=0.0_wp ;  
    316309         ! 
    317          DO jj = 1, jpjm1 
    318             DO ji = 1, jpim1 
    319  
    320                iku = mbku(ji,jj) 
    321                ikv = mbkv(ji,jj) 
    322                ze3wu = gdept(ji+1,jj,iku,Kmm) - gdept(ji,jj,iku,Kmm) 
    323                ze3wv = gdept(ji,jj+1,ikv,Kmm) - gdept(ji,jj,ikv,Kmm) 
    324                ! 
    325                IF( ze3wu >= 0._wp ) THEN   ;   zhi(ji,jj) = gdept(ji  ,jj,iku,Kmm)    ! i-direction: case 1 
    326                ELSE                        ;   zhi(ji,jj) = gdept(ji+1,jj,iku,Kmm)    ! -     -      case 2 
    327                ENDIF 
    328                IF( ze3wv >= 0._wp ) THEN   ;   zhj(ji,jj) = gdept(ji,jj  ,ikv,Kmm)    ! j-direction: case 1 
    329                ELSE                        ;   zhj(ji,jj) = gdept(ji,jj+1,ikv,Kmm)    ! -     -      case 2 
    330                ENDIF 
    331  
    332             END DO 
    333          END DO 
     310         DO_2D_10_10 
     311 
     312            iku = mbku(ji,jj) 
     313            ikv = mbkv(ji,jj) 
     314            ze3wu = gdept(ji+1,jj,iku,Kmm) - gdept(ji,jj,iku,Kmm) 
     315            ze3wv = gdept(ji,jj+1,ikv,Kmm) - gdept(ji,jj,ikv,Kmm) 
     316            ! 
     317            IF( ze3wu >= 0._wp ) THEN   ;   zhi(ji,jj) = gdept(ji  ,jj,iku,Kmm)    ! i-direction: case 1 
     318            ELSE                        ;   zhi(ji,jj) = gdept(ji+1,jj,iku,Kmm)    ! -     -      case 2 
     319            ENDIF 
     320            IF( ze3wv >= 0._wp ) THEN   ;   zhj(ji,jj) = gdept(ji,jj  ,ikv,Kmm)    ! j-direction: case 1 
     321            ELSE                        ;   zhj(ji,jj) = gdept(ji,jj+1,ikv,Kmm)    ! -     -      case 2 
     322            ENDIF 
     323 
     324         END_2D 
    334325 
    335326         ! Compute interpolated rd from zti, ztj for the 2 cases at the depth of the partial 
    … …  
    338329         CALL eos( ztj, zhj, zrj ) 
    339330 
    340          DO jj = 1, jpjm1                 ! Gradient of density at the last level  
    341             DO ji = 1, jpim1 
    342                iku = mbku(ji,jj) 
    343                ikv = mbkv(ji,jj) 
    344                ze3wu = gdept(ji+1,jj,iku,Kmm) - gdept(ji,jj,iku,Kmm) 
    345                ze3wv = gdept(ji,jj+1,ikv,Kmm) - gdept(ji,jj,ikv,Kmm) 
    346  
    347                IF( ze3wu >= 0._wp ) THEN   ;   pgru(ji,jj) = ssumask(ji,jj) * ( zri(ji  ,jj    ) - prd(ji,jj,iku) )   ! i: 1 
    348                ELSE                        ;   pgru(ji,jj) = ssumask(ji,jj) * ( prd(ji+1,jj,iku) - zri(ji,jj    ) )   ! i: 2 
    349                ENDIF 
    350                IF( ze3wv >= 0._wp ) THEN   ;   pgrv(ji,jj) = ssvmask(ji,jj) * ( zrj(ji,jj      ) - prd(ji,jj,ikv) )   ! j: 1 
    351                ELSE                        ;   pgrv(ji,jj) = ssvmask(ji,jj) * ( prd(ji,jj+1,ikv) - zrj(ji,jj    ) )   ! j: 2 
    352                ENDIF 
    353  
    354             END DO 
    355          END DO 
     331         DO_2D_10_10 
     332            iku = mbku(ji,jj) 
     333            ikv = mbkv(ji,jj) 
     334            ze3wu = gdept(ji+1,jj,iku,Kmm) - gdept(ji,jj,iku,Kmm) 
     335            ze3wv = gdept(ji,jj+1,ikv,Kmm) - gdept(ji,jj,ikv,Kmm) 
     336 
     337            IF( ze3wu >= 0._wp ) THEN   ;   pgru(ji,jj) = ssumask(ji,jj) * ( zri(ji  ,jj    ) - prd(ji,jj,iku) )   ! i: 1 
     338            ELSE                        ;   pgru(ji,jj) = ssumask(ji,jj) * ( prd(ji+1,jj,iku) - zri(ji,jj    ) )   ! i: 2 
     339            ENDIF 
     340            IF( ze3wv >= 0._wp ) THEN   ;   pgrv(ji,jj) = ssvmask(ji,jj) * ( zrj(ji,jj      ) - prd(ji,jj,ikv) )   ! j: 1 
     341            ELSE                        ;   pgrv(ji,jj) = ssvmask(ji,jj) * ( prd(ji,jj+1,ikv) - zrj(ji,jj    ) )   ! j: 2 
     342            ENDIF 
     343 
     344         END_2D 
    356345 
    357346         CALL lbc_lnk_multi( 'zpshde', pgru , 'U', -1. , pgrv , 'V', -1. )   ! Lateral boundary conditions 
    … …  
    362351      ! 
    363352      DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==!            ! 
    364          DO jj = 1, jpjm1 
    365             DO ji = 1, jpim1 
    366                iku = miku(ji,jj); ikup1 = miku(ji,jj) + 1 
    367                ikv = mikv(ji,jj); ikvp1 = mikv(ji,jj) + 1 
    368                ! 
    369                ! (ISF) case partial step top and bottom in adjacent cell in vertical 
    370                ! cannot used e3w because if 2 cell water column, we have ps at top and bottom 
    371                ! in this case e3w(i,j) - e3w(i,j+1) is not the distance between Tj~ and Tj 
    372                ! the only common depth between cells (i,j) and (i,j+1) is gdepw_0 
    373                ze3wu  =  gdept(ji,jj,iku,Kmm) - gdept(ji+1,jj,iku,Kmm) 
    374                ze3wv  =  gdept(ji,jj,ikv,Kmm) - gdept(ji,jj+1,ikv,Kmm)  
    375  
    376                ! i- direction 
    377                IF( ze3wu >= 0._wp ) THEN      ! case 1 
    378                   zmaxu = ze3wu / e3w(ji+1,jj,ikup1,Kmm) 
    379                   ! interpolated values of tracers 
    380                   zti(ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikup1,jn) - pta(ji+1,jj,iku,jn) ) 
    381                   ! gradient of tracers 
    382                   pgtui(ji,jj,jn) = ssumask(ji,jj) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 
    383                ELSE                           ! case 2 
    384                   zmaxu = - ze3wu / e3w(ji,jj,ikup1,Kmm) 
    385                   ! interpolated values of tracers 
    386                   zti(ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikup1,jn) - pta(ji,jj,iku,jn) ) 
    387                   ! gradient of  tracers 
    388                   pgtui(ji,jj,jn) = ssumask(ji,jj) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) ) 
    389                ENDIF 
    390                ! 
    391                ! j- direction 
    392                IF( ze3wv >= 0._wp ) THEN      ! case 1 
    393                   zmaxv =  ze3wv / e3w(ji,jj+1,ikvp1,Kmm) 
    394                   ! interpolated values of tracers 
    395                   ztj(ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvp1,jn) - pta(ji,jj+1,ikv,jn) ) 
    396                   ! gradient of tracers 
    397                   pgtvi(ji,jj,jn) = ssvmask(ji,jj) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 
    398                ELSE                           ! case 2 
    399                   zmaxv =  - ze3wv / e3w(ji,jj,ikvp1,Kmm) 
    400                   ! interpolated values of tracers 
    401                   ztj(ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvp1,jn) - pta(ji,jj,ikv,jn) ) 
    402                   ! gradient of tracers 
    403                   pgtvi(ji,jj,jn) = ssvmask(ji,jj) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) 
    404                ENDIF 
    405  
    406             END DO 
    407          END DO 
     353         DO_2D_10_10 
     354            iku = miku(ji,jj); ikup1 = miku(ji,jj) + 1 
     355            ikv = mikv(ji,jj); ikvp1 = mikv(ji,jj) + 1 
     356            ! 
     357            ! (ISF) case partial step top and bottom in adjacent cell in vertical 
     358            ! cannot used e3w because if 2 cell water column, we have ps at top and bottom 
     359            ! in this case e3w(i,j) - e3w(i,j+1) is not the distance between Tj~ and Tj 
     360            ! the only common depth between cells (i,j) and (i,j+1) is gdepw_0 
     361            ze3wu  =  gdept(ji,jj,iku,Kmm) - gdept(ji+1,jj,iku,Kmm) 
     362            ze3wv  =  gdept(ji,jj,ikv,Kmm) - gdept(ji,jj+1,ikv,Kmm)  
     363 
     364            ! i- direction 
     365            IF( ze3wu >= 0._wp ) THEN      ! case 1 
     366               zmaxu = ze3wu / e3w(ji+1,jj,ikup1,Kmm) 
     367               ! interpolated values of tracers 
     368               zti(ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikup1,jn) - pta(ji+1,jj,iku,jn) ) 
     369               ! gradient of tracers 
     370               pgtui(ji,jj,jn) = ssumask(ji,jj) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 
     371            ELSE                           ! case 2 
     372               zmaxu = - ze3wu / e3w(ji,jj,ikup1,Kmm) 
     373               ! interpolated values of tracers 
     374               zti(ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikup1,jn) - pta(ji,jj,iku,jn) ) 
     375               ! gradient of  tracers 
     376               pgtui(ji,jj,jn) = ssumask(ji,jj) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) ) 
     377            ENDIF 
     378            ! 
     379            ! j- direction 
     380            IF( ze3wv >= 0._wp ) THEN      ! case 1 
     381               zmaxv =  ze3wv / e3w(ji,jj+1,ikvp1,Kmm) 
     382               ! interpolated values of tracers 
     383               ztj(ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvp1,jn) - pta(ji,jj+1,ikv,jn) ) 
     384               ! gradient of tracers 
     385               pgtvi(ji,jj,jn) = ssvmask(ji,jj) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 
     386            ELSE                           ! case 2 
     387               zmaxv =  - ze3wv / e3w(ji,jj,ikvp1,Kmm) 
     388               ! interpolated values of tracers 
     389               ztj(ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvp1,jn) - pta(ji,jj,ikv,jn) ) 
     390               ! gradient of tracers 
     391               pgtvi(ji,jj,jn) = ssvmask(ji,jj) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) 
     392            ENDIF 
     393 
     394         END_2D 
    408395         ! 
    409396      END DO 
    … …  
    413400         ! 
    414401         pgrui(:,:)  =0.0_wp; pgrvi(:,:)  =0.0_wp; 
    415          DO jj = 1, jpjm1 
    416             DO ji = 1, jpim1 
    417  
    418                iku = miku(ji,jj) 
    419                ikv = mikv(ji,jj) 
    420                ze3wu  =  gdept(ji,jj,iku,Kmm) - gdept(ji+1,jj,iku,Kmm) 
    421                ze3wv  =  gdept(ji,jj,ikv,Kmm) - gdept(ji,jj+1,ikv,Kmm)  
    422                ! 
    423                IF( ze3wu >= 0._wp ) THEN   ;   zhi(ji,jj) = gdept(ji  ,jj,iku,Kmm)    ! i-direction: case 1 
    424                ELSE                        ;   zhi(ji,jj) = gdept(ji+1,jj,iku,Kmm)    ! -     -      case 2 
    425                ENDIF 
    426  
    427                IF( ze3wv >= 0._wp ) THEN   ;   zhj(ji,jj) = gdept(ji,jj  ,ikv,Kmm)    ! j-direction: case 1 
    428                ELSE                        ;   zhj(ji,jj) = gdept(ji,jj+1,ikv,Kmm)    ! -     -      case 2 
    429                ENDIF 
    430  
    431             END DO 
    432          END DO 
     402         DO_2D_10_10 
     403 
     404            iku = miku(ji,jj) 
     405            ikv = mikv(ji,jj) 
     406            ze3wu  =  gdept(ji,jj,iku,Kmm) - gdept(ji+1,jj,iku,Kmm) 
     407            ze3wv  =  gdept(ji,jj,ikv,Kmm) - gdept(ji,jj+1,ikv,Kmm)  
     408            ! 
     409            IF( ze3wu >= 0._wp ) THEN   ;   zhi(ji,jj) = gdept(ji  ,jj,iku,Kmm)    ! i-direction: case 1 
     410            ELSE                        ;   zhi(ji,jj) = gdept(ji+1,jj,iku,Kmm)    ! -     -      case 2 
     411            ENDIF 
     412 
     413            IF( ze3wv >= 0._wp ) THEN   ;   zhj(ji,jj) = gdept(ji,jj  ,ikv,Kmm)    ! j-direction: case 1 
     414            ELSE                        ;   zhj(ji,jj) = gdept(ji,jj+1,ikv,Kmm)    ! -     -      case 2 
     415            ENDIF 
     416 
     417         END_2D 
    433418         ! 
    434419         CALL eos( zti, zhi, zri )        ! interpolated density from zti, ztj  
    435420         CALL eos( ztj, zhj, zrj )        ! at the partial step depth output in  zri, zrj  
    436421         ! 
    437          DO jj = 1, jpjm1                 ! Gradient of density at the last level  
    438             DO ji = 1, jpim1 
    439                iku = miku(ji,jj)  
    440                ikv = mikv(ji,jj)  
    441                ze3wu  =  gdept(ji,jj,iku,Kmm) - gdept(ji+1,jj,iku,Kmm) 
    442                ze3wv  =  gdept(ji,jj,ikv,Kmm) - gdept(ji,jj+1,ikv,Kmm)  
    443  
    444                IF( ze3wu >= 0._wp ) THEN ; pgrui(ji,jj) = ssumask(ji,jj) * ( zri(ji  ,jj      ) - prd(ji,jj,iku) ) ! i: 1 
    445                ELSE                      ; pgrui(ji,jj) = ssumask(ji,jj) * ( prd(ji+1,jj  ,iku) - zri(ji,jj    ) ) ! i: 2 
    446                ENDIF 
    447                IF( ze3wv >= 0._wp ) THEN ; pgrvi(ji,jj) = ssvmask(ji,jj) * ( zrj(ji  ,jj      ) - prd(ji,jj,ikv) ) ! j: 1 
    448                ELSE                      ; pgrvi(ji,jj) = ssvmask(ji,jj) * ( prd(ji  ,jj+1,ikv) - zrj(ji,jj    ) ) ! j: 2 
    449                ENDIF 
    450  
    451             END DO 
    452          END DO 
     422         DO_2D_10_10 
     423            iku = miku(ji,jj)  
     424            ikv = mikv(ji,jj)  
     425            ze3wu  =  gdept(ji,jj,iku,Kmm) - gdept(ji+1,jj,iku,Kmm) 
     426            ze3wv  =  gdept(ji,jj,ikv,Kmm) - gdept(ji,jj+1,ikv,Kmm)  
     427 
     428            IF( ze3wu >= 0._wp ) THEN ; pgrui(ji,jj) = ssumask(ji,jj) * ( zri(ji  ,jj      ) - prd(ji,jj,iku) ) ! i: 1 
     429            ELSE                      ; pgrui(ji,jj) = ssumask(ji,jj) * ( prd(ji+1,jj  ,iku) - zri(ji,jj    ) ) ! i: 2 
     430            ENDIF 
     431            IF( ze3wv >= 0._wp ) THEN ; pgrvi(ji,jj) = ssvmask(ji,jj) * ( zrj(ji  ,jj      ) - prd(ji,jj,ikv) ) ! j: 1 
     432            ELSE                      ; pgrvi(ji,jj) = ssvmask(ji,jj) * ( prd(ji  ,jj+1,ikv) - zrj(ji,jj    ) ) ! j: 2 
     433            ENDIF 
     434 
     435         END_2D 
    453436         CALL lbc_lnk_multi( 'zpshde', pgrui, 'U', -1. , pgrvi, 'V', -1. )   ! Lateral boundary conditions 
    454437         ! 
Note: See TracChangeset for help on using the changeset viewer.