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 – 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.

Location:
NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DIA
Files:
6 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DIA/diaar5.F90

    r12336 r12340  
    4040   !! * Substitutions 
    4141#  include "vectopt_loop_substitute.h90" 
     42#  include "do_loop_substitute.h90" 
    4243   !!---------------------------------------------------------------------- 
    4344   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    107108      ! 
    108109      IF( iom_use( 'e3tb' ) )  THEN    ! bottom layer thickness 
    109          DO jj = 1, jpj 
    110             DO ji = 1, jpi 
    111                ikb = mbkt(ji,jj) 
    112                z2d(ji,jj) = e3t(ji,jj,ikb,Kmm) 
    113             END DO 
    114          END DO 
     110         DO_2D_11_11 
     111            ikb = mbkt(ji,jj) 
     112            z2d(ji,jj) = e3t(ji,jj,ikb,Kmm) 
     113         END_2D 
    115114         CALL iom_put( 'e3tb', z2d ) 
    116115      ENDIF  
    … …  
    192191          !                                         ! Mean density anomalie, temperature and salinity 
    193192          ztsn(:,:,:,:) = 0._wp                    ! ztsn(:,:,1,jp_tem/sal) is used here as 2D Workspace for temperature & salinity 
    194           DO jk = 1, jpkm1 
    195              DO jj = 1, jpj 
    196                 DO ji = 1, jpi 
    197                    zztmp = area(ji,jj) * e3t(ji,jj,jk,Kmm) 
    198                    ztsn(ji,jj,1,jp_tem) = ztsn(ji,jj,1,jp_tem) + zztmp * ts(ji,jj,jk,jp_tem,Kmm) 
    199                    ztsn(ji,jj,1,jp_sal) = ztsn(ji,jj,1,jp_sal) + zztmp * ts(ji,jj,jk,jp_sal,Kmm) 
    200                 ENDDO 
    201              ENDDO 
    202           ENDDO 
     193          DO_3D_11_11( 1, jpkm1 ) 
     194             zztmp = area(ji,jj) * e3t(ji,jj,jk,Kmm) 
     195             ztsn(ji,jj,1,jp_tem) = ztsn(ji,jj,1,jp_tem) + zztmp * ts(ji,jj,jk,jp_tem,Kmm) 
     196             ztsn(ji,jj,1,jp_sal) = ztsn(ji,jj,1,jp_sal) + zztmp * ts(ji,jj,jk,jp_sal,Kmm) 
     197          END_3D 
    203198 
    204199          IF( ln_linssh ) THEN 
    … …  
    256251             IF( iom_use( 'tosmint_pot') ) THEN 
    257252               z2d(:,:) = 0._wp 
    258                DO jk = 1, jpkm1 
    259                   DO jj = 1, jpj 
    260                      DO ji = 1, jpi   ! vector opt. 
    261                         z2d(ji,jj) = z2d(ji,jj) + rau0 * e3t(ji,jj,jk,Kmm) *  ztpot(ji,jj,jk) 
    262                      END DO 
    263                   END DO 
    264                END DO 
     253               DO_3D_11_11( 1, jpkm1 ) 
     254                  z2d(ji,jj) = z2d(ji,jj) + rau0 * e3t(ji,jj,jk,Kmm) *  ztpot(ji,jj,jk) 
     255               END_3D 
    265256               CALL iom_put( 'tosmint_pot', z2d )  
    266257            ENDIF 
    … …  
    281272         zpe(:,:) = 0._wp 
    282273         IF( ln_zdfddm ) THEN 
    283             DO jk = 2, jpk 
    284                DO jj = 1, jpj 
    285                   DO ji = 1, jpi 
    286                      IF( rn2(ji,jj,jk) > 0._wp ) THEN 
    287                         zrw = ( gdept(ji,jj,jk,Kmm) - gdepw(ji,jj,jk,Kmm) ) / e3w(ji,jj,jk,Kmm) 
    288                         ! 
    289                         zaw = rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem)* zrw 
    290                         zbw = rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal)* zrw 
    291                         ! 
    292                         zpe(ji, jj) = zpe(ji,jj)   & 
    293                            &        -  grav * (  avt(ji,jj,jk) * zaw * (ts(ji,jj,jk-1,jp_tem,Kmm) - ts(ji,jj,jk,jp_tem,Kmm) )  & 
    294                            &                   - avs(ji,jj,jk) * zbw * (ts(ji,jj,jk-1,jp_sal,Kmm) - ts(ji,jj,jk,jp_sal,Kmm) ) ) 
    295                      ENDIF 
    296                   END DO 
    297                END DO 
    298              END DO 
     274            DO_3D_11_11( 2, jpk ) 
     275               IF( rn2(ji,jj,jk) > 0._wp ) THEN 
     276                  zrw = ( gdept(ji,jj,jk,Kmm) - gdepw(ji,jj,jk,Kmm) ) / e3w(ji,jj,jk,Kmm) 
     277                  ! 
     278                  zaw = rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem)* zrw 
     279                  zbw = rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal)* zrw 
     280                  ! 
     281                  zpe(ji, jj) = zpe(ji,jj)   & 
     282                     &        -  grav * (  avt(ji,jj,jk) * zaw * (ts(ji,jj,jk-1,jp_tem,Kmm) - ts(ji,jj,jk,jp_tem,Kmm) )  & 
     283                     &                   - avs(ji,jj,jk) * zbw * (ts(ji,jj,jk-1,jp_sal,Kmm) - ts(ji,jj,jk,jp_sal,Kmm) ) ) 
     284               ENDIF 
     285            END_3D 
    299286          ELSE 
    300             DO jk = 1, jpk 
    301                DO jj = 1, jpj 
    302                   DO ji = 1, jpi 
    303                      zpe(ji,jj) = zpe(ji,jj) + avt(ji,jj,jk) * MIN(0._wp,rn2(ji,jj,jk)) * rau0 * e3w(ji,jj,jk,Kmm) 
    304                   END DO 
    305                END DO 
    306             END DO 
     287            DO_3D_11_11( 1, jpk ) 
     288               zpe(ji,jj) = zpe(ji,jj) + avt(ji,jj,jk) * MIN(0._wp,rn2(ji,jj,jk)) * rau0 * e3w(ji,jj,jk,Kmm) 
     289            END_3D 
    307290         ENDIF 
    308291          CALL iom_put( 'tnpeo', zpe ) 
    … …  
    338321     
    339322      z2d(:,:) = puflx(:,:,1)  
    340       DO jk = 1, jpkm1 
    341          DO jj = 2, jpjm1 
    342             DO ji = fs_2, fs_jpim1   ! vector opt. 
    343                z2d(ji,jj) = z2d(ji,jj) + puflx(ji,jj,jk)  
    344             END DO 
    345          END DO 
    346        END DO 
     323      DO_3D_00_00( 1, jpkm1 ) 
     324         z2d(ji,jj) = z2d(ji,jj) + puflx(ji,jj,jk)  
     325      END_3D 
    347326       CALL lbc_lnk( 'diaar5', z2d, 'U', -1. ) 
    348327       IF( cptr == 'adv' ) THEN 
    … …  
    356335       ! 
    357336       z2d(:,:) = pvflx(:,:,1)  
    358        DO jk = 1, jpkm1 
    359           DO jj = 2, jpjm1 
    360              DO ji = fs_2, fs_jpim1   ! vector opt. 
    361                 z2d(ji,jj) = z2d(ji,jj) + pvflx(ji,jj,jk)  
    362              END DO 
    363           END DO 
    364        END DO 
     337       DO_3D_00_00( 1, jpkm1 ) 
     338          z2d(ji,jj) = z2d(ji,jj) + pvflx(ji,jj,jk)  
     339       END_3D 
    365340       CALL lbc_lnk( 'diaar5', z2d, 'V', -1. ) 
    366341       IF( cptr == 'adv' ) THEN 
    … …  
    407382         zvol0 (:,:) = 0._wp 
    408383         thick0(:,:) = 0._wp 
    409          DO jk = 1, jpkm1 
    410             DO jj = 1, jpj               ! interpolation of salinity at the last ocean level (i.e. the partial step) 
    411                DO ji = 1, jpi 
    412                   idep = tmask(ji,jj,jk) * e3t_0(ji,jj,jk) 
    413                   zvol0 (ji,jj) = zvol0 (ji,jj) +  idep * area(ji,jj) 
    414                   thick0(ji,jj) = thick0(ji,jj) +  idep     
    415                END DO 
    416             END DO 
    417          END DO 
     384         DO_3D_11_11( 1, jpkm1 ) 
     385            idep = tmask(ji,jj,jk) * e3t_0(ji,jj,jk) 
     386            zvol0 (ji,jj) = zvol0 (ji,jj) +  idep * area(ji,jj) 
     387            thick0(ji,jj) = thick0(ji,jj) +  idep     
     388         END_3D 
    418389         vol0 = glob_sum( 'diaar5', zvol0 ) 
    419390         DEALLOCATE( zvol0 ) 
    … …  
    429400            sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:) 
    430401            IF( ln_zps ) THEN               ! z-coord. partial steps 
    431                DO jj = 1, jpj               ! interpolation of salinity at the last ocean level (i.e. the partial step) 
    432                   DO ji = 1, jpi 
    433                      ik = mbkt(ji,jj) 
    434                      IF( ik > 1 ) THEN 
    435                         zztmp = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 
    436                         sn0(ji,jj,ik) = ( 1._wp - zztmp ) * sn0(ji,jj,ik) + zztmp * sn0(ji,jj,ik-1) 
    437                      ENDIF 
    438                   END DO 
    439                END DO 
     402               DO_2D_11_11 
     403                  ik = mbkt(ji,jj) 
     404                  IF( ik > 1 ) THEN 
     405                     zztmp = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 
     406                     sn0(ji,jj,ik) = ( 1._wp - zztmp ) * sn0(ji,jj,ik) + zztmp * sn0(ji,jj,ik-1) 
     407                  ENDIF 
     408               END_2D 
    440409            ENDIF 
    441410            ! 

  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DIA/diacfl.F90

    r11949 r12340  
    3434   !! * Substitutions 
    3535#  include "vectopt_loop_substitute.h90" 
     36#  include "do_loop_substitute.h90" 
    3637   !!---------------------------------------------------------------------- 
    3738   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    6566      ! 
    6667      !                 
    67       DO jk = 1, jpk       ! calculate Courant numbers 
    68          DO jj = 1, jpj 
    69             DO ji = 1, jpi 
    70                zCu_cfl(ji,jj,jk) = ABS( uu(ji,jj,jk,Kmm) ) * z2dt / e1u  (ji,jj)      ! for i-direction 
    71                zCv_cfl(ji,jj,jk) = ABS( vv(ji,jj,jk,Kmm) ) * z2dt / e2v  (ji,jj)      ! for j-direction 
    72                zCw_cfl(ji,jj,jk) = ABS( ww(ji,jj,jk) ) * z2dt / e3w(ji,jj,jk,Kmm)   ! for k-direction 
    73             END DO 
    74          END DO          
    75       END DO 
     68      DO_3D_11_11( 1, jpk ) 
     69         zCu_cfl(ji,jj,jk) = ABS( uu(ji,jj,jk,Kmm) ) * z2dt / e1u  (ji,jj)      ! for i-direction 
     70         zCv_cfl(ji,jj,jk) = ABS( vv(ji,jj,jk,Kmm) ) * z2dt / e2v  (ji,jj)      ! for j-direction 
     71         zCw_cfl(ji,jj,jk) = ABS( ww(ji,jj,jk) ) * z2dt / e3w(ji,jj,jk,Kmm)   ! for k-direction 
     72      END_3D 
    7673      ! 
    7774      ! write outputs 

  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DIA/diahth.F90

    r12193 r12340  
    4040 
    4141 
     42   !! * Substitutions 
     43#  include "do_loop_substitute.h90" 
    4244   !!---------------------------------------------------------------------- 
    4345   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    127129            zdepinv(:,:) = 0._wp   
    128130            zmaxdzT(:,:) = 0._wp   
    129             DO jj = 1, jpj 
    130                DO ji = 1, jpi 
     131            DO_2D_11_11 
     132               zztmp = gdepw(ji,jj,mbkt(ji,jj)+1,Kmm)  
     133               hth     (ji,jj) = zztmp 
     134               zabs2   (ji,jj) = zztmp 
     135               ztm2    (ji,jj) = zztmp 
     136               zrho10_3(ji,jj) = zztmp 
     137               zpycn   (ji,jj) = zztmp 
     138            END_2D 
     139            IF( nla10 > 1 ) THEN  
     140               DO_2D_11_11 
    131141                  zztmp = gdepw(ji,jj,mbkt(ji,jj)+1,Kmm)  
    132                   hth     (ji,jj) = zztmp 
    133                   zabs2   (ji,jj) = zztmp 
    134                   ztm2    (ji,jj) = zztmp 
    135                   zrho10_3(ji,jj) = zztmp 
    136                   zpycn   (ji,jj) = zztmp 
    137                  END DO 
    138             END DO 
    139             IF( nla10 > 1 ) THEN  
    140                DO jj = 1, jpj 
    141                   DO ji = 1, jpi 
    142                      zztmp = gdepw(ji,jj,mbkt(ji,jj)+1,Kmm)  
    143                      zrho0_3(ji,jj) = zztmp 
    144                      zrho0_1(ji,jj) = zztmp 
    145                   END DO 
    146                END DO 
     142                  zrho0_3(ji,jj) = zztmp 
     143                  zrho0_1(ji,jj) = zztmp 
     144               END_2D 
    147145            ENDIF 
    148146       
    149147            ! Preliminary computation 
    150148            ! computation of zdelr = (dr/dT)(T,S,10m)*(-0.2 degC) 
    151             DO jj = 1, jpj 
    152                DO ji = 1, jpi 
    153                   IF( tmask(ji,jj,nla10) == 1. ) THEN 
    154                      zu  =  1779.50 + 11.250 * ts(ji,jj,nla10,jp_tem,Kmm) - 3.80   * ts(ji,jj,nla10,jp_sal,Kmm)  & 
    155                         &           - 0.0745 * ts(ji,jj,nla10,jp_tem,Kmm) * ts(ji,jj,nla10,jp_tem,Kmm)   & 
    156                         &           - 0.0100 * ts(ji,jj,nla10,jp_tem,Kmm) * ts(ji,jj,nla10,jp_sal,Kmm) 
    157                      zv  =  5891.00 + 38.000 * ts(ji,jj,nla10,jp_tem,Kmm) + 3.00   * ts(ji,jj,nla10,jp_sal,Kmm)  & 
    158                         &           - 0.3750 * ts(ji,jj,nla10,jp_tem,Kmm) * ts(ji,jj,nla10,jp_tem,Kmm) 
    159                      zut =    11.25 -  0.149 * ts(ji,jj,nla10,jp_tem,Kmm) - 0.01   * ts(ji,jj,nla10,jp_sal,Kmm) 
    160                      zvt =    38.00 -  0.750 * ts(ji,jj,nla10,jp_tem,Kmm) 
    161                      zw  = (zu + 0.698*zv) * (zu + 0.698*zv) 
    162                      zdelr(ji,jj) = ztem2 * (1000.*(zut*zv - zvt*zu)/zw) 
    163                   ELSE 
    164                      zdelr(ji,jj) = 0._wp 
    165                   ENDIF 
    166                END DO 
    167             END DO 
     149            DO_2D_11_11 
     150               IF( tmask(ji,jj,nla10) == 1. ) THEN 
     151                  zu  =  1779.50 + 11.250 * ts(ji,jj,nla10,jp_tem,Kmm) - 3.80   * ts(ji,jj,nla10,jp_sal,Kmm)  & 
     152                     &           - 0.0745 * ts(ji,jj,nla10,jp_tem,Kmm) * ts(ji,jj,nla10,jp_tem,Kmm)   & 
     153                     &           - 0.0100 * ts(ji,jj,nla10,jp_tem,Kmm) * ts(ji,jj,nla10,jp_sal,Kmm) 
     154                  zv  =  5891.00 + 38.000 * ts(ji,jj,nla10,jp_tem,Kmm) + 3.00   * ts(ji,jj,nla10,jp_sal,Kmm)  & 
     155                     &           - 0.3750 * ts(ji,jj,nla10,jp_tem,Kmm) * ts(ji,jj,nla10,jp_tem,Kmm) 
     156                  zut =    11.25 -  0.149 * ts(ji,jj,nla10,jp_tem,Kmm) - 0.01   * ts(ji,jj,nla10,jp_sal,Kmm) 
     157                  zvt =    38.00 -  0.750 * ts(ji,jj,nla10,jp_tem,Kmm) 
     158                  zw  = (zu + 0.698*zv) * (zu + 0.698*zv) 
     159                  zdelr(ji,jj) = ztem2 * (1000.*(zut*zv - zvt*zu)/zw) 
     160               ELSE 
     161                  zdelr(ji,jj) = 0._wp 
     162               ENDIF 
     163            END_2D 
    168164 
    169165            ! ------------------------------------------------------------- ! 
    … …  
    173169            ! MLD: rho = rho(1) + zrho1                                     ! 
    174170            ! ------------------------------------------------------------- ! 
    175             DO jk = jpkm1, 2, -1   ! loop from bottom to 2 
    176                DO jj = 1, jpj 
    177                   DO ji = 1, jpi 
    178                      ! 
    179                      zzdep = gdepw(ji,jj,jk,Kmm) 
    180                      zztmp = ( ts(ji,jj,jk-1,jp_tem,Kmm) - ts(ji,jj,jk,jp_tem,Kmm) ) & 
    181                             & / zzdep * tmask(ji,jj,jk)   ! vertical gradient of temperature (dT/dz) 
    182                      zzdep = zzdep * tmask(ji,jj,1) 
    183  
    184                      IF( zztmp > zmaxdzT(ji,jj) ) THEN                         
    185                          zmaxdzT(ji,jj) = zztmp    
    186                          hth    (ji,jj) = zzdep                ! max and depth of dT/dz 
    187                      ENDIF 
    188                 
    189                      IF( nla10 > 1 ) THEN  
    190                         zztmp = rhop(ji,jj,jk) - rhop(ji,jj,1)                       ! delta rho(1) 
    191                         IF( zztmp > zrho3 )   zrho0_3(ji,jj) = zzdep                ! > 0.03 
    192                         IF( zztmp > zrho1 )   zrho0_1(ji,jj) = zzdep                ! > 0.01 
    193                      ENDIF 
    194                   END DO 
    195                END DO 
    196             END DO 
     171            DO_3DS_11_11( jpkm1, 2, -1 ) 
     172               ! 
     173               zzdep = gdepw(ji,jj,jk,Kmm) 
     174               zztmp = ( ts(ji,jj,jk-1,jp_tem,Kmm) - ts(ji,jj,jk,jp_tem,Kmm) ) & 
     175                      & / zzdep * tmask(ji,jj,jk)   ! vertical gradient of temperature (dT/dz) 
     176               zzdep = zzdep * tmask(ji,jj,1) 
     177 
     178               IF( zztmp > zmaxdzT(ji,jj) ) THEN                         
     179                   zmaxdzT(ji,jj) = zztmp    
     180                   hth    (ji,jj) = zzdep                ! max and depth of dT/dz 
     181               ENDIF 
     182          
     183               IF( nla10 > 1 ) THEN  
     184                  zztmp = rhop(ji,jj,jk) - rhop(ji,jj,1)                       ! delta rho(1) 
     185                  IF( zztmp > zrho3 )   zrho0_3(ji,jj) = zzdep                ! > 0.03 
     186                  IF( zztmp > zrho1 )   zrho0_1(ji,jj) = zzdep                ! > 0.01 
     187               ENDIF 
     188            END_3D 
    197189          
    198190            CALL iom_put( 'mlddzt', hth )            ! depth of the thermocline 
    … …  
    214206            ! depth of temperature inversion                                ! 
    215207            ! ------------------------------------------------------------- ! 
    216             DO jk = jpkm1, nlb10, -1   ! loop from bottom to nlb10 
    217                DO jj = 1, jpj 
    218                   DO ji = 1, jpi 
    219                      ! 
    220                      zzdep = gdepw(ji,jj,jk,Kmm) * tmask(ji,jj,1) 
    221                      ! 
    222                      zztmp = ts(ji,jj,nla10,jp_tem,Kmm) - ts(ji,jj,jk,jp_tem,Kmm)  ! - delta T(10m) 
    223                      IF( ABS(zztmp) > ztem2 )      zabs2   (ji,jj) = zzdep   ! abs > 0.2 
    224                      IF(     zztmp  > ztem2 )      ztm2    (ji,jj) = zzdep   ! > 0.2 
    225                      zztmp = -zztmp                                          ! delta T(10m) 
    226                      IF( zztmp >  ztinv(ji,jj) ) THEN                        ! temperature inversion 
    227                         ztinv(ji,jj) = zztmp    
    228                         zdepinv (ji,jj) = zzdep   ! max value and depth 
    229                      ENDIF 
    230  
    231                      zztmp = rhop(ji,jj,jk) - rhop(ji,jj,nla10)              ! delta rho(10m) 
    232                      IF( zztmp > zrho3        )    zrho10_3(ji,jj) = zzdep   ! > 0.03 
    233                      IF( zztmp > zdelr(ji,jj) )    zpycn   (ji,jj) = zzdep   ! > equi. delta T(10m) - 0.2 
    234                      ! 
    235                   END DO 
    236                END DO 
    237             END DO 
     208            DO_3DS_11_11( jpkm1, nlb10, -1 ) 
     209               ! 
     210               zzdep = gdepw(ji,jj,jk,Kmm) * tmask(ji,jj,1) 
     211               ! 
     212               zztmp = ts(ji,jj,nla10,jp_tem,Kmm) - ts(ji,jj,jk,jp_tem,Kmm)  ! - delta T(10m) 
     213               IF( ABS(zztmp) > ztem2 )      zabs2   (ji,jj) = zzdep   ! abs > 0.2 
     214               IF(     zztmp  > ztem2 )      ztm2    (ji,jj) = zzdep   ! > 0.2 
     215               zztmp = -zztmp                                          ! delta T(10m) 
     216               IF( zztmp >  ztinv(ji,jj) ) THEN                        ! temperature inversion 
     217                  ztinv(ji,jj) = zztmp    
     218                  zdepinv (ji,jj) = zzdep   ! max value and depth 
     219               ENDIF 
     220 
     221               zztmp = rhop(ji,jj,jk) - rhop(ji,jj,nla10)              ! delta rho(10m) 
     222               IF( zztmp > zrho3        )    zrho10_3(ji,jj) = zzdep   ! > 0.03 
     223               IF( zztmp > zdelr(ji,jj) )    zpycn   (ji,jj) = zzdep   ! > equi. delta T(10m) - 0.2 
     224               ! 
     225            END_3D 
    238226 
    239227            CALL iom_put( 'mld_dt02', zabs2    )   ! MLD abs(delta t) - 0.2 
    … …  
    316304      ! --------------------------------------- ! 
    317305      iktem(:,:) = 1 
    318       DO jk = 1, jpkm1   ! beware temperature is not always decreasing with depth => loop from top to bottom 
    319          DO jj = 1, jpj 
    320             DO ji = 1, jpi 
    321                zztmp = ts(ji,jj,jk,jp_tem,Kmm) 
    322                IF( zztmp >= ptem )   iktem(ji,jj) = jk 
    323             END DO 
    324          END DO 
    325       END DO 
     306      DO_3D_11_11( 1, jpkm1 ) 
     307         zztmp = ts(ji,jj,jk,jp_tem,Kmm) 
     308         IF( zztmp >= ptem )   iktem(ji,jj) = jk 
     309      END_3D 
    326310 
    327311      ! ------------------------------- ! 
    328312      !  Depth of ptem isotherm         ! 
    329313      ! ------------------------------- ! 
    330       DO jj = 1, jpj 
    331          DO ji = 1, jpi 
    332             ! 
    333             zzdep = gdepw(ji,jj,mbkt(ji,jj)+1,Kmm)       ! depth of the ocean bottom 
    334             ! 
    335             iid = iktem(ji,jj) 
    336             IF( iid /= 1 ) THEN  
    337                 zztmp =     gdept(ji,jj,iid  ,Kmm)   &                     ! linear interpolation 
    338                   &  + (    gdept(ji,jj,iid+1,Kmm) - gdept(ji,jj,iid,Kmm)                       )   & 
    339                   &  * ( 20.*tmask(ji,jj,iid+1) - ts(ji,jj,iid,jp_tem,Kmm)                       )   & 
    340                   &  / ( ts(ji,jj,iid+1,jp_tem,Kmm) - ts(ji,jj,iid,jp_tem,Kmm) + (1.-tmask(ji,jj,1)) ) 
    341                pdept(ji,jj) = MIN( zztmp , zzdep) * tmask(ji,jj,1)       ! bound by the ocean depth 
    342             ELSE  
    343                pdept(ji,jj) = 0._wp 
    344             ENDIF 
    345          END DO 
    346       END DO 
     314      DO_2D_11_11 
     315         ! 
     316         zzdep = gdepw(ji,jj,mbkt(ji,jj)+1,Kmm)       ! depth of the ocean bottom 
     317         ! 
     318         iid = iktem(ji,jj) 
     319         IF( iid /= 1 ) THEN  
     320             zztmp =     gdept(ji,jj,iid  ,Kmm)   &                     ! linear interpolation 
     321               &  + (    gdept(ji,jj,iid+1,Kmm) - gdept(ji,jj,iid,Kmm)                       )   & 
     322               &  * ( 20.*tmask(ji,jj,iid+1) - ts(ji,jj,iid,jp_tem,Kmm)                       )   & 
     323               &  / ( ts(ji,jj,iid+1,jp_tem,Kmm) - ts(ji,jj,iid,jp_tem,Kmm) + (1.-tmask(ji,jj,1)) ) 
     324            pdept(ji,jj) = MIN( zztmp , zzdep) * tmask(ji,jj,1)       ! bound by the ocean depth 
     325         ELSE  
     326            pdept(ji,jj) = 0._wp 
     327         ENDIF 
     328      END_2D 
    347329      ! 
    348330   END SUBROUTINE dia_hth_dep 
    … …  
    368350      ! 
    369351      ilevel(:,:) = 1 
    370       DO jk = 2, jpkm1 
    371          DO jj = 1, jpj 
    372             DO ji = 1, jpi 
    373                IF( ( gdept(ji,jj,jk,Kmm) < pdep ) .AND. ( tmask(ji,jj,jk) == 1 ) ) THEN 
    374                    ilevel(ji,jj) = jk 
    375                    zthick(ji,jj) = zthick(ji,jj) + e3t(ji,jj,jk,Kmm) 
    376                    phtc  (ji,jj) = phtc  (ji,jj) + e3t(ji,jj,jk,Kmm) * pt(ji,jj,jk) 
    377                ENDIF 
    378             ENDDO 
    379          ENDDO 
    380       ENDDO 
    381       ! 
    382       DO jj = 1, jpj 
    383          DO ji = 1, jpi 
    384             ik = ilevel(ji,jj) 
    385             zthick(ji,jj) = pdep - zthick(ji,jj)   !   remaining thickness to reach depht pdep 
    386             phtc(ji,jj)   = phtc(ji,jj) + pt(ji,jj,ik+1) * MIN( e3t(ji,jj,ik+1,Kmm), zthick(ji,jj) ) & 
    387                                                           * tmask(ji,jj,ik+1) 
    388          END DO 
    389       ENDDO 
     352      DO_3D_11_11( 2, jpkm1 ) 
     353         IF( ( gdept(ji,jj,jk,Kmm) < pdep ) .AND. ( tmask(ji,jj,jk) == 1 ) ) THEN 
     354             ilevel(ji,jj) = jk 
     355             zthick(ji,jj) = zthick(ji,jj) + e3t(ji,jj,jk,Kmm) 
     356             phtc  (ji,jj) = phtc  (ji,jj) + e3t(ji,jj,jk,Kmm) * pt(ji,jj,jk) 
     357         ENDIF 
     358      END_3D 
     359      ! 
     360      DO_2D_11_11 
     361         ik = ilevel(ji,jj) 
     362         zthick(ji,jj) = pdep - zthick(ji,jj)   !   remaining thickness to reach depht pdep 
     363         phtc(ji,jj)   = phtc(ji,jj) + pt(ji,jj,ik+1) * MIN( e3t(ji,jj,ik+1,Kmm), zthick(ji,jj) ) & 
     364                                                       * tmask(ji,jj,ik+1) 
     365      END_2D 
    390366      ! 
    391367      ! 

  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DIA/diamlr.F90

    r12229 r12340  
    2323   PUBLIC ::   dia_mlr_init, dia_mlr_iom_init, dia_mlr 
    2424 
     25   !! * Substitutions 
     26#  include "do_loop_substitute.h90" 
    2527   !!---------------------------------------------------------------------- 
    2628   !! NEMO/OCE 4.0 , NEMO Consortium (2019) 

  • 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 

  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DIA/diawri.F90

    r12252 r12340  
    8585   !! * Substitutions 
    8686#  include "vectopt_loop_substitute.h90" 
     87#  include "do_loop_substitute.h90" 
    8788   !!---------------------------------------------------------------------- 
    8889   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    155156      CALL iom_put(  "sst", ts(:,:,1,jp_tem,Kmm) )    ! surface temperature 
    156157      IF ( iom_use("sbt") ) THEN 
    157          DO jj = 1, jpj 
    158             DO ji = 1, jpi 
    159                ikbot = mbkt(ji,jj) 
    160                z2d(ji,jj) = ts(ji,jj,ikbot,jp_tem,Kmm) 
    161             END DO 
    162          END DO 
     158         DO_2D_11_11 
     159            ikbot = mbkt(ji,jj) 
     160            z2d(ji,jj) = ts(ji,jj,ikbot,jp_tem,Kmm) 
     161         END_2D 
    163162         CALL iom_put( "sbt", z2d )                ! bottom temperature 
    164163      ENDIF 
    … …  
    167166      CALL iom_put(  "sss", ts(:,:,1,jp_sal,Kmm) )    ! surface salinity 
    168167      IF ( iom_use("sbs") ) THEN 
    169          DO jj = 1, jpj 
    170             DO ji = 1, jpi 
    171                ikbot = mbkt(ji,jj) 
    172                z2d(ji,jj) = ts(ji,jj,ikbot,jp_sal,Kmm) 
    173             END DO 
    174          END DO 
     168         DO_2D_11_11 
     169            ikbot = mbkt(ji,jj) 
     170            z2d(ji,jj) = ts(ji,jj,ikbot,jp_sal,Kmm) 
     171         END_2D 
    175172         CALL iom_put( "sbs", z2d )                ! bottom salinity 
    176173      ENDIF 
    … …  
    179176         zztmp = rau0 * 0.25 
    180177         z2d(:,:) = 0._wp 
    181          DO jj = 2, jpjm1 
    182             DO ji = fs_2, fs_jpim1   ! vector opt. 
    183                zztmp2 = (  ( rCdU_bot(ji+1,jj)+rCdU_bot(ji  ,jj) ) * uu(ji  ,jj,mbku(ji  ,jj),Kmm)  )**2   & 
    184                   &   + (  ( rCdU_bot(ji  ,jj)+rCdU_bot(ji-1,jj) ) * uu(ji-1,jj,mbku(ji-1,jj),Kmm)  )**2   & 
    185                   &   + (  ( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj  ) ) * vv(ji,jj  ,mbkv(ji,jj  ),Kmm)  )**2   & 
    186                   &   + (  ( rCdU_bot(ji,jj  )+rCdU_bot(ji,jj-1) ) * vv(ji,jj-1,mbkv(ji,jj-1),Kmm)  )**2 
    187                z2d(ji,jj) = zztmp * SQRT( zztmp2 ) * tmask(ji,jj,1)  
    188                ! 
    189             END DO 
    190          END DO 
     178         DO_2D_00_00 
     179            zztmp2 = (  ( rCdU_bot(ji+1,jj)+rCdU_bot(ji  ,jj) ) * uu(ji  ,jj,mbku(ji  ,jj),Kmm)  )**2   & 
     180               &   + (  ( rCdU_bot(ji  ,jj)+rCdU_bot(ji-1,jj) ) * uu(ji-1,jj,mbku(ji-1,jj),Kmm)  )**2   & 
     181               &   + (  ( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj  ) ) * vv(ji,jj  ,mbkv(ji,jj  ),Kmm)  )**2   & 
     182               &   + (  ( rCdU_bot(ji,jj  )+rCdU_bot(ji,jj-1) ) * vv(ji,jj-1,mbkv(ji,jj-1),Kmm)  )**2 
     183            z2d(ji,jj) = zztmp * SQRT( zztmp2 ) * tmask(ji,jj,1)  
     184            ! 
     185         END_2D 
    191186         CALL lbc_lnk( 'diawri', z2d, 'T', 1. ) 
    192187         CALL iom_put( "taubot", z2d )            
    … …  
    196191      CALL iom_put(  "ssu", uu(:,:,1,Kmm) )            ! surface i-current 
    197192      IF ( iom_use("sbu") ) THEN 
    198          DO jj = 1, jpj 
    199             DO ji = 1, jpi 
    200                ikbot = mbku(ji,jj) 
    201                z2d(ji,jj) = uu(ji,jj,ikbot,Kmm) 
    202             END DO 
    203          END DO 
     193         DO_2D_11_11 
     194            ikbot = mbku(ji,jj) 
     195            z2d(ji,jj) = uu(ji,jj,ikbot,Kmm) 
     196         END_2D 
    204197         CALL iom_put( "sbu", z2d )                ! bottom i-current 
    205198      ENDIF 
    … …  
    208201      CALL iom_put(  "ssv", vv(:,:,1,Kmm) )            ! surface j-current 
    209202      IF ( iom_use("sbv") ) THEN 
    210          DO jj = 1, jpj 
    211             DO ji = 1, jpi 
    212                ikbot = mbkv(ji,jj) 
    213                z2d(ji,jj) = vv(ji,jj,ikbot,Kmm) 
    214             END DO 
    215          END DO 
     203         DO_2D_11_11 
     204            ikbot = mbkv(ji,jj) 
     205            z2d(ji,jj) = vv(ji,jj,ikbot,Kmm) 
     206         END_2D 
    216207         CALL iom_put( "sbv", z2d )                ! bottom j-current 
    217208      ENDIF 
    … …  
    240231 
    241232      IF ( iom_use("sstgrad") .OR. iom_use("sstgrad2") ) THEN 
    242          DO jj = 2, jpjm1                                    ! sst gradient 
    243             DO ji = fs_2, fs_jpim1   ! vector opt. 
    244                zztmp  = ts(ji,jj,1,jp_tem,Kmm) 
    245                zztmpx = ( ts(ji+1,jj,1,jp_tem,Kmm) - zztmp ) * r1_e1u(ji,jj) + ( zztmp - ts(ji-1,jj  ,1,jp_tem,Kmm) ) * r1_e1u(ji-1,jj) 
    246                zztmpy = ( ts(ji,jj+1,1,jp_tem,Kmm) - zztmp ) * r1_e2v(ji,jj) + ( zztmp - ts(ji  ,jj-1,1,jp_tem,Kmm) ) * r1_e2v(ji,jj-1) 
    247                z2d(ji,jj) = 0.25 * ( zztmpx * zztmpx + zztmpy * zztmpy )   & 
    248                   &              * umask(ji,jj,1) * umask(ji-1,jj,1) * vmask(ji,jj,1) * umask(ji,jj-1,1) 
    249             END DO 
    250          END DO 
     233         DO_2D_00_00 
     234            zztmp  = ts(ji,jj,1,jp_tem,Kmm) 
     235            zztmpx = ( ts(ji+1,jj,1,jp_tem,Kmm) - zztmp ) * r1_e1u(ji,jj) + ( zztmp - ts(ji-1,jj  ,1,jp_tem,Kmm) ) * r1_e1u(ji-1,jj) 
     236            zztmpy = ( ts(ji,jj+1,1,jp_tem,Kmm) - zztmp ) * r1_e2v(ji,jj) + ( zztmp - ts(ji  ,jj-1,1,jp_tem,Kmm) ) * r1_e2v(ji,jj-1) 
     237            z2d(ji,jj) = 0.25 * ( zztmpx * zztmpx + zztmpy * zztmpy )   & 
     238               &              * umask(ji,jj,1) * umask(ji-1,jj,1) * vmask(ji,jj,1) * umask(ji,jj-1,1) 
     239         END_2D 
    251240         CALL lbc_lnk( 'diawri', z2d, 'T', 1. ) 
    252241         CALL iom_put( "sstgrad2",  z2d )          ! square of module of sst gradient 
    … …  
    258247      IF( iom_use("heatc") ) THEN 
    259248         z2d(:,:)  = 0._wp  
    260          DO jk = 1, jpkm1 
    261             DO jj = 1, jpj 
    262                DO ji = 1, jpi 
    263                   z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_tem,Kmm) * tmask(ji,jj,jk) 
    264                END DO 
    265             END DO 
    266          END DO 
     249         DO_3D_11_11( 1, jpkm1 ) 
     250            z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_tem,Kmm) * tmask(ji,jj,jk) 
     251         END_3D 
    267252         CALL iom_put( "heatc", rau0_rcp * z2d )   ! vertically integrated heat content (J/m2) 
    268253      ENDIF 
    … …  
    270255      IF( iom_use("saltc") ) THEN 
    271256         z2d(:,:)  = 0._wp  
    272          DO jk = 1, jpkm1 
    273             DO jj = 1, jpj 
    274                DO ji = 1, jpi 
    275                   z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) * tmask(ji,jj,jk) 
    276                END DO 
    277             END DO 
    278          END DO 
     257         DO_3D_11_11( 1, jpkm1 ) 
     258            z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) * tmask(ji,jj,jk) 
     259         END_3D 
    279260         CALL iom_put( "saltc", rau0 * z2d )          ! vertically integrated salt content (PSU*kg/m2) 
    280261      ENDIF 
    … …  
    282263      IF ( iom_use("eken") ) THEN 
    283264         z3d(:,:,jpk) = 0._wp  
    284          DO jk = 1, jpkm1 
    285             DO jj = 2, jpjm1 
    286                DO ji = fs_2, fs_jpim1   ! vector opt. 
    287                   zztmp  = 0.25_wp * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 
    288                   z3d(ji,jj,jk) = zztmp * (  uu(ji-1,jj,jk,Kmm)**2 * e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm)   & 
    289                      &                     + uu(ji  ,jj,jk,Kmm)**2 * e2u(ji  ,jj) * e3u(ji  ,jj,jk,Kmm)   & 
    290                      &                     + vv(ji,jj-1,jk,Kmm)**2 * e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm)   & 
    291                      &                     + vv(ji,jj  ,jk,Kmm)**2 * e1v(ji,jj  ) * e3v(ji,jj  ,jk,Kmm)   ) 
    292                END DO 
    293             END DO 
    294          END DO 
     265         DO_3D_00_00( 1, jpkm1 ) 
     266            zztmp  = 0.25_wp * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 
     267            z3d(ji,jj,jk) = zztmp * (  uu(ji-1,jj,jk,Kmm)**2 * e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm)   & 
     268               &                     + uu(ji  ,jj,jk,Kmm)**2 * e2u(ji  ,jj) * e3u(ji  ,jj,jk,Kmm)   & 
     269               &                     + vv(ji,jj-1,jk,Kmm)**2 * e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm)   & 
     270               &                     + vv(ji,jj  ,jk,Kmm)**2 * e1v(ji,jj  ) * e3v(ji,jj  ,jk,Kmm)   ) 
     271         END_3D 
    295272         CALL lbc_lnk( 'diawri', z3d, 'T', 1. ) 
    296273         CALL iom_put( "eken", z3d )                 ! kinetic energy 
    … …  
    312289      IF( iom_use("u_heattr") ) THEN 
    313290         z2d(:,:) = 0._wp  
    314          DO jk = 1, jpkm1 
    315             DO jj = 2, jpjm1 
    316                DO ji = fs_2, fs_jpim1   ! vector opt. 
    317                   z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji+1,jj,jk,jp_tem,Kmm) ) 
    318                END DO 
    319             END DO 
    320          END DO 
     291         DO_3D_00_00( 1, jpkm1 ) 
     292            z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji+1,jj,jk,jp_tem,Kmm) ) 
     293         END_3D 
    321294         CALL lbc_lnk( 'diawri', z2d, 'U', -1. ) 
    322295         CALL iom_put( "u_heattr", 0.5*rcp * z2d )    ! heat transport in i-direction 
    … …  
    325298      IF( iom_use("u_salttr") ) THEN 
    326299         z2d(:,:) = 0.e0  
    327          DO jk = 1, jpkm1 
    328             DO jj = 2, jpjm1 
    329                DO ji = fs_2, fs_jpim1   ! vector opt. 
    330                   z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji+1,jj,jk,jp_sal,Kmm) ) 
    331                END DO 
    332             END DO 
    333          END DO 
     300         DO_3D_00_00( 1, jpkm1 ) 
     301            z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji+1,jj,jk,jp_sal,Kmm) ) 
     302         END_3D 
    334303         CALL lbc_lnk( 'diawri', z2d, 'U', -1. ) 
    335304         CALL iom_put( "u_salttr", 0.5 * z2d )        ! heat transport in i-direction 
    … …  
    347316      IF( iom_use("v_heattr") ) THEN 
    348317         z2d(:,:) = 0.e0  
    349          DO jk = 1, jpkm1 
    350             DO jj = 2, jpjm1 
    351                DO ji = fs_2, fs_jpim1   ! vector opt. 
    352                   z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji,jj+1,jk,jp_tem,Kmm) ) 
    353                END DO 
    354             END DO 
    355          END DO 
     318         DO_3D_00_00( 1, jpkm1 ) 
     319            z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji,jj+1,jk,jp_tem,Kmm) ) 
     320         END_3D 
    356321         CALL lbc_lnk( 'diawri', z2d, 'V', -1. ) 
    357322         CALL iom_put( "v_heattr", 0.5*rcp * z2d )    !  heat transport in j-direction 
    … …  
    360325      IF( iom_use("v_salttr") ) THEN 
    361326         z2d(:,:) = 0._wp  
    362          DO jk = 1, jpkm1 
    363             DO jj = 2, jpjm1 
    364                DO ji = fs_2, fs_jpim1   ! vector opt. 
    365                   z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji,jj+1,jk,jp_sal,Kmm) ) 
    366                END DO 
    367             END DO 
    368          END DO 
     327         DO_3D_00_00( 1, jpkm1 ) 
     328            z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji,jj+1,jk,jp_sal,Kmm) ) 
     329         END_3D 
    369330         CALL lbc_lnk( 'diawri', z2d, 'V', -1. ) 
    370331         CALL iom_put( "v_salttr", 0.5 * z2d )        !  heat transport in j-direction 
    … …  
    373334      IF( iom_use("tosmint") ) THEN 
    374335         z2d(:,:) = 0._wp 
    375          DO jk = 1, jpkm1 
    376             DO jj = 2, jpjm1 
    377                DO ji = fs_2, fs_jpim1   ! vector opt. 
    378                   z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) *  ts(ji,jj,jk,jp_tem,Kmm) 
    379                END DO 
    380             END DO 
    381          END DO 
     336         DO_3D_00_00( 1, jpkm1 ) 
     337            z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) *  ts(ji,jj,jk,jp_tem,Kmm) 
     338         END_3D 
    382339         CALL lbc_lnk( 'diawri', z2d, 'T', -1. ) 
    383340         CALL iom_put( "tosmint", rau0 * z2d )        ! Vertical integral of temperature 
    … …  
    385342      IF( iom_use("somint") ) THEN 
    386343         z2d(:,:)=0._wp 
    387          DO jk = 1, jpkm1 
    388             DO jj = 2, jpjm1 
    389                DO ji = fs_2, fs_jpim1   ! vector opt. 
    390                   z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) 
    391                END DO 
    392             END DO 
    393          END DO 
     344         DO_3D_00_00( 1, jpkm1 ) 
     345            z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) 
     346         END_3D 
    394347         CALL lbc_lnk( 'diawri', z2d, 'T', -1. ) 
    395348         CALL iom_put( "somint", rau0 * z2d )         ! Vertical integral of salinity 
Note: See TracChangeset for help on using the changeset viewer.