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 14852 – NEMO

Changeset 14852


Ignore:
Timestamp:
2021-05-12T15:05:29+02:00 (3 years ago)
Author:
mcastril
Message:

2021/HPC-11_mcastril_HPDAonline_DiagGPU: Update with trunk r14848

Location:
NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU
Files:
2 deleted
131 edited
5 copied

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/cfgs/AGRIF_DEMO/EXPREF/1_namelist_cfg

    r14789 r14852  
    4040      ln_closea    = .false.    !  F => suppress closed seas (defined by closea_mask field)  
    4141      !                         !       from the bathymetry at runtime. 
     42/ 
     43!----------------------------------------------------------------------- 
     44&namtile        !   parameters of the tiling 
     45!----------------------------------------------------------------------- 
    4246/ 
    4347!----------------------------------------------------------------------- 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/cfgs/AGRIF_DEMO/EXPREF/2_namelist_cfg

    r14789 r14852  
    3838   ln_read_cfg = .true.    !  (=T) read the domain configuration file 
    3939      cn_domcfg = "ORCA_R05_zps_domcfg_agrif"    ! domain configuration filename 
     40/ 
     41!----------------------------------------------------------------------- 
     42&namtile        !   parameters of the tiling 
     43!----------------------------------------------------------------------- 
    4044/ 
    4145!----------------------------------------------------------------------- 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/cfgs/AGRIF_DEMO/EXPREF/3_namelist_cfg

    r14789 r14852  
    3838   ln_read_cfg = .true.    !  (=T) read the domain configuration file 
    3939      cn_domcfg = "ORCA_R017_zps_domcfg_agrif"    ! domain configuration filename 
     40/ 
     41!----------------------------------------------------------------------- 
     42&namtile        !   parameters of the tiling 
     43!----------------------------------------------------------------------- 
    4044/ 
    4145!----------------------------------------------------------------------- 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/cfgs/AGRIF_DEMO/EXPREF/namelist_cfg

    r14789 r14852  
    4040      ln_closea    = .false.    !  F => suppress closed seas (defined by closea_mask field)  
    4141      !                         !       from the bathymetry at runtime. 
     42/ 
     43!----------------------------------------------------------------------- 
     44&namtile        !   parameters of the tiling 
     45!----------------------------------------------------------------------- 
    4246/ 
    4347!----------------------------------------------------------------------- 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/cfgs/AMM12/EXPREF/namelist_cfg

    r14789 r14852  
    4040   ln_read_cfg = .true.   !  (=T) read the domain configuration file 
    4141      cn_domcfg = "AMM_R12_sco_domcfg" ! domain configuration filename 
     42/ 
     43!----------------------------------------------------------------------- 
     44&namtile        !   parameters of the tiling 
     45!----------------------------------------------------------------------- 
    4246/ 
    4347!!====================================================================== 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/cfgs/C1D_PAPA/EXPREF/namelist_cfg

    r14789 r14852  
    5858/ 
    5959!----------------------------------------------------------------------- 
     60&namtile        !   parameters of the tiling 
     61!----------------------------------------------------------------------- 
     62/ 
     63!----------------------------------------------------------------------- 
    6064&namtsd        !    Temperature & Salinity Data  (init/dmp)             (default: OFF) 
    6165!----------------------------------------------------------------------- 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/cfgs/GYRE_BFM/EXPREF/namelist_cfg

    r14789 r14852  
    3232!----------------------------------------------------------------------- 
    3333   ln_read_cfg = .false.   !  (=F) user defined configuration           (F => create/check namusr_def) 
     34/ 
     35!----------------------------------------------------------------------- 
     36&namtile        !   parameters of the tiling 
     37!----------------------------------------------------------------------- 
    3438/ 
    3539!----------------------------------------------------------------------- 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/cfgs/GYRE_PISCES/EXPREF/namelist_cfg

    r14789 r14852  
    3232!----------------------------------------------------------------------- 
    3333   ln_read_cfg = .false.   !  (=F) user defined configuration           (F => create/check namusr_def) 
     34/ 
     35!----------------------------------------------------------------------- 
     36&namtile        !   parameters of the tiling 
     37!----------------------------------------------------------------------- 
    3438/ 
    3539!----------------------------------------------------------------------- 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/cfgs/ORCA2_ICE_ABL/EXPREF/namelist_cfg

    r14229 r14852  
    4141      ln_closea    = .false.    !  F => suppress closed seas (defined by closea_mask field)  
    4242      !                         !       from the bathymetry at runtime. 
     43/ 
     44!----------------------------------------------------------------------- 
     45&namtile        !   parameters of the tiling 
     46!----------------------------------------------------------------------- 
    4347/ 
    4448!----------------------------------------------------------------------- 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/cfgs/ORCA2_ICE_PISCES/EXPREF/namelist_cfg

    r14789 r14852  
    3838      ln_closea    = .false.    !  F => suppress closed seas (defined by closea_mask field)  
    3939      !                         !       from the bathymetry at runtime. 
     40/ 
     41!----------------------------------------------------------------------- 
     42&namtile        !   parameters of the tiling 
     43!----------------------------------------------------------------------- 
     44   ln_tile = .false.     !  Use tiling (T) or not (F) 
     45   nn_ltile_i = 10       !  Length of tiles in i 
     46   nn_ltile_j = 10       !  Length of tiles in j 
    4047/ 
    4148!----------------------------------------------------------------------- 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/cfgs/ORCA2_OFF_PISCES/EXPREF/namelist_cfg

    r14789 r14852  
    4343      cn_domcfg = "ORCA_R2_zps_domcfg"   ! domain configuration filename 
    4444      ! 
     45/ 
     46!----------------------------------------------------------------------- 
     47&namtile        !   parameters of the tiling 
     48!----------------------------------------------------------------------- 
    4549/ 
    4650!----------------------------------------------------------------------- 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/cfgs/ORCA2_OFF_TRC/EXPREF/namelist_cfg

    r14789 r14852  
    4242      cn_domcfg = "ORCA_R2_zps_domcfg"   ! domain configuration filename 
    4343      ! 
     44/ 
     45!----------------------------------------------------------------------- 
     46&namtile        !   parameters of the tiling 
     47!----------------------------------------------------------------------- 
    4448/ 
    4549!----------------------------------------------------------------------- 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/cfgs/ORCA2_SAS_ICE/EXPREF/namelist_cfg

    r14789 r14852  
    3535   ln_read_cfg = .true.    !  (=T) read the domain configuration file 
    3636      cn_domcfg = "ORCA_R2_zps_domcfg"    ! domain configuration filename 
     37/ 
     38!----------------------------------------------------------------------- 
     39&namtile        !   parameters of the tiling 
     40!----------------------------------------------------------------------- 
    3741/ 
    3842!!====================================================================== 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/cfgs/SPITZ12/EXPREF/namelist_cfg

    r14789 r14852  
    3636      !                    !  (=F) user defined configuration           (F => create/check namusr_def) 
    3737      cn_domcfg = "domain_cfg"  ! domain configuration filename 
     38/ 
     39!----------------------------------------------------------------------- 
     40&namtile        !   parameters of the tiling 
     41!----------------------------------------------------------------------- 
    3842/ 
    3943!----------------------------------------------------------------------- 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/cfgs/WED025/EXPREF/namelist_cfg

    r14789 r14852  
    5454      !                    !  (=F) user defined configuration           (F => create/check namusr_def) 
    5555      cn_domcfg = "domain_cfg"  ! domain configuration filename 
     56/ 
     57!----------------------------------------------------------------------- 
     58&namtile        !   parameters of the tiling 
     59!----------------------------------------------------------------------- 
    5660/ 
    5761!----------------------------------------------------------------------- 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/ICE/icethd_ent.F90

    r13547 r14852  
    121121         DO ji = 1, npti 
    122122            rswitch      = MAX( 0._wp , SIGN( 1._wp , zhnew(ji) - epsi20 ) )  
    123             qnew(ji,jk1) = rswitch * ( zeh_cum1(ji,jk1) - zeh_cum1(ji,jk1-1) ) / MAX( zhnew(ji), epsi20 ) 
     123            qnew(ji,jk1) = rswitch * MAX( 0._wp, zeh_cum1(ji,jk1) - zeh_cum1(ji,jk1-1) ) / MAX( zhnew(ji), epsi20 ) ! max for roundoff error 
    124124         END DO 
    125125      END DO 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/ASM/asminc.F90

    r14789 r14852  
    2626   USE par_oce         ! Ocean space and time domain variables 
    2727   USE dom_oce         ! Ocean space and time domain 
    28    USE domtile 
    2928   USE domvvl          ! domain: variable volume level 
    3029   USE ldfdyn          ! lateral diffusion: eddy viscosity coefficients 
    … …  
    519518      ! 
    520519      INTEGER  :: ji, jj, jk 
    521       INTEGER  :: it, itile 
     520      INTEGER  :: it 
    522521      REAL(wp) :: zincwgt  ! IAU weight for current time step 
    523522      REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: fzptnz ! 3d freezing point values 
    … …  
    541540            zincwgt = wgtiau(it) / rn_Dt   ! IAU weight for the current time step 
    542541            ! 
    543             IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     542            IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
    544543               IF(lwp) THEN 
    545544                  WRITE(numout,*) 
    … …  
    578577         ENDIF 
    579578         ! 
    580          IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only on the last tile 
     579         IF( .NOT. l_istiled .OR. ntile == nijtile )  THEN                ! Do only on the last tile 
    581580            IF ( kt == nitiaufin_r + 1  ) THEN   ! For bias crcn to work 
    582581               DEALLOCATE( t_bkginc ) 
    … …  
    595594            IF (ln_temnofreeze) THEN 
    596595               ! Do not apply negative increments if the temperature will fall below freezing 
    597                WHERE( t_bkginc(A2D(0),:) > 0.0_wp .OR. pts(A2D(0),:,jp_tem,Kmm) + t_bkginc(A2D(0),:) > fzptnz(:,:,:) ) 
    598                   pts(A2D(0),:,jp_tem,Kmm) = t_bkg(A2D(0),:) + t_bkginc(A2D(0),:) 
     596               WHERE( t_bkginc(:,:,:) > 0.0_wp .OR. pts(:,:,:,jp_tem,Kmm) + t_bkginc(:,:,:) > fzptnz(:,:,:) ) 
     597                  pts(:,:,:,jp_tem,Kmm) = t_bkg(:,:,:) + t_bkginc(:,:,:) 
    599598               END WHERE 
    600599            ELSE 
    601                DO_3D( 0, 0, 0, 0, 1, jpk ) 
    602                   pts(ji,jj,jk,jp_tem,Kmm) = t_bkg(ji,jj,jk) + t_bkginc(ji,jj,jk) 
    603                END_3D 
     600               pts(:,:,:,jp_tem,Kmm) = t_bkg(:,:,:) + t_bkginc(:,:,:) 
    604601            ENDIF 
    605602            IF (ln_salfix) THEN 
    606603               ! Do not apply negative increments if the salinity will fall below a specified 
    607604               ! minimum value salfixmin 
    608                WHERE( s_bkginc(A2D(0),:) > 0.0_wp .OR. pts(A2D(0),:,jp_sal,Kmm) + s_bkginc(A2D(0),:) > salfixmin ) 
    609                   pts(A2D(0),:,jp_sal,Kmm) = s_bkg(A2D(0),:) + s_bkginc(A2D(0),:) 
     605               WHERE( s_bkginc(:,:,:) > 0.0_wp .OR. pts(:,:,:,jp_sal,Kmm) + s_bkginc(:,:,:) > salfixmin ) 
     606                  pts(:,:,:,jp_sal,Kmm) = s_bkg(:,:,:) + s_bkginc(:,:,:) 
    610607               END WHERE 
    611608            ELSE 
    612                DO_3D( 0, 0, 0, 0, 1, jpk ) 
    613                   pts(ji,jj,jk,jp_sal,Kmm) = s_bkg(ji,jj,jk) + s_bkginc(ji,jj,jk) 
    614                END_3D 
    615             ENDIF 
    616  
    617             DO_3D( 0, 0, 0, 0, 1, jpk ) 
    618                pts(ji,jj,jk,:,Kbb) = pts(ji,jj,jk,:,Kmm)             ! Update before fields 
    619             END_3D 
     609               pts(:,:,:,jp_sal,Kmm) = s_bkg(:,:,:) + s_bkginc(:,:,:) 
     610            ENDIF 
     611 
     612            pts(:,:,:,:,Kbb) = pts(:,:,:,:,Kmm)                 ! Update before fields 
    620613 
    621614            CALL eos( pts(:,:,:,:,Kbb), rhd, rhop, gdept_0(:,:,:) )  ! Before potential and in situ densities 
    … …  
    624617!!gm 
    625618 
    626             ! TEMP: [tiling] This change not necessary after extra haloes development (lbc_lnk removed from zps_hde*) 
    627             IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only for the full domain 
    628                itile = ntile 
    629                IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 )            ! Use full domain 
    630  
    631                IF( ln_zps .AND. .NOT. lk_c1d .AND. .NOT. ln_isfcav)           & 
    632                   &  CALL zps_hde    ( kt, Kmm, jpts, pts(:,:,:,:,Kbb), gtsu, gtsv,        &  ! Partial steps: before horizontal gradient 
    633                   &                              rhd, gru , grv               )  ! of t, s, rd at the last ocean level 
    634                IF( ln_zps .AND. .NOT. lk_c1d .AND.       ln_isfcav)                       & 
    635                   &  CALL zps_hde_isf( nit000, Kmm, jpts, pts(:,:,:,:,Kbb), gtsu, gtsv, gtui, gtvi,    &  ! Partial steps for top cell (ISF) 
    636                   &                                  rhd, gru , grv , grui, grvi          )  ! of t, s, rd at the last ocean level 
    637  
    638                IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = itile )            ! Revert to tile domain 
    639             ENDIF 
    640  
    641             IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only on the last tile 
    642                DEALLOCATE( t_bkginc ) 
    643                DEALLOCATE( s_bkginc ) 
    644                DEALLOCATE( t_bkg    ) 
    645                DEALLOCATE( s_bkg    ) 
    646             ENDIF 
    647          ! 
     619            IF( ln_zps .AND. .NOT. lk_c1d .AND. .NOT. ln_isfcav)           & 
     620               &  CALL zps_hde    ( kt, Kmm, jpts, pts(:,:,:,:,Kbb), gtsu, gtsv,        &  ! Partial steps: before horizontal gradient 
     621               &                              rhd, gru , grv               )  ! of t, s, rd at the last ocean level 
     622            IF( ln_zps .AND. .NOT. lk_c1d .AND.       ln_isfcav)                       & 
     623               &  CALL zps_hde_isf( nit000, Kmm, jpts, pts(:,:,:,:,Kbb), gtsu, gtsv, gtui, gtvi,    &  ! Partial steps for top cell (ISF) 
     624               &                                  rhd, gru , grv , grui, grvi          )  ! of t, s, rd at the last ocean level 
     625 
     626            DEALLOCATE( t_bkginc ) 
     627            DEALLOCATE( s_bkginc ) 
     628            DEALLOCATE( t_bkg    ) 
     629            DEALLOCATE( s_bkg    ) 
    648630         ENDIF 
    649631         ! 
    … …  
    669651      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv       ! ocean velocities and RHS of momentum equation 
    670652      ! 
    671       INTEGER :: jk 
     653      INTEGER :: ji, jj, jk 
    672654      INTEGER :: it 
    673655      REAL(wp) :: zincwgt  ! IAU weight for current time step 
    … …  
    683665            zincwgt = wgtiau(it) / rn_Dt   ! IAU weight for the current time step 
    684666            ! 
    685             IF(lwp) THEN 
    686                WRITE(numout,*) 
    687                WRITE(numout,*) 'dyn_asm_inc : Dynamics IAU at time step = ', kt,' with IAU weight = ', wgtiau(it) 
    688                WRITE(numout,*) '~~~~~~~~~~~~' 
     667            IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     668               IF(lwp) THEN 
     669                  WRITE(numout,*) 
     670                  WRITE(numout,*) 'dyn_asm_inc : Dynamics IAU at time step = ', kt,' with IAU weight = ', wgtiau(it) 
     671                  WRITE(numout,*) '~~~~~~~~~~~~' 
     672               ENDIF 
    689673            ENDIF 
    690674            ! 
    691675            ! Update the dynamic tendencies 
    692             DO jk = 1, jpkm1 
    693                puu(:,:,jk,Krhs) = puu(:,:,jk,Krhs) + u_bkginc(:,:,jk) * zincwgt 
    694                pvv(:,:,jk,Krhs) = pvv(:,:,jk,Krhs) + v_bkginc(:,:,jk) * zincwgt 
    695             END DO 
    696             ! 
    697             IF ( kt == nitiaufin_r ) THEN 
    698                DEALLOCATE( u_bkginc ) 
    699                DEALLOCATE( v_bkginc ) 
     676            DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     677               puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + u_bkginc(ji,jj,jk) * zincwgt 
     678               pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + v_bkginc(ji,jj,jk) * zincwgt 
     679            END_3D 
     680            ! 
     681            IF( .NOT. l_istiled .OR. ntile == nijtile )  THEN                ! Do only on the last tile 
     682               IF ( kt == nitiaufin_r ) THEN 
     683                  DEALLOCATE( u_bkginc ) 
     684                  DEALLOCATE( v_bkginc ) 
     685               ENDIF 
    700686            ENDIF 
    701687            ! 
    … …  
    741727      ! 
    742728      INTEGER :: it 
    743       INTEGER :: jk 
     729      INTEGER :: ji, jj, jk 
    744730      REAL(wp) :: zincwgt  ! IAU weight for current time step 
    745731      !!---------------------------------------------------------------------- 
    … …  
    754740            zincwgt = wgtiau(it) / rn_Dt   ! IAU weight for the current time step 
    755741            ! 
    756             IF(lwp) THEN 
    757                WRITE(numout,*) 
    758                WRITE(numout,*) 'ssh_asm_inc : SSH IAU at time step = ', & 
    759                   &  kt,' with IAU weight = ', wgtiau(it) 
    760                WRITE(numout,*) '~~~~~~~~~~~~' 
     742            IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     743               IF(lwp) THEN 
     744                  WRITE(numout,*) 
     745                  WRITE(numout,*) 'ssh_asm_inc : SSH IAU at time step = ', & 
     746                     &  kt,' with IAU weight = ', wgtiau(it) 
     747                  WRITE(numout,*) '~~~~~~~~~~~~' 
     748               ENDIF 
    761749            ENDIF 
    762750            ! 
    … …  
    764752            ! (applied in dynspg.*) 
    765753#if defined key_asminc 
    766             ssh_iau(:,:) = ssh_bkginc(:,:) * zincwgt 
     754            DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls ) 
     755               ssh_iau(ji,jj) = ssh_bkginc(ji,jj) * zincwgt 
     756            END_2D 
    767757#endif 
    768758            ! 
    … …  
    770760            ! 
    771761            ! test on ssh_bkginc needed as ssh_asm_inc is called twice by time step 
    772             IF (ALLOCATED(ssh_bkginc)) DEALLOCATE( ssh_bkginc ) 
     762            IF( .NOT. l_istiled .OR. ntile == nijtile )  THEN                ! Do only on the last tile 
     763               IF (ALLOCATED(ssh_bkginc)) DEALLOCATE( ssh_bkginc ) 
     764            ENDIF 
    773765            ! 
    774766#if defined key_asminc 
    775             ssh_iau(:,:) = 0._wp 
     767            DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls ) 
     768               ssh_iau(ji,jj) = 0._wp 
     769            END_2D 
    776770#endif 
    777771            ! 
    … …  
    820814      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   phdivn   ! horizontal divergence 
    821815      !! 
    822       INTEGER  ::   jk                                        ! dummy loop index 
     816      INTEGER  ::   ji, jj, jk                                ! dummy loop index 
    823817      REAL(wp), DIMENSION(:,:)  , POINTER       ::   ztim     ! local array 
    824818      !!---------------------------------------------------------------------- 
    … …  
    828822      ! 
    829823      IF( ln_linssh ) THEN 
    830          phdivn(:,:,1) = phdivn(:,:,1) - ssh_iau(:,:) / e3t(:,:,1,Kmm) * tmask(:,:,1) 
     824         DO_2D_OVR( nn_hls-1, nn_hls, nn_hls-1, nn_hls ) 
     825            phdivn(ji,jj,1) = phdivn(ji,jj,1) - ssh_iau(ji,jj) / e3t(ji,jj,1,Kmm) * tmask(ji,jj,1) 
     826         END_2D 
    831827      ELSE 
    832          ALLOCATE( ztim(jpi,jpj) ) 
    833          ztim(:,:) = ssh_iau(:,:) / ( ht(:,:) + 1.0 - ssmask(:,:) ) 
    834          DO jk = 1, jpkm1 
    835             phdivn(:,:,jk) = phdivn(:,:,jk) - ztim(:,:) * tmask(:,:,jk) 
    836          END DO 
     828         ALLOCATE( ztim(A2D(nn_hls)) ) 
     829         DO_2D_OVR( nn_hls-1, nn_hls, nn_hls-1, nn_hls ) 
     830            ztim(ji,jj) = ssh_iau(ji,jj) / ( ht(ji,jj) + 1.0 - ssmask(ji,jj) ) 
     831            DO jk = 1, jpkm1 
     832               phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - ztim(ji,jj) * tmask(ji,jj,jk) 
     833            END DO 
     834         END_2D 
    837835         ! 
    838836         DEALLOCATE(ztim) 
    … …  
    876874            ! note this is not a tendency so should not be divided by rn_Dt (as with the tracer and other increments) 
    877875            ! 
    878             IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     876            IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
    879877               IF(lwp) THEN 
    880878                  WRITE(numout,*) 
    … …  
    920918#endif 
    921919            ! 
    922             IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only on the last tile 
     920            IF( .NOT. l_istiled .OR. ntile == nijtile )  THEN                ! Do only on the last tile 
    923921               IF ( kt == nitiaufin_r ) THEN 
    924922                  DEALLOCATE( seaice_bkginc ) 
    … …  
    979977            END_2D 
    980978#endif 
    981             IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only on the last tile 
     979            IF( .NOT. l_istiled .OR. ntile == nijtile )  THEN                ! Do only on the last tile 
    982980               IF ( .NOT. PRESENT(kindic) ) THEN 
    983981                  DEALLOCATE( seaice_bkginc ) 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/BDY/bdydyn3d.F90

    r14789 r14852  
    349349      REAL(wp) ::   zwgt           ! boundary weight 
    350350      !!---------------------------------------------------------------------- 
     351      IF( l_istiled .AND. ntile /= 1 ) RETURN                        ! Do only for the full domain 
    351352      ! 
    352353      IF( ln_timing )   CALL timing_start('bdy_dyn3d_dmp') 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/BDY/bdytra.F90

    r14789 r14852  
    158158      INTEGER  ::   ib_bdy         ! Loop index 
    159159      !!---------------------------------------------------------------------- 
    160       IF( ntile /= 0 .AND. ntile /= 1 ) RETURN                        ! Do only for the full domain 
     160      IF( l_istiled .AND. ntile /= 1 ) RETURN                        ! Do only for the full domain 
    161161      ! 
    162162      IF( ln_timing )   CALL timing_start('bdy_tra_dmp') 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/DIA/diaar5.F90

    r14789 r14852  
    3434   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:  ) ::   thick0       ! ocean thickness (interior domain) 
    3535   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sn0          ! initial salinity 
    36    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   hstr_adv, hstr_ldf 
    3736 
    3837   LOGICAL  :: l_ar5 
    … …  
    5554      !!---------------------------------------------------------------------- 
    5655      ! 
    57       ALLOCATE( thick0(jpi,jpj) , sn0(jpi,jpj,jpk) , & 
    58          &      hstr_adv(jpi,jpj,jpts,2), hstr_ldf(jpi,jpj,jpts,2), STAT=dia_ar5_alloc ) 
     56      ALLOCATE( thick0(jpi,jpj) , sn0(jpi,jpj,jpk), STAT=dia_ar5_alloc ) 
    5957      ! 
    6058      CALL mpp_sum ( 'diaar5', dia_ar5_alloc ) 
    … …  
    306304   END SUBROUTINE dia_ar5 
    307305 
    308    ! TEMP: [tiling] These changes not necessary if using XIOS (subdomain support, will not output haloes) 
     306 
    309307   SUBROUTINE dia_ar5_hst( ktra, cptr, puflx, pvflx ) 
    310308      !!---------------------------------------------------------------------- 
    … …  
    320318      ! 
    321319      INTEGER    ::  ji, jj, jk 
    322  
    323       IF( cptr /= 'adv' .AND. cptr /= 'ldf' ) RETURN 
    324       IF( ktra /= jp_tem .AND. ktra /= jp_sal ) RETURN 
     320      REAL(wp), DIMENSION(A2D(nn_hls))  :: z2d 
     321 
     322      z2d(:,:) = puflx(:,:,1) 
     323      DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     324         z2d(ji,jj) = z2d(ji,jj) + puflx(ji,jj,jk) 
     325      END_3D 
    325326 
    326327      IF( cptr == 'adv' ) THEN 
    327          DO_2D( 0, 0, 0, 0 ) 
    328             hstr_adv(ji,jj,ktra,1) = puflx(ji,jj,1) 
    329             hstr_adv(ji,jj,ktra,2) = pvflx(ji,jj,1) 
    330          END_2D 
    331          DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    332             hstr_adv(ji,jj,ktra,1) = hstr_adv(ji,jj,ktra,1) + puflx(ji,jj,jk) 
    333             hstr_adv(ji,jj,ktra,2) = hstr_adv(ji,jj,ktra,2) + pvflx(ji,jj,jk) 
    334          END_3D 
     328         IF( ktra == jp_tem ) CALL iom_put( 'uadv_heattr' , rho0_rcp * z2d(:,:) )  ! advective heat transport in i-direction 
     329         IF( ktra == jp_sal ) CALL iom_put( 'uadv_salttr' , rho0     * z2d(:,:) )  ! advective salt transport in i-direction 
    335330      ELSE IF( cptr == 'ldf' ) THEN 
    336          DO_2D( 0, 0, 0, 0 ) 
    337             hstr_ldf(ji,jj,ktra,1) = puflx(ji,jj,1) 
    338             hstr_ldf(ji,jj,ktra,2) = pvflx(ji,jj,1) 
    339          END_2D 
    340          DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    341             hstr_ldf(ji,jj,ktra,1) = hstr_ldf(ji,jj,ktra,1) + puflx(ji,jj,jk) 
    342             hstr_ldf(ji,jj,ktra,2) = hstr_ldf(ji,jj,ktra,2) + pvflx(ji,jj,jk) 
    343          END_3D 
    344       ENDIF 
    345  
    346       IF( ntile == 0 .OR. ntile == nijtile ) THEN 
    347          IF( cptr == 'adv' ) THEN 
    348             IF( ktra == jp_tem ) CALL iom_put( 'uadv_heattr' , rho0_rcp * hstr_adv(:,:,ktra,1) )  ! advective heat transport in i-direction 
    349             IF( ktra == jp_sal ) CALL iom_put( 'uadv_salttr' , rho0     * hstr_adv(:,:,ktra,1) )  ! advective salt transport in i-direction 
    350             IF( ktra == jp_tem ) CALL iom_put( 'vadv_heattr' , rho0_rcp * hstr_adv(:,:,ktra,2) )  ! advective heat transport in j-direction 
    351             IF( ktra == jp_sal ) CALL iom_put( 'vadv_salttr' , rho0     * hstr_adv(:,:,ktra,2) )  ! advective salt transport in j-direction 
    352          ENDIF 
    353          IF( cptr == 'ldf' ) THEN 
    354             IF( ktra == jp_tem ) CALL iom_put( 'udiff_heattr' , rho0_rcp * hstr_ldf(:,:,ktra,1) ) ! diffusive heat transport in i-direction 
    355             IF( ktra == jp_sal ) CALL iom_put( 'udiff_salttr' , rho0     * hstr_ldf(:,:,ktra,1) ) ! diffusive salt transport in i-direction 
    356             IF( ktra == jp_tem ) CALL iom_put( 'vdiff_heattr' , rho0_rcp * hstr_ldf(:,:,ktra,2) ) ! diffusive heat transport in j-direction 
    357             IF( ktra == jp_sal ) CALL iom_put( 'vdiff_salttr' , rho0     * hstr_ldf(:,:,ktra,2) ) ! diffusive salt transport in j-direction 
    358          ENDIF 
     331         IF( ktra == jp_tem ) CALL iom_put( 'udiff_heattr' , rho0_rcp * z2d(:,:) ) ! diffusive heat transport in i-direction 
     332         IF( ktra == jp_sal ) CALL iom_put( 'udiff_salttr' , rho0     * z2d(:,:) ) ! diffusive salt transport in i-direction 
     333      ENDIF 
     334      ! 
     335      z2d(:,:) = pvflx(:,:,1) 
     336      DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     337         z2d(ji,jj) = z2d(ji,jj) + pvflx(ji,jj,jk) 
     338      END_3D 
     339 
     340      IF( cptr == 'adv' ) THEN 
     341         IF( ktra == jp_tem ) CALL iom_put( 'vadv_heattr' , rho0_rcp * z2d(:,:) )  ! advective heat transport in j-direction 
     342         IF( ktra == jp_sal ) CALL iom_put( 'vadv_salttr' , rho0     * z2d(:,:) )  ! advective salt transport in j-direction 
     343      ELSE IF( cptr == 'ldf' ) THEN 
     344         IF( ktra == jp_tem ) CALL iom_put( 'vdiff_heattr' , rho0_rcp * z2d(:,:) ) ! diffusive heat transport in j-direction 
     345         IF( ktra == jp_sal ) CALL iom_put( 'vdiff_salttr' , rho0     * z2d(:,:) ) ! diffusive salt transport in j-direction 
    359346      ENDIF 
    360347 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/DIA/diaptr.F90

    r14789 r14852  
    7171CONTAINS 
    7272 
     73   ! NOTE: [tiling] tiling sometimes changes the diagnostics very slightly, usually where there are few zonal points e.g. the northern Indian Ocean basin. The difference is usually very small, for one point in one diagnostic. Presumably this is because of the additional zonal integration step over tiles. 
    7374   SUBROUTINE dia_ptr( kt, Kmm, pvtr ) 
    7475      !!---------------------------------------------------------------------- 
    … …  
    9394 
    9495         ! Calculate diagnostics only when zonal integrals have finished 
    95          IF( ntile == 0 .OR. ntile == nijtile ) CALL dia_ptr_iom(kt, Kmm, pvtr) 
     96         IF( .NOT. l_istiled .OR. ntile == nijtile ) CALL dia_ptr_iom(kt, Kmm, pvtr) 
    9697      ENDIF 
    9798 
    … …  
    317318         ! 
    318319         IF( iom_use( 'uocetr_vsum_cumul' ) ) THEN 
    319             IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 )         ! Use full domain 
    320320            CALL iom_get_var(  'uocetr_vsum_op', z2d ) ! get uocetr_vsum_op from xml 
    321321            z2d(:,:) = ptr_ci_2d( z2d(:,:) ) 
    322322            CALL iom_put( 'uocetr_vsum_cumul', z2d ) 
    323             IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = nijtile )   ! Revert to tile domain 
    324323         ENDIF 
    325324         ! 
    … …  
    589588 
    590589#if ! defined key_mpi_off 
    591       IF( ntile == 0 .OR. ntile == nijtile ) THEN 
     590      IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN 
    592591         ish1d(1) = jpj*nbasin 
    593592         ish2d(1) = jpj ; ish2d(2) = nbasin 
    … …  
    627626 
    628627#if ! defined key_mpi_off 
    629       IF( ntile == 0 .OR. ntile == nijtile ) THEN 
     628      IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN 
    630629         ish1d(1) = jpj*jpk*nbasin 
    631630         ish3d(1) = jpj ; ish3d(2) = jpk ; ish3d(3) = nbasin 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/DOM/dom_oce.F90

    r14789 r14852  
    7373   INTEGER         ::   nn_ltile_i, nn_ltile_j 
    7474 
    75    ! Domain tiling (all tiles) 
     75   ! Domain tiling 
    7676   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ntsi_a       !: start of internal part of tile domain 
    7777   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ntsj_a       ! 
    7878   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ntei_a       !: end of internal part of tile domain 
    7979   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ntej_a       ! 
     80   LOGICAL, PUBLIC                                  ::   l_istiled    ! whether tiling is currently active or not 
    8081 
    8182   !                             !: domain MPP decomposition parameters 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/DOM/domain.F90

    r14789 r14852  
    125125      !           !==  Reference coordinate system  ==! 
    126126      ! 
    127       CALL dom_glo                            ! global domain versus local domain 
    128       CALL dom_nam                            ! read namelist ( namrun, namdom ) 
    129       CALL dom_tile( ntsi, ntsj, ntei, ntej ) ! Tile domain 
     127      CALL dom_glo                      ! global domain versus local domain 
     128      CALL dom_nam                      ! read namelist ( namrun, namdom ) 
     129      CALL dom_tile_init                ! Tile domain 
    130130 
    131131      ! 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/DOM/domqco.F90

    r14789 r14852  
    123123      CALL dom_qco_r3c( ssh(:,:,Kmm), r3t(:,:,Kmm), r3u(:,:,Kmm), r3v(:,:,Kmm), r3f(:,:) ) 
    124124#endif 
     125      ! dom_qco_r3c defines over [nn_hls, nn_hls-1, nn_hls, nn_hls-1] 
     126      IF( nn_hls == 2 ) CALL lbc_lnk( 'dom_qco_zgr', r3u(:,:,Kbb), 'U', 1._wp, r3v(:,:,Kbb), 'V', 1._wp, & 
     127         &                                           r3u(:,:,Kmm), 'U', 1._wp, r3v(:,:,Kmm), 'V', 1._wp ) 
    125128      ! 
    126129   END SUBROUTINE dom_qco_zgr 
    … …  
    146149      ! 
    147150      ! 
    148       pr3t(:,:) = pssh(:,:) * r1_ht_0(:,:)   !==  ratio at t-point  ==! 
     151      DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls ) 
     152         pr3t(ji,jj) = pssh(ji,jj) * r1_ht_0(ji,jj)   !==  ratio at t-point  ==! 
     153      END_2D 
    149154      ! 
    150155      ! 
    … …  
    154159#if ! defined key_qcoTest_FluxForm 
    155160      !                                ! no 'key_qcoTest_FluxForm' : surface weighted ssh average 
    156          DO_2D( 0, 0, 0, 0 ) 
    157             pr3u(ji,jj) = 0.5_wp * (  e1e2t(ji  ,jj) * pssh(ji  ,jj)  & 
    158                &                    + e1e2t(ji+1,jj) * pssh(ji+1,jj)  ) * r1_hu_0(ji,jj) * r1_e1e2u(ji,jj) 
    159             pr3v(ji,jj) = 0.5_wp * (  e1e2t(ji,jj  ) * pssh(ji,jj  )  & 
    160                &                    + e1e2t(ji,jj+1) * pssh(ji,jj+1)  ) * r1_hv_0(ji,jj) * r1_e1e2v(ji,jj) 
    161          END_2D 
     161      DO_2D_OVR( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
     162         pr3u(ji,jj) = 0.5_wp * (  e1e2t(ji  ,jj) * pssh(ji  ,jj)  & 
     163            &                    + e1e2t(ji+1,jj) * pssh(ji+1,jj)  ) * r1_hu_0(ji,jj) * r1_e1e2u(ji,jj) 
     164         pr3v(ji,jj) = 0.5_wp * (  e1e2t(ji,jj  ) * pssh(ji,jj  )  & 
     165            &                    + e1e2t(ji,jj+1) * pssh(ji,jj+1)  ) * r1_hv_0(ji,jj) * r1_e1e2v(ji,jj) 
     166      END_2D 
    162167!!st      ELSE                                         !- Flux Form   (simple averaging) 
    163168#else 
    164          DO_2D( 0, 0, 0, 0 ) 
    165             pr3u(ji,jj) = 0.5_wp * (  pssh(ji,jj) + pssh(ji+1,jj  )  ) * r1_hu_0(ji,jj) 
    166             pr3v(ji,jj) = 0.5_wp * (  pssh(ji,jj) + pssh(ji  ,jj+1)  ) * r1_hv_0(ji,jj) 
    167          END_2D 
     169      DO_2D_OVR( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
     170         pr3u(ji,jj) = 0.5_wp * (  pssh(ji,jj) + pssh(ji+1,jj  )  ) * r1_hu_0(ji,jj) 
     171         pr3v(ji,jj) = 0.5_wp * (  pssh(ji,jj) + pssh(ji  ,jj+1)  ) * r1_hv_0(ji,jj) 
     172      END_2D 
    168173!!st      ENDIF 
    169174#endif          
    170175      ! 
    171176      IF( .NOT.PRESENT( pr3f ) ) THEN              !- lbc on ratio at u-, v-points only 
    172          CALL lbc_lnk( 'dom_qco_r3c', pr3u, 'U', 1._wp, pr3v, 'V', 1._wp ) 
     177         IF (nn_hls==1) CALL lbc_lnk( 'dom_qco_r3c', pr3u, 'U', 1._wp, pr3v, 'V', 1._wp ) 
    173178         ! 
    174179         ! 
    … …  
    179184         !                                ! no 'key_qcoTest_FluxForm' : surface weighted ssh average 
    180185 
    181             DO_2D( 0, 0, 0, 0 )                               ! start from 1 since lbc_lnk('F') doesn't update the 1st row/line 
    182                pr3f(ji,jj) = 0.25_wp * (  e1e2t(ji  ,jj  ) * pssh(ji  ,jj  )  & 
    183                   &                     + e1e2t(ji+1,jj  ) * pssh(ji+1,jj  )  & 
    184                   &                     + e1e2t(ji  ,jj+1) * pssh(ji  ,jj+1)  & 
    185                   &                     + e1e2t(ji+1,jj+1) * pssh(ji+1,jj+1)  ) * r1_hf_0(ji,jj) * r1_e1e2f(ji,jj) 
    186             END_2D 
     186      DO_2D_OVR( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )                               ! start from 1 since lbc_lnk('F') doesn't update the 1st row/line 
     187         ! round brackets added to fix the order of floating point operations 
     188         ! needed to ensure halo 1 - halo 2 compatibility 
     189         pr3f(ji,jj) = 0.25_wp * ( ( e1e2t(ji  ,jj  ) * pssh(ji  ,jj  )   & 
     190            &                      + e1e2t(ji+1,jj  ) * pssh(ji+1,jj  )   & 
     191            &                      )                                      & ! bracket for halo 1 - halo 2 compatibility 
     192            &                     + ( e1e2t(ji  ,jj+1) * pssh(ji  ,jj+1)  & 
     193            &                       + e1e2t(ji+1,jj+1) * pssh(ji+1,jj+1)  & 
     194            &                       )                                     & ! bracket for halo 1 - halo 2 compatibility 
     195            &                    ) * r1_hf_0(ji,jj) * r1_e1e2f(ji,jj) 
     196      END_2D 
    187197!!st         ELSE                                      !- Flux Form   (simple averaging) 
    188198#else 
    189             DO_2D( 0, 0, 0, 0 )                               ! start from 1 since lbc_lnk('F') doesn't update the 1st row/line 
    190                pr3f(ji,jj) = 0.25_wp * (  pssh(ji,jj  ) + pssh(ji+1,jj  )  & 
    191                   &                     + pssh(ji,jj+1) + pssh(ji+1,jj+1)  ) * r1_hf_0(ji,jj) 
    192             END_2D 
     199      DO_2D_OVR( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
     200         ! round brackets added to fix the order of floating point operations 
     201         ! needed to ensure halo 1 - halo 2 compatibility 
     202         pr3f(ji,jj) = 0.25_wp * ( ( pssh(ji,jj  ) + pssh(ji+1,jj  ) ) & 
     203            &                     + ( pssh(ji,jj+1) + pssh(ji+1,jj+1)  & 
     204            &                       )                                  & ! bracket for halo 1 - halo 2 compatibility 
     205            &                    ) * r1_hf_0(ji,jj) 
     206      END_2D 
    193207!!st         ENDIF 
    194208#endif 
    195209         !                                                 ! lbc on ratio at u-,v-,f-points 
    196          CALL lbc_lnk( 'dom_qco_r3c', pr3u, 'U', 1._wp, pr3v, 'V', 1._wp, pr3f, 'F', 1._wp ) 
     210         IF (nn_hls==1) CALL lbc_lnk( 'dom_qco_r3c', pr3u, 'U', 1._wp, pr3v, 'V', 1._wp, pr3f, 'F', 1._wp ) 
    197211         ! 
    198212      ENDIF 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/DOM/domtile.F90

    r14789 r14852  
    1313   ! 
    1414   USE prtctl         ! Print control (prt_ctl_info routine) 
     15   USE lib_mpp , ONLY : ctl_stop, ctl_warn 
    1516   USE in_out_manager ! I/O manager 
    1617 
    … …  
    1819   PRIVATE 
    1920 
    20    PUBLIC dom_tile   ! called by step.F90 
     21   PUBLIC dom_tile         ! called by step.F90 
     22   PUBLIC dom_tile_start   ! called by various 
     23   PUBLIC dom_tile_stop    ! "      " 
     24   PUBLIC dom_tile_init    ! called by domain.F90 
     25 
     26   LOGICAL, ALLOCATABLE, DIMENSION(:) ::   l_tilefin    ! whether a tile is finished or not 
    2127 
    2228   !!---------------------------------------------------------------------- 
    … …  
    2733CONTAINS 
    2834 
    29    SUBROUTINE dom_tile( ktsi, ktsj, ktei, ktej, ktile ) 
     35   SUBROUTINE dom_tile_init 
     36      !!---------------------------------------------------------------------- 
     37      !!                     ***  ROUTINE dom_tile_init  *** 
     38      !! 
     39      !! ** Purpose :   Initialise tile domain variables 
     40      !! 
     41      !! ** Action  : - ntsi, ntsj     : start of internal part of domain 
     42      !!              - ntei, ntej     : end of internal part of domain 
     43      !!              - ntile          : current tile number 
     44      !!              - nijtile        : total number of tiles 
     45      !!              - nthl, nthr     : modifier on DO loop macro bound offset (left, right) 
     46      !!              - nthb, ntht     :              "         "               (bottom, top) 
     47      !!              - l_istiled      : whether tiling is currently active or not 
     48      !!              - l_tilefin      : whether a tile is finished or not 
     49      !!---------------------------------------------------------------------- 
     50      INTEGER ::   jt                                     ! dummy loop argument 
     51      INTEGER ::   iitile, ijtile                         ! Local integers 
     52      !!---------------------------------------------------------------------- 
     53      IF( ln_tile .AND. nn_hls /= 2 ) CALL ctl_stop('dom_tile_init: Tiling is only supported for nn_hls = 2') 
     54 
     55      ntile = 0                     ! Initialise to full domain 
     56      nijtile = 1 
     57      ntsi = Nis0 
     58      ntsj = Njs0 
     59      ntei = Nie0 
     60      ntej = Nje0 
     61      nthl = 0 
     62      nthr = 0 
     63      nthb = 0 
     64      ntht = 0 
     65      l_istiled = .FALSE. 
     66 
     67      IF( ln_tile ) THEN            ! Calculate tile domain indices 
     68         iitile = Ni_0 / nn_ltile_i       ! Number of tiles 
     69         ijtile = Nj_0 / nn_ltile_j 
     70         IF( MOD( Ni_0, nn_ltile_i ) /= 0 ) iitile = iitile + 1 
     71         IF( MOD( Nj_0, nn_ltile_j ) /= 0 ) ijtile = ijtile + 1 
     72 
     73         nijtile = iitile * ijtile 
     74         ALLOCATE( ntsi_a(0:nijtile), ntsj_a(0:nijtile), ntei_a(0:nijtile), ntej_a(0:nijtile), l_tilefin(nijtile) ) 
     75 
     76         l_tilefin(:) = .FALSE. 
     77 
     78         ntsi_a(0) = Nis0                 ! Full domain 
     79         ntsj_a(0) = Njs0 
     80         ntei_a(0) = Nie0 
     81         ntej_a(0) = Nje0 
     82 
     83         DO jt = 1, nijtile               ! Tile domains 
     84            ntsi_a(jt) = Nis0 + nn_ltile_i * MOD(jt - 1, iitile) 
     85            ntsj_a(jt) = Njs0 + nn_ltile_j * ((jt - 1) / iitile) 
     86            ntei_a(jt) = MIN(ntsi_a(jt) + nn_ltile_i - 1, Nie0) 
     87            ntej_a(jt) = MIN(ntsj_a(jt) + nn_ltile_j - 1, Nje0) 
     88         ENDDO 
     89      ENDIF 
     90 
     91      IF(lwp) THEN                  ! control print 
     92         WRITE(numout,*) 
     93         WRITE(numout,*) 'dom_tile : Domain tiling decomposition' 
     94         WRITE(numout,*) '~~~~~~~~' 
     95         IF( ln_tile ) THEN 
     96            WRITE(numout,*) iitile, 'tiles in i' 
     97            WRITE(numout,*) '    Starting indices' 
     98            WRITE(numout,*) '        ', (ntsi_a(jt), jt=1, iitile) 
     99            WRITE(numout,*) '    Ending indices' 
     100            WRITE(numout,*) '        ', (ntei_a(jt), jt=1, iitile) 
     101            WRITE(numout,*) ijtile, 'tiles in j' 
     102            WRITE(numout,*) '    Starting indices' 
     103            WRITE(numout,*) '        ', (ntsj_a(jt), jt=1, nijtile, iitile) 
     104            WRITE(numout,*) '    Ending indices' 
     105            WRITE(numout,*) '        ', (ntej_a(jt), jt=1, nijtile, iitile) 
     106         ELSE 
     107            WRITE(numout,*) 'No domain tiling' 
     108            WRITE(numout,*) '    i indices =', ntsi, ':', ntei 
     109            WRITE(numout,*) '    j indices =', ntsj, ':', ntej 
     110         ENDIF 
     111      ENDIF 
     112   END SUBROUTINE dom_tile_init 
     113 
     114 
     115   SUBROUTINE dom_tile( ktsi, ktsj, ktei, ktej, ktile, ldhold, cstr ) 
    30116      !!---------------------------------------------------------------------- 
    31117      !!                     ***  ROUTINE dom_tile  *** 
    32118      !! 
    33       !! ** Purpose :   Set tile domain variables 
     119      !! ** Purpose :   Set the current tile and its domain indices 
    34120      !! 
    35121      !! ** Action  : - ktsi, ktsj     : start of internal part of domain 
    36122      !!              - ktei, ktej     : end of internal part of domain 
    37       !!              - ntile          : current tile number 
    38       !!              - nijtile        : total number of tiles 
     123      !!              - nthl, nthr     : modifier on DO loop macro bound offset (left, right) 
     124      !!              - nthb, ntht     :              "         "               (bottom, top) 
     125      !!              - ktile          : set the current tile number (ntile) 
    39126      !!---------------------------------------------------------------------- 
    40127      INTEGER, INTENT(out) :: ktsi, ktsj, ktei, ktej      ! Tile domain indices 
    41       INTEGER, INTENT(in), OPTIONAL :: ktile              ! Tile number 
    42       INTEGER ::   jt                                     ! dummy loop argument 
    43       INTEGER ::   iitile, ijtile                         ! Local integers 
    44       CHARACTER (len=11) ::   charout 
    45       !!---------------------------------------------------------------------- 
    46       IF( PRESENT(ktile) .AND. ln_tile ) THEN 
    47          ntile = ktile                 ! Set domain indices for tile 
    48          ktsi = ntsi_a(ktile) 
    49          ktsj = ntsj_a(ktile) 
    50          ktei = ntei_a(ktile) 
    51          ktej = ntej_a(ktile) 
    52  
     128      INTEGER, INTENT(in)  :: ktile                       ! Tile number 
     129      LOGICAL, INTENT(in), OPTIONAL :: ldhold             ! Pause/resume (.true.) or set (.false.) current tile 
     130      CHARACTER(len=*), INTENT(in), OPTIONAL   :: cstr    ! Debug information (added to warnings) 
     131      CHARACTER(len=23) :: clstr 
     132      LOGICAL :: llhold 
     133      CHARACTER(len=11)   :: charout 
     134      INTEGER :: iitile 
     135      !!---------------------------------------------------------------------- 
     136      llhold = .FALSE. 
     137      IF( PRESENT(ldhold) ) llhold = ldhold 
     138      clstr = '' 
     139      IF( PRESENT(cstr) ) clstr = TRIM(' ('//TRIM(cstr)//')') 
     140 
     141      IF( .NOT. ln_tile ) CALL ctl_stop('Cannot use dom_tile with ln_tile = .false.') 
     142      IF( .NOT. llhold ) THEN 
     143         IF( .NOT. l_istiled ) THEN 
     144            CALL ctl_warn('Cannot call dom_tile when tiling is inactive'//clstr) 
     145            RETURN 
     146         ENDIF 
     147 
     148         IF( ntile /= 0 ) l_tilefin(ntile) = .TRUE.         ! If setting a new tile, the current tile is complete 
     149 
     150         ntile = ktile                                      ! Set the new tile 
    53151         IF(sn_cfctl%l_prtctl) THEN 
    54             WRITE(charout, FMT="('ntile =', I4)") ktile 
     152            WRITE(charout, FMT="('ntile =', I4)") ntile 
    55153            CALL prt_ctl_info( charout ) 
    56154         ENDIF 
    57       ELSE 
    58          ntile = 0                     ! Initialise to full domain 
    59          nijtile = 1 
    60          ktsi = Nis0 
    61          ktsj = Njs0 
    62          ktei = Nie0 
    63          ktej = Nje0 
    64  
    65          IF( ln_tile ) THEN            ! Calculate tile domain indices 
    66             iitile = Ni_0 / nn_ltile_i       ! Number of tiles 
    67             ijtile = Nj_0 / nn_ltile_j 
    68             IF( MOD( Ni_0, nn_ltile_i ) /= 0 ) iitile = iitile + 1 
    69             IF( MOD( Nj_0, nn_ltile_j ) /= 0 ) ijtile = ijtile + 1 
    70  
    71             nijtile = iitile * ijtile 
    72             ALLOCATE( ntsi_a(0:nijtile), ntsj_a(0:nijtile), ntei_a(0:nijtile), ntej_a(0:nijtile) ) 
    73  
    74             ntsi_a(0) = ktsi                 ! Full domain 
    75             ntsj_a(0) = ktsj 
    76             ntei_a(0) = ktei 
    77             ntej_a(0) = ktej 
    78  
    79             DO jt = 1, nijtile               ! Tile domains 
    80                ntsi_a(jt) = Nis0 + nn_ltile_i * MOD(jt - 1, iitile) 
    81                ntsj_a(jt) = Njs0 + nn_ltile_j * ((jt - 1) / iitile) 
    82                ntei_a(jt) = MIN(ntsi_a(jt) + nn_ltile_i - 1, Nie0) 
    83                ntej_a(jt) = MIN(ntsj_a(jt) + nn_ltile_j - 1, Nje0) 
    84             ENDDO 
    85          ENDIF 
    86  
    87          IF(lwp) THEN                  ! control print 
    88             WRITE(numout,*) 
    89             WRITE(numout,*) 'dom_tile : Domain tiling decomposition' 
    90             WRITE(numout,*) '~~~~~~~~' 
    91             IF( ln_tile ) THEN 
    92                WRITE(numout,*) iitile, 'tiles in i' 
    93                WRITE(numout,*) '    Starting indices' 
    94                WRITE(numout,*) '        ', (ntsi_a(jt), jt=1, iitile) 
    95                WRITE(numout,*) '    Ending indices' 
    96                WRITE(numout,*) '        ', (ntei_a(jt), jt=1, iitile) 
    97                WRITE(numout,*) ijtile, 'tiles in j' 
    98                WRITE(numout,*) '    Starting indices' 
    99                WRITE(numout,*) '        ', (ntsj_a(jt), jt=1, nijtile, iitile) 
    100                WRITE(numout,*) '    Ending indices' 
    101                WRITE(numout,*) '        ', (ntej_a(jt), jt=1, nijtile, iitile) 
    102             ELSE 
    103                WRITE(numout,*) 'No domain tiling' 
    104                WRITE(numout,*) '    i indices =', ktsi, ':', ktei 
    105                WRITE(numout,*) '    j indices =', ktsj, ':', ktej 
    106             ENDIF 
    107          ENDIF 
    108       ENDIF 
     155      ENDIF 
     156 
     157      ktsi = ntsi_a(ktile)                                  ! Set the domain indices 
     158      ktsj = ntsj_a(ktile) 
     159      ktei = ntei_a(ktile) 
     160      ktej = ntej_a(ktile) 
     161 
     162      ! Calculate the modifying factor on DO loop bounds (1 = do not work on points that have already been processed by a neighbouring tile) 
     163      nthl = 0 ; nthr = 0 ; nthb = 0 ; ntht = 0 
     164      iitile = Ni_0 / nn_ltile_i 
     165      IF( MOD( Ni_0, nn_ltile_i ) /= 0 ) iitile = iitile + 1 
     166      IF( ktsi > Nis0 ) THEN ; IF( l_tilefin(ktile - 1     ) ) nthl = 1 ; ENDIF    ! Left adjacent tile 
     167      IF( ktei < Nie0 ) THEN ; IF( l_tilefin(ktile + 1     ) ) nthr = 1 ; ENDIF    ! Right  "  " 
     168      IF( ktsj > Njs0 ) THEN ; IF( l_tilefin(ktile - iitile) ) nthb = 1 ; ENDIF    ! Bottom "  " 
     169      IF( ktej < Nje0 ) THEN ; IF( l_tilefin(ktile + iitile) ) ntht = 1 ; ENDIF    ! Top    "  " 
    109170   END SUBROUTINE dom_tile 
    110171 
     172 
     173   SUBROUTINE dom_tile_start( ldhold, cstr ) 
     174      !!---------------------------------------------------------------------- 
     175      !!                     ***  ROUTINE dom_tile_start  *** 
     176      !! 
     177      !! ** Purpose : Start or resume the use of tiling 
     178      !! 
     179      !! ** Method  : dom_tile_start & dom_tile_stop are used to declare a tiled region of code. 
     180      !! 
     181      !!              Tiling is active/inactive (l_istiled = .true./.false.) within/outside of this code region. 
     182      !!              After enabling tiling, no tile will initially be set (the full domain will be used) and dom_tile must 
     183      !!              be called to set a specific tile to work on. Furthermore, all tiles will be marked as incomplete 
     184      !!              (ln_tilefin(:) = .false.). 
     185      !! 
     186      !!              Tiling can be paused/resumed within the tiled code region by calling dom_tile_stop/dom_tile_start 
     187      !!              with ldhold = .true.. This can be used to temporarily revert back to using the full domain. 
     188      !! 
     189      !!                 CALL dom_tile_start                                  ! Enable tiling 
     190      !!                    CALL dom_tile(ntsi, ntei, ntsj, ntej, ktile=n)    ! Set current tile "n" 
     191      !!                    ... 
     192      !!                    CALL dom_tile_stop(.TRUE.)                        ! Pause tiling (temporarily disable) 
     193      !!                    ... 
     194      !!                    CALL dom_tile_start(.TRUE.)                       ! Resume tiling 
     195      !!                 CALL dom_tile_stop                                   ! Disable tiling 
     196      !!---------------------------------------------------------------------- 
     197      LOGICAL, INTENT(in), OPTIONAL :: ldhold            ! Resume (.true.) or start (.false.) 
     198      LOGICAL :: llhold 
     199      CHARACTER(len=*), INTENT(in), OPTIONAL   :: cstr   ! Debug information (added to warnings) 
     200      CHARACTER(len=23) :: clstr 
     201      !!---------------------------------------------------------------------- 
     202      llhold = .FALSE. 
     203      IF( PRESENT(ldhold) ) llhold = ldhold 
     204      clstr = '' 
     205      IF( PRESENT(cstr) ) clstr = TRIM(' ('//TRIM(cstr)//')') 
     206 
     207      IF( .NOT. ln_tile ) CALL ctl_stop('Cannot resume/start tiling as ln_tile = .false.') 
     208      IF( l_istiled ) THEN 
     209         CALL ctl_warn('Cannot resume/start tiling as it is already active'//clstr) 
     210         RETURN 
     211      ! TODO: [tiling] this warning will always be raised outside a tiling loop (cannot check for pause rather than stop) 
     212      ELSE IF( llhold .AND. ntile == 0 ) THEN 
     213         CALL ctl_warn('Cannot resume tiling as it is not paused'//clstr) 
     214         RETURN 
     215      ENDIF 
     216 
     217      ! Whether resumed or started, the tiling is made active. If resumed, the domain indices for the current tile are used. 
     218      IF( llhold ) CALL dom_tile(ntsi, ntsj, ntei, ntej, ktile=ntile, ldhold=.TRUE., cstr='dom_tile_start'//clstr) 
     219      l_istiled = .TRUE. 
     220   END SUBROUTINE dom_tile_start 
     221 
     222 
     223   SUBROUTINE dom_tile_stop( ldhold, cstr ) 
     224      !!---------------------------------------------------------------------- 
     225      !!                     ***  ROUTINE dom_tile_stop  *** 
     226      !! 
     227      !! ** Purpose : End or pause the use of tiling 
     228      !! 
     229      !! ** Method  : See dom_tile_start 
     230      !!---------------------------------------------------------------------- 
     231      LOGICAL, INTENT(in), OPTIONAL :: ldhold            ! Pause (.true.) or stop (.false.) 
     232      LOGICAL :: llhold 
     233      CHARACTER(len=*), INTENT(in), OPTIONAL   :: cstr   ! Debug information (added to warnings) 
     234      CHARACTER(len=23) :: clstr 
     235      !!---------------------------------------------------------------------- 
     236      llhold = .FALSE. 
     237      IF( PRESENT(ldhold) ) llhold = ldhold 
     238      clstr = '' 
     239      IF( PRESENT(cstr) ) clstr = TRIM(' ('//TRIM(cstr)//')') 
     240 
     241      IF( .NOT. ln_tile ) CALL ctl_stop('Cannot pause/stop tiling as ln_tile = .false.') 
     242      IF( .NOT. l_istiled ) THEN 
     243         CALL ctl_warn('Cannot pause/stop tiling as it is inactive'//clstr) 
     244         RETURN 
     245      ENDIF 
     246 
     247      ! Whether paused or stopped, the tiling is made inactive and the full domain indices are used. 
     248      ! If stopped, there is no active tile (ntile = 0) and the finished tile indicators are reset 
     249      CALL dom_tile(ntsi, ntsj, ntei, ntej, ktile=0, ldhold=llhold, cstr='dom_tile_stop'//clstr) 
     250      IF( .NOT. llhold ) l_tilefin(:) = .FALSE. 
     251      l_istiled = .FALSE. 
     252   END SUBROUTINE dom_tile_stop 
    111253   !!====================================================================== 
    112254END MODULE domtile 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/DOM/domutl.F90

    r14789 r14852  
    2222 
    2323   INTERFACE is_tile 
    24       MODULE PROCEDURE is_tile_2d, is_tile_3d, is_tile_4d 
     24      MODULE PROCEDURE is_tile_2d_sp, is_tile_3d_sp, is_tile_4d_sp, is_tile_2d_dp, is_tile_3d_dp, is_tile_4d_dp 
    2525   END INTERFACE is_tile 
    2626 
    … …  
    116116 
    117117 
    118    FUNCTION is_tile_2d( pt ) 
    119       !! 
    120       REAL(wp), DIMENSION(:,:), INTENT(in) ::   pt 
    121       INTEGER :: is_tile_2d 
    122       !! 
    123       IF( ln_tile .AND. (SIZE(pt, 1) < jpi .OR. SIZE(pt, 2) < jpj) ) THEN 
    124          is_tile_2d = 1 
     118   INTEGER FUNCTION is_tile_2d_sp( pt ) 
     119      REAL(sp), DIMENSION(:,:), INTENT(in) ::   pt 
     120 
     121      IF( l_istiled .AND. (SIZE(pt, 1) < jpi .OR. SIZE(pt, 2) < jpj) ) THEN 
     122         is_tile_2d_sp = 1 
    125123      ELSE 
    126          is_tile_2d = 0 
     124         is_tile_2d_sp = 0 
    127125      ENDIF 
    128    END FUNCTION is_tile_2d 
     126   END FUNCTION is_tile_2d_sp 
    129127 
    130128 
    131    FUNCTION is_tile_3d( pt ) 
    132       !! 
    133       REAL(wp), DIMENSION(:,:,:), INTENT(in) ::   pt 
    134       INTEGER :: is_tile_3d 
    135       !! 
    136       IF( ln_tile .AND. (SIZE(pt, 1) < jpi .OR. SIZE(pt, 2) < jpj) ) THEN 
    137          is_tile_3d = 1 
     129   INTEGER FUNCTION is_tile_2d_dp( pt ) 
     130      REAL(dp), DIMENSION(:,:), INTENT(in) ::   pt 
     131 
     132      IF( l_istiled .AND. (SIZE(pt, 1) < jpi .OR. SIZE(pt, 2) < jpj) ) THEN 
     133         is_tile_2d_dp = 1 
    138134      ELSE 
    139          is_tile_3d = 0 
     135         is_tile_2d_dp = 0 
    140136      ENDIF 
    141    END FUNCTION is_tile_3d 
     137   END FUNCTION is_tile_2d_dp 
    142138 
    143139 
    144    FUNCTION is_tile_4d( pt ) 
    145       !! 
    146       REAL(wp), DIMENSION(:,:,:,:), INTENT(in) ::   pt 
    147       INTEGER :: is_tile_4d 
    148       !! 
    149       IF( ln_tile .AND. (SIZE(pt, 1) < jpi .OR. SIZE(pt, 2) < jpj) ) THEN 
    150          is_tile_4d = 1 
     140   INTEGER FUNCTION is_tile_3d_sp( pt ) 
     141      REAL(sp), DIMENSION(:,:,:), INTENT(in) ::   pt 
     142 
     143      IF( l_istiled .AND. (SIZE(pt, 1) < jpi .OR. SIZE(pt, 2) < jpj) ) THEN 
     144         is_tile_3d_sp = 1 
    151145      ELSE 
    152          is_tile_4d = 0 
     146         is_tile_3d_sp = 0 
    153147      ENDIF 
    154    END FUNCTION is_tile_4d 
     148   END FUNCTION is_tile_3d_sp 
    155149 
     150 
     151   INTEGER FUNCTION is_tile_3d_dp( pt ) 
     152      REAL(dp), DIMENSION(:,:,:), INTENT(in) ::   pt 
     153 
     154      IF( l_istiled .AND. (SIZE(pt, 1) < jpi .OR. SIZE(pt, 2) < jpj) ) THEN 
     155         is_tile_3d_dp = 1 
     156      ELSE 
     157         is_tile_3d_dp = 0 
     158      ENDIF 
     159   END FUNCTION is_tile_3d_dp 
     160 
     161 
     162   INTEGER FUNCTION is_tile_4d_sp( pt ) 
     163      REAL(sp), DIMENSION(:,:,:,:), INTENT(in) ::   pt 
     164 
     165      IF( l_istiled .AND. (SIZE(pt, 1) < jpi .OR. SIZE(pt, 2) < jpj) ) THEN 
     166         is_tile_4d_sp = 1 
     167      ELSE 
     168         is_tile_4d_sp = 0 
     169      ENDIF 
     170   END FUNCTION is_tile_4d_sp 
     171 
     172 
     173   INTEGER FUNCTION is_tile_4d_dp( pt ) 
     174      REAL(dp), DIMENSION(:,:,:,:), INTENT(in) ::   pt 
     175 
     176      IF( l_istiled .AND. (SIZE(pt, 1) < jpi .OR. SIZE(pt, 2) < jpj) ) THEN 
     177         is_tile_4d_dp = 1 
     178      ELSE 
     179         is_tile_4d_dp = 0 
     180      ENDIF 
     181   END FUNCTION is_tile_4d_dp 
    156182   !!====================================================================== 
    157183END MODULE domutl 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/DOM/domvvl.F90

    r14789 r14852  
    204204      gdept(:,:,1,Kbb) = 0.5_wp * e3w(:,:,1,Kbb) 
    205205      gdepw(:,:,1,Kbb) = 0.0_wp 
    206       DO_3D( 1, 1, 1, 1, 2, jpk )                     ! vertical sum 
     206      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, jpk )                     ! vertical sum 
    207207         !    zcoef = tmask - wmask    ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 
    208208         !                             ! 1 everywhere from mbkt to mikt + 1 or 1 (if no isf) 
    … …  
    404404         zwu(:,:) = 0._wp 
    405405         zwv(:,:) = 0._wp 
    406          DO_3D( 1, 0, 1, 0, 1, jpkm1 )   ! a - first derivative: diffusive fluxes 
     406         DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )       ! a - first derivative: diffusive fluxes 
    407407            un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * e2_e1u(ji,jj)           & 
    408408               &            * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj  ,jk) ) 
    … …  
    412412            zwv(ji,jj) = zwv(ji,jj) + vn_td(ji,jj,jk) 
    413413         END_3D 
    414          DO_2D( 1, 1, 1, 1 )             ! b - correction for last oceanic u-v points 
     414         DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )                 ! b - correction for last oceanic u-v points 
    415415            un_td(ji,jj,mbku(ji,jj)) = un_td(ji,jj,mbku(ji,jj)) - zwu(ji,jj) 
    416416            vn_td(ji,jj,mbkv(ji,jj)) = vn_td(ji,jj,mbkv(ji,jj)) - zwv(ji,jj) 
    … …  
    423423         !                               ! d - thickness diffusion transport: boundary conditions 
    424424         !                             (stored for tracer advction and continuity equation) 
    425          CALL lbc_lnk( 'domvvl', un_td , 'U' , -1._wp, vn_td , 'V' , -1._wp) 
     425         IF( nn_hls == 1 ) CALL lbc_lnk( 'domvvl', un_td , 'U' , -1._wp, vn_td , 'V' , -1._wp) 
    426426         ! 4 - Time stepping of baroclinic scale factors 
    427427         ! --------------------------------------------- 
    … …  
    640640      gdepw(:,:,1,Kmm) = 0.0_wp 
    641641      gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm) 
    642       DO_3D( 1, 1, 1, 1, 2, jpk ) 
     642      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, jpk ) 
    643643        !    zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))   ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 
    644644                                                           ! 1 for jk = mikt 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/DOM/dtatsd.F90

    r14789 r14852  
    141141      INTEGER ::   ji, jj, jk, jl, jkk   ! dummy loop indicies 
    142142      INTEGER ::   ik, il0, il1, ii0, ii1, ij0, ij1   ! local integers 
    143       INTEGER ::   itile 
    144143      INTEGER, DIMENSION(jpts), SAVE :: irec_b, irec_n 
    145144      REAL(wp)::   zl, zi                             ! local scalars 
    … …  
    147146      !!---------------------------------------------------------------------- 
    148147      ! 
    149       IF( ntile == 0 .OR. ntile == 1 )  THEN                                         ! Do only for the full domain 
    150          itile = ntile 
    151          IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 )            ! Use full domain 
     148      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                                         ! Do only for the full domain 
     149         IF( ln_tile ) CALL dom_tile_stop( ldhold=.TRUE. )             ! Use full domain 
    152150            CALL fld_read( kt, 1, sf_tsd )   !==   read T & S data at kt time step   ==! 
    153151      ! 
    … …  
    195193         ENDIF 
    196194!!gm end 
    197          IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = itile )            ! Revert to tile domain 
     195         IF( ln_tile ) CALL dom_tile_start( ldhold=.TRUE. )            ! Revert to tile domain 
    198196      ENDIF 
    199197      ! 
    … …  
    205203      IF( ln_sco ) THEN                   !==   s- or mixed s-zps-coordinate   ==! 
    206204         ! 
    207          IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     205         IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
    208206            IF( kt == nit000 .AND. lwp )THEN 
    209207               WRITE(numout,*) 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/DOM/istate.F90

    r14789 r14852  
    152152      ! 
    153153!!gm  the use of umsak & vmask is not necessary below as uu(:,:,:,Kmm), vv(:,:,:,Kmm), uu(:,:,:,Kbb), vv(:,:,:,Kbb) are always masked 
    154       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     154      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
    155155         uu_b(ji,jj,Kmm) = uu_b(ji,jj,Kmm) + e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) * umask(ji,jj,jk) 
    156156         vv_b(ji,jj,Kmm) = vv_b(ji,jj,Kmm) + e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) * vmask(ji,jj,jk) 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/DYN/divhor.F90

    r13558 r14852  
    6464      ! 
    6565      INTEGER  ::   ji, jj, jk    ! dummy loop indices 
    66       REAL(wp) ::   zraur, zdep   ! local scalars 
    67       REAL(wp), DIMENSION(jpi,jpj) :: ztmp 
    6866      !!---------------------------------------------------------------------- 
    6967      ! 
    … …  
    7169      ! 
    7270      IF( kt == nit000 ) THEN 
    73          IF(lwp) WRITE(numout,*) 
    74          IF(lwp) WRITE(numout,*) 'div_hor : horizontal velocity divergence ' 
    75          IF(lwp) WRITE(numout,*) '~~~~~~~   ' 
    76          hdiv(:,:,:) = 0._wp    ! initialize hdiv for the halos at the first time step 
     71         IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     72            IF(lwp) WRITE(numout,*) 
     73            IF(lwp) WRITE(numout,*) 'div_hor : horizontal velocity divergence ' 
     74            IF(lwp) WRITE(numout,*) '~~~~~~~   ' 
     75         ENDIF 
     76         DO_3D_OVR( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 
     77            hdiv(ji,jj,jk) = 0._wp    ! initialize hdiv for the halos at the first time step 
     78         END_3D 
    7779      ENDIF 
    7880      ! 
    79       DO_3D( 0, 0, 0, 0, 1, jpkm1 )                                    !==  Horizontal divergence  ==! 
    80          hdiv(ji,jj,jk) = (   e2u(ji  ,jj) * e3u(ji  ,jj,jk,Kmm) * uu(ji  ,jj,jk,Kmm)      & 
    81             &               - e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm) * uu(ji-1,jj,jk,Kmm)      & 
    82             &               + e1v(ji,jj  ) * e3v(ji,jj  ,jk,Kmm) * vv(ji,jj  ,jk,Kmm)      & 
    83             &               - e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm) * vv(ji,jj-1,jk,Kmm)  )   & 
    84             &            * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 
     81      DO_3D_OVR( nn_hls-1, nn_hls, nn_hls-1, nn_hls, 1, jpkm1 )                                    !==  Horizontal divergence  ==! 
     82         ! round brackets added to fix the order of floating point operations 
     83         ! needed to ensure halo 1 - halo 2 compatibility 
     84         hdiv(ji,jj,jk) = (  ( e2u(ji  ,jj) * e3u(ji  ,jj,jk,Kmm) * uu(ji  ,jj,jk,Kmm)     & 
     85            &                - e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm) * uu(ji-1,jj,jk,Kmm)     & 
     86            &                )                                                             & ! bracket for halo 1 - halo 2 compatibility 
     87            &              + ( e1v(ji,jj  ) * e3v(ji,jj  ,jk,Kmm) * vv(ji,jj  ,jk,Kmm)     & 
     88            &                - e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm) * vv(ji,jj-1,jk,Kmm)     & 
     89            &                )                                                             & ! bracket for halo 1 - halo 2 compatibility 
     90            &             )  * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 
    8591      END_3D 
    8692      ! 
    … …  
    9197      !  
    9298#endif 
    93       ! 
    9499      IF( ln_isf )                      CALL isf_hdiv( kt, Kmm, hdiv )           !==  ice shelf         ==!   (update hdiv field) 
    95100      ! 
    96       CALL lbc_lnk( 'divhor', hdiv, 'T', 1.0_wp )   !   (no sign change) 
     101      IF (nn_hls==1) CALL lbc_lnk( 'divhor', hdiv, 'T', 1.0_wp )   !   (no sign change) 
    97102      ! 
    98103      IF( ln_timing )   CALL timing_stop('div_hor') 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/DYN/dynadv_cen2.F90

    r13497 r14852  
    5252      ! 
    5353      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    54       REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zfu_t, zfu_f, zfu_uw, zfu 
    55       REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zfv_t, zfv_f, zfv_vw, zfv, zfw 
     54      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::  zfu_t, zfu_f, zfu_uw, zfu 
     55      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::  zfv_t, zfv_f, zfv_vw, zfv, zfw 
    5656      !!---------------------------------------------------------------------- 
    5757      ! 
    58       IF( kt == nit000 .AND. lwp ) THEN 
    59          WRITE(numout,*) 
    60          WRITE(numout,*) 'dyn_adv_cen2 : 2nd order flux form momentum advection' 
    61          WRITE(numout,*) '~~~~~~~~~~~~' 
     58      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     59         IF( kt == nit000 .AND. lwp ) THEN 
     60            WRITE(numout,*) 
     61            WRITE(numout,*) 'dyn_adv_cen2 : 2nd order flux form momentum advection' 
     62            WRITE(numout,*) '~~~~~~~~~~~~' 
     63         ENDIF 
    6264      ENDIF 
    6365      ! 
    … …  
    7072      ! 
    7173      DO jk = 1, jpkm1                    ! horizontal transport 
    72          zfu(:,:,jk) = 0.25_wp * e2u(:,:) * e3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm) 
    73          zfv(:,:,jk) = 0.25_wp * e1v(:,:) * e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) 
     74         DO_2D( 1, 1, 1, 1 ) 
     75            zfu(ji,jj,jk) = 0.25_wp * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * puu(ji,jj,jk,Kmm) 
     76            zfv(ji,jj,jk) = 0.25_wp * e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * pvv(ji,jj,jk,Kmm) 
     77         END_2D 
    7478         DO_2D( 1, 0, 1, 0 )              ! horizontal momentum fluxes (at T- and F-point) 
    7579            zfu_t(ji+1,jj  ,jk) = ( zfu(ji,jj,jk) + zfu(ji+1,jj,jk) ) * ( puu(ji,jj,jk,Kmm) + puu(ji+1,jj  ,jk,Kmm) ) 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/DYN/dynadv_ubs.F90

    r14789 r14852  
    7575      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    7676      REAL(wp) ::   zui, zvj, zfuj, zfvi, zl_u, zl_v   ! local scalars 
    77       REAL(wp), DIMENSION(jpi,jpj,jpk)   ::   zfu_t, zfu_f, zfu_uw, zfu 
    78       REAL(wp), DIMENSION(jpi,jpj,jpk)   ::   zfv_t, zfv_f, zfv_vw, zfv, zfw 
    79       REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   zlu_uu, zlu_uv 
    80       REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   zlv_vv, zlv_vu 
     77      REAL(wp), DIMENSION(A2D(nn_hls),jpk)   ::   zfu_t, zfu_f, zfu_uw, zfu 
     78      REAL(wp), DIMENSION(A2D(nn_hls),jpk)   ::   zfv_t, zfv_f, zfv_vw, zfv, zfw 
     79      REAL(wp), DIMENSION(A2D(nn_hls),jpk,2) ::   zlu_uu, zlu_uv 
     80      REAL(wp), DIMENSION(A2D(nn_hls),jpk,2) ::   zlv_vv, zlv_vu 
    8181      !!---------------------------------------------------------------------- 
    8282      ! 
    83       IF( kt == nit000 ) THEN 
    84          IF(lwp) WRITE(numout,*) 
    85          IF(lwp) WRITE(numout,*) 'dyn_adv_ubs : UBS flux form momentum advection' 
    86          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
     83      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     84         IF( kt == nit000 ) THEN 
     85            IF(lwp) WRITE(numout,*) 
     86            IF(lwp) WRITE(numout,*) 'dyn_adv_ubs : UBS flux form momentum advection' 
     87            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
     88         ENDIF 
    8789      ENDIF 
    8890      ! 
    … …  
    105107         !                                   ! =========================== ! 
    106108         !                                         ! horizontal volume fluxes 
    107          zfu(:,:,jk) = e2u(:,:) * e3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm) 
    108          zfv(:,:,jk) = e1v(:,:) * e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) 
     109         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     110            zfu(ji,jj,jk) = e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * puu(ji,jj,jk,Kmm) 
     111            zfv(ji,jj,jk) = e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * pvv(ji,jj,jk,Kmm) 
     112         END_2D 
    109113         !             
    110          DO_2D( 0, 0, 0, 0 )                       ! laplacian 
    111             zlu_uu(ji,jj,jk,1) = ( puu (ji+1,jj  ,jk,Kbb) - 2.*puu (ji,jj,jk,Kbb) + puu (ji-1,jj  ,jk,Kbb) ) * umask(ji,jj,jk) 
    112             zlv_vv(ji,jj,jk,1) = ( pvv (ji  ,jj+1,jk,Kbb) - 2.*pvv (ji,jj,jk,Kbb) + pvv (ji  ,jj-1,jk,Kbb) ) * vmask(ji,jj,jk) 
    113             zlu_uv(ji,jj,jk,1) = ( puu (ji  ,jj+1,jk,Kbb) - puu (ji  ,jj  ,jk,Kbb) ) * fmask(ji  ,jj  ,jk)   & 
    114                &               - ( puu (ji  ,jj  ,jk,Kbb) - puu (ji  ,jj-1,jk,Kbb) ) * fmask(ji  ,jj-1,jk) 
    115             zlv_vu(ji,jj,jk,1) = ( pvv (ji+1,jj  ,jk,Kbb) - pvv (ji  ,jj  ,jk,Kbb) ) * fmask(ji  ,jj  ,jk)   & 
    116                &               - ( pvv (ji  ,jj  ,jk,Kbb) - pvv (ji-1,jj  ,jk,Kbb) ) * fmask(ji-1,jj  ,jk) 
    117             ! 
    118             zlu_uu(ji,jj,jk,2) = ( zfu(ji+1,jj  ,jk) - 2.*zfu(ji,jj,jk) + zfu(ji-1,jj  ,jk) ) * umask(ji,jj,jk) 
    119             zlv_vv(ji,jj,jk,2) = ( zfv(ji  ,jj+1,jk) - 2.*zfv(ji,jj,jk) + zfv(ji  ,jj-1,jk) ) * vmask(ji,jj,jk) 
    120             zlu_uv(ji,jj,jk,2) = ( zfu(ji  ,jj+1,jk) - zfu(ji  ,jj  ,jk) ) * fmask(ji  ,jj  ,jk)   & 
    121                &               - ( zfu(ji  ,jj  ,jk) - zfu(ji  ,jj-1,jk) ) * fmask(ji  ,jj-1,jk) 
    122             zlv_vu(ji,jj,jk,2) = ( zfv(ji+1,jj  ,jk) - zfv(ji  ,jj  ,jk) ) * fmask(ji  ,jj  ,jk)   & 
    123                &               - ( zfv(ji  ,jj  ,jk) - zfv(ji-1,jj  ,jk) ) * fmask(ji-1,jj  ,jk) 
     114         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )                       ! laplacian 
     115            ! round brackets added to fix the order of floating point operations 
     116            ! needed to ensure halo 1 - halo 2 compatibility 
     117            zlu_uu(ji,jj,jk,1) = ( ( puu (ji+1,jj  ,jk,Kbb) - puu (ji  ,jj  ,jk,Kbb) & 
     118               &                   )                                                 & ! bracket for halo 1 - halo 2 compatibility 
     119               &                 + ( puu (ji-1,jj  ,jk,Kbb) - puu (ji  ,jj  ,jk,Kbb) & 
     120               &                   )                                                 & ! bracket for halo 1 - halo 2 compatibility 
     121               &                 ) * umask(ji  ,jj  ,jk) 
     122            zlv_vv(ji,jj,jk,1) = ( ( pvv (ji  ,jj+1,jk,Kbb) - pvv (ji  ,jj  ,jk,Kbb) & 
     123               &                   )                                                 & ! bracket for halo 1 - halo 2 compatibility 
     124               &                 + ( pvv (ji  ,jj-1,jk,Kbb) - pvv (ji  ,jj  ,jk,Kbb) & 
     125               &                   )                                                 & ! bracket for halo 1 - halo 2 compatibility 
     126               &                 ) * vmask(ji  ,jj  ,jk) 
     127            zlu_uv(ji,jj,jk,1) = (  puu (ji  ,jj+1,jk,Kbb) - puu (ji  ,jj  ,jk,Kbb)  ) * fmask(ji  ,jj  ,jk)   & 
     128               &               - (  puu (ji  ,jj  ,jk,Kbb) - puu (ji  ,jj-1,jk,Kbb)  ) * fmask(ji  ,jj-1,jk) 
     129            zlv_vu(ji,jj,jk,1) = (  pvv (ji+1,jj  ,jk,Kbb) - pvv (ji  ,jj  ,jk,Kbb)  ) * fmask(ji  ,jj  ,jk)   & 
     130               &               - (  pvv (ji  ,jj  ,jk,Kbb) - pvv (ji-1,jj  ,jk,Kbb)  ) * fmask(ji-1,jj  ,jk) 
     131            ! 
     132            ! round brackets added to fix the order of floating point operations 
     133            ! needed to ensure halo 1 - halo 2 compatibility 
     134            zlu_uu(ji,jj,jk,2) = ( ( zfu(ji+1,jj  ,jk) - zfu(ji  ,jj  ,jk)           & 
     135               &                   )                                                 & ! bracket for halo 1 - halo 2 compatibility 
     136               &                 + ( zfu(ji-1,jj  ,jk) - zfu(ji  ,jj  ,jk)           & 
     137               &                   )                                                 & ! bracket for halo 1 - halo 2 compatibility 
     138               &                 ) * umask(ji  ,jj  ,jk) 
     139            zlv_vv(ji,jj,jk,2) = ( ( zfv(ji  ,jj+1,jk) - zfv(ji  ,jj  ,jk)           & 
     140               &                   )                                                 & ! bracket for halo 1 - halo 2 compatibility 
     141               &                 + ( zfv(ji  ,jj-1,jk) - zfv(ji  ,jj  ,jk)           & 
     142               &                   )                                                 & ! bracket for halo 1 - halo 2 compatibility 
     143               &                 ) * vmask(ji  ,jj  ,jk) 
     144            zlu_uv(ji,jj,jk,2) = (  zfu(ji  ,jj+1,jk) - zfu(ji  ,jj  ,jk)  ) * fmask(ji  ,jj  ,jk)             & 
     145               &               - (  zfu(ji  ,jj  ,jk) - zfu(ji  ,jj-1,jk)  ) * fmask(ji  ,jj-1,jk) 
     146            zlv_vu(ji,jj,jk,2) = (  zfv(ji+1,jj  ,jk) - zfv(ji  ,jj  ,jk)  ) * fmask(ji  ,jj  ,jk)             & 
     147               &               - (  zfv(ji  ,jj  ,jk) - zfv(ji-1,jj  ,jk)  ) * fmask(ji-1,jj  ,jk) 
    124148         END_2D 
    125149      END DO 
    126       CALL lbc_lnk( 'dynadv_ubs', zlu_uu(:,:,:,1), 'U', 1.0_wp , zlu_uv(:,:,:,1), 'U', 1.0_wp,  & 
    127          &                        zlu_uu(:,:,:,2), 'U', 1.0_wp , zlu_uv(:,:,:,2), 'U', 1.0_wp,  &  
    128          &                        zlv_vv(:,:,:,1), 'V', 1.0_wp , zlv_vu(:,:,:,1), 'V', 1.0_wp,  & 
    129          &                        zlv_vv(:,:,:,2), 'V', 1.0_wp , zlv_vu(:,:,:,2), 'V', 1.0_wp   ) 
     150      IF( nn_hls == 1 ) CALL lbc_lnk( 'dynadv_ubs', zlu_uu(:,:,:,1), 'U', -1.0_wp , zlu_uv(:,:,:,1), 'U', -1.0_wp,  & 
     151                                              &   zlu_uu(:,:,:,2), 'U', -1.0_wp , zlu_uv(:,:,:,2), 'U', -1.0_wp,  & 
     152                                              &   zlv_vv(:,:,:,1), 'V', -1.0_wp , zlv_vu(:,:,:,1), 'V', -1.0_wp,  & 
     153                                              &   zlv_vv(:,:,:,2), 'V', -1.0_wp , zlv_vu(:,:,:,2), 'V', -1.0_wp   ) 
    130154      ! 
    131155      !                                      ! ====================== ! 
    … …  
    133157      DO jk = 1, jpkm1                       ! ====================== ! 
    134158         !                                         ! horizontal volume fluxes 
    135          zfu(:,:,jk) = 0.25_wp * e2u(:,:) * e3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm) 
    136          zfv(:,:,jk) = 0.25_wp * e1v(:,:) * e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) 
     159         DO_2D( 1, 1, 1, 1 ) 
     160            zfu(ji,jj,jk) = 0.25_wp * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * puu(ji,jj,jk,Kmm) 
     161            zfv(ji,jj,jk) = 0.25_wp * e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * pvv(ji,jj,jk,Kmm) 
     162         END_2D 
    137163         ! 
    138164         DO_2D( 1, 0, 1, 0 )                       ! horizontal momentum fluxes at T- and F-point 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/DYN/dynatf.F90

    r14789 r14852  
    201201         IF( ln_linssh ) THEN             ! Fixed volume ! 
    202202            !                             ! =============! 
    203             DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     203            DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
    204204               puu(ji,jj,jk,Kmm) = puu(ji,jj,jk,Kmm) + rn_atfp * ( puu(ji,jj,jk,Kbb) - 2._wp * puu(ji,jj,jk,Kmm) + puu(ji,jj,jk,Kaa) ) 
    205205               pvv(ji,jj,jk,Kmm) = pvv(ji,jj,jk,Kmm) + rn_atfp * ( pvv(ji,jj,jk,Kbb) - 2._wp * pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk,Kaa) ) 
    … …  
    237237               CALL dom_vvl_interpol( pe3t(:,:,:,Kmm), pe3u(:,:,:,Kmm), 'U' ) 
    238238               CALL dom_vvl_interpol( pe3t(:,:,:,Kmm), pe3v(:,:,:,Kmm), 'V' ) 
    239                DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     239               DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
    240240                  puu(ji,jj,jk,Kmm) = puu(ji,jj,jk,Kmm) + rn_atfp * ( puu(ji,jj,jk,Kbb) - 2._wp * puu(ji,jj,jk,Kmm) + puu(ji,jj,jk,Kaa) ) 
    241241                  pvv(ji,jj,jk,Kmm) = pvv(ji,jj,jk,Kmm) + rn_atfp * ( pvv(ji,jj,jk,Kbb) - 2._wp * pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk,Kaa) ) 
    … …  
    248248               CALL dom_vvl_interpol( pe3t(:,:,:,Kmm), ze3u_f, 'U' ) 
    249249               CALL dom_vvl_interpol( pe3t(:,:,:,Kmm), ze3v_f, 'V' ) 
    250                DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     250               DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
    251251                  zue3a = pe3u(ji,jj,jk,Kaa) * puu(ji,jj,jk,Kaa) 
    252252                  zve3a = pe3v(ji,jj,jk,Kaa) * pvv(ji,jj,jk,Kaa) 
    … …  
    285285      ENDIF ! .NOT. l_1st_euler 
    286286      ! 
     287      ! This is needed for dyn_ldf_blp to be restartable 
     288      IF( nn_hls == 2 ) CALL lbc_lnk( 'dynatf', puu(:,:,:,Kmm), 'U', -1.0_wp, pvv(:,:,:,Kmm), 'V', -1.0_wp ) 
    287289      ! Set "now" and "before" barotropic velocities for next time step: 
    288290      ! JC: Would be more clever to swap variables than to make a full vertical 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/DYN/dynatf_qco.F90

    r14789 r14852  
    139139         IF( ln_linssh ) THEN             ! Fixed volume ! 
    140140            !                             ! =============! 
    141             DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     141            DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
    142142               puu(ji,jj,jk,Kmm) = puu(ji,jj,jk,Kmm) + rn_atfp * ( puu(ji,jj,jk,Kbb) - 2._wp * puu(ji,jj,jk,Kmm) + puu(ji,jj,jk,Kaa) ) 
    143143               pvv(ji,jj,jk,Kmm) = pvv(ji,jj,jk,Kmm) + rn_atfp * ( pvv(ji,jj,jk,Kbb) - 2._wp * pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk,Kaa) ) 
    … …  
    149149            IF( ln_dynadv_vec ) THEN      ! Asselin filter applied on velocity 
    150150               ! Before filtered scale factor at (u/v)-points 
    151                DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     151               DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
    152152                  puu(ji,jj,jk,Kmm) = puu(ji,jj,jk,Kmm) + rn_atfp * ( puu(ji,jj,jk,Kbb) - 2._wp * puu(ji,jj,jk,Kmm) + puu(ji,jj,jk,Kaa) ) 
    153153                  pvv(ji,jj,jk,Kmm) = pvv(ji,jj,jk,Kmm) + rn_atfp * ( pvv(ji,jj,jk,Kbb) - 2._wp * pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk,Kaa) ) 
    … …  
    156156            ELSE                          ! Asselin filter applied on thickness weighted velocity 
    157157               ! 
    158                DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     158               DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
    159159                  zue3a = ( 1._wp + r3u(ji,jj,Kaa) * umask(ji,jj,jk) ) * puu(ji,jj,jk,Kaa) 
    160160                  zve3a = ( 1._wp + r3v(ji,jj,Kaa) * vmask(ji,jj,jk) ) * pvv(ji,jj,jk,Kaa) 
    … …  
    195195      ENDIF ! .NOT. l_1st_euler 
    196196      ! 
     197      ! This is needed for dyn_ldf_blp to be restartable 
     198      IF( nn_hls == 2 ) CALL lbc_lnk( 'dynatfqco', puu(:,:,:,Kmm), 'U', -1.0_wp, pvv(:,:,:,Kmm), 'V', -1.0_wp ) 
     199 
    197200      ! Set "now" and "before" barotropic velocities for next time step: 
    198201      ! JC: Would be more clever to swap variables than to make a full vertical 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/DYN/dynhpg.F90

    r14789 r14852  
    266266      INTEGER  ::   ji, jj, jk       ! dummy loop indices 
    267267      REAL(wp) ::   zcoef0, zcoef1   ! temporary scalars 
    268       REAL(wp), DIMENSION(jpi,jpj) ::  zhpi, zhpj 
    269       !!---------------------------------------------------------------------- 
    270       ! 
    271       IF( kt == nit000 ) THEN 
    272          IF(lwp) WRITE(numout,*) 
    273          IF(lwp) WRITE(numout,*) 'dyn:hpg_zco : hydrostatic pressure gradient trend' 
    274          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   z-coordinate case ' 
     268      REAL(wp), DIMENSION(A2D(nn_hls)) ::  zhpi, zhpj 
     269      !!---------------------------------------------------------------------- 
     270      ! 
     271      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     272         IF( kt == nit000 ) THEN 
     273            IF(lwp) WRITE(numout,*) 
     274            IF(lwp) WRITE(numout,*) 'dyn:hpg_zco : hydrostatic pressure gradient trend' 
     275            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   z-coordinate case ' 
     276         ENDIF 
    275277      ENDIF 
    276278      ! 
    … …  
    318320      INTEGER  ::   iku, ikv                         ! temporary integers 
    319321      REAL(wp) ::   zcoef0, zcoef1, zcoef2, zcoef3   ! temporary scalars 
    320       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zhpi, zhpj 
    321       REAL(wp), DIMENSION(jpi,jpj,jpts)   :: zgtsu, zgtsv 
    322       REAL(wp), DIMENSION(jpi,jpj)     :: zgru, zgrv 
    323       !!---------------------------------------------------------------------- 
    324       ! 
    325       IF( kt == nit000 ) THEN 
    326          IF(lwp) WRITE(numout,*) 
    327          IF(lwp) WRITE(numout,*) 'dyn:hpg_zps : hydrostatic pressure gradient trend' 
    328          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   z-coordinate with partial steps - vector optimization' 
     322      REAL(wp), DIMENSION(A2D(nn_hls),jpk ) :: zhpi, zhpj 
     323      REAL(wp), DIMENSION(A2D(nn_hls),jpts) :: zgtsu, zgtsv 
     324      REAL(wp), DIMENSION(A2D(nn_hls)     ) :: zgru, zgrv 
     325      !!---------------------------------------------------------------------- 
     326      ! 
     327      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     328         IF( kt == nit000 ) THEN 
     329            IF(lwp) WRITE(numout,*) 
     330            IF(lwp) WRITE(numout,*) 'dyn:hpg_zps : hydrostatic pressure gradient trend' 
     331            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   z-coordinate with partial steps - vector optimization' 
     332         ENDIF 
    329333      ENDIF 
    330334 
    … …  
    410414      REAL(wp) ::   zcoef0, zuap, zvap, ztmp       ! local scalars 
    411415      LOGICAL  ::   ll_tmp1, ll_tmp2               ! local logical variables 
    412       REAL(wp), DIMENSION(jpi,jpj,jpk)      ::   zhpi, zhpj 
     416      REAL(wp), DIMENSION(A2D(nn_hls),jpk)  ::   zhpi, zhpj 
    413417      REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   zcpx, zcpy   !W/D pressure filter 
    414418      !!---------------------------------------------------------------------- 
    415419      ! 
    416       IF( ln_wd_il ) ALLOCATE(zcpx(jpi,jpj), zcpy(jpi,jpj)) 
    417       ! 
    418       IF( kt == nit000 ) THEN 
    419          IF(lwp) WRITE(numout,*) 
    420          IF(lwp) WRITE(numout,*) 'dyn:hpg_sco : hydrostatic pressure gradient trend' 
    421          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   s-coordinate case, OCE original scheme used' 
     420      IF( ln_wd_il ) ALLOCATE(zcpx(A2D(nn_hls)), zcpy(A2D(nn_hls))) 
     421      ! 
     422      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     423         IF( kt == nit000 ) THEN 
     424            IF(lwp) WRITE(numout,*) 
     425            IF(lwp) WRITE(numout,*) 'dyn:hpg_sco : hydrostatic pressure gradient trend' 
     426            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   s-coordinate case, OCE original scheme used' 
     427         ENDIF 
    422428      ENDIF 
    423429      ! 
    … …  
    462468          END IF 
    463469        END_2D 
    464         CALL lbc_lnk( 'dynhpg', zcpx, 'U', 1.0_wp, zcpy, 'V', 1.0_wp ) 
    465470      END IF 
    466471      ! 
    … …  
    548553      REAL(wp) ::   ze3w, ze3wi1, ze3wj1   ! local scalars 
    549554      REAL(wp) ::   zcoef0, zuap, zvap     !   -      - 
    550       REAL(wp), DIMENSION(jpi,jpj,jpk ) ::  zhpi, zhpj 
    551       REAL(wp), DIMENSION(jpi,jpj,jpts) ::  zts_top 
    552       REAL(wp), DIMENSION(jpi,jpj)      ::  zrhdtop_oce 
     555      REAL(wp), DIMENSION(A2D(nn_hls),jpk ) ::  zhpi, zhpj 
     556      REAL(wp), DIMENSION(A2D(nn_hls),jpts) ::  zts_top 
     557      REAL(wp), DIMENSION(A2D(nn_hls))      ::  zrhdtop_oce 
    553558      !!---------------------------------------------------------------------- 
    554559      ! 
    … …  
    560565      ! compute rhd at the ice/oce interface (ocean side) 
    561566      ! usefull to reduce residual current in the test case ISOMIP with no melting 
    562       DO ji = 1, jpi 
    563         DO jj = 1, jpj 
    564           ikt = mikt(ji,jj) 
    565           zts_top(ji,jj,1) = ts(ji,jj,ikt,1,Kmm) 
    566           zts_top(ji,jj,2) = ts(ji,jj,ikt,2,Kmm) 
    567         END DO 
    568       END DO 
     567      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     568         ikt = mikt(ji,jj) 
     569         zts_top(ji,jj,1) = ts(ji,jj,ikt,1,Kmm) 
     570         zts_top(ji,jj,2) = ts(ji,jj,ikt,2,Kmm) 
     571      END_2D 
    569572      CALL eos( zts_top, risfdep, zrhdtop_oce ) 
    570573 
    … …  
    636639      INTEGER  ::   iktb, iktt          ! jk indices at tracer points for top and bottom points  
    637640      REAL(wp) ::   zcoef0, zep, cffw   ! temporary scalars 
    638       REAL(wp) ::   z_grav_10, z1_12 
     641      REAL(wp) ::   z_grav_10, z1_12, z1_cff 
    639642      REAL(wp) ::   cffu, cffx          !    "         " 
    640643      REAL(wp) ::   cffv, cffy          !    "         " 
    641644      LOGICAL  ::   ll_tmp1, ll_tmp2    ! local logical variables 
    642       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zhpi, zhpj 
    643   
    644       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdzx, zdzy, zdzz                          ! Primitive grid differences ('delta_xyz') 
    645       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdz_i, zdz_j, zdz_k                       ! Harmonic average of primitive grid differences ('d_xyz') 
    646       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdrhox, zdrhoy, zdrhoz                    ! Primitive rho differences ('delta_rho') 
    647       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdrho_i, zdrho_j, zdrho_k                 ! Harmonic average of primitive rho differences ('d_rho') 
    648       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   z_rho_i, z_rho_j, z_rho_k                 ! Face intergrals 
    649       REAL(wp), DIMENSION(jpi,jpj)     ::   zz_dz_i, zz_dz_j, zz_drho_i, zz_drho_j    ! temporary arrays  
     645      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zhpi, zhpj 
     646 
     647      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zdzx, zdzy, zdzz                          ! Primitive grid differences ('delta_xyz') 
     648      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zdz_i, zdz_j, zdz_k                       ! Harmonic average of primitive grid differences ('d_xyz') 
     649      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zdrhox, zdrhoy, zdrhoz                    ! Primitive rho differences ('delta_rho') 
     650      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zdrho_i, zdrho_j, zdrho_k                 ! Harmonic average of primitive rho differences ('d_rho') 
     651      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   z_rho_i, z_rho_j, z_rho_k                 ! Face intergrals 
     652      REAL(wp), DIMENSION(A2D(nn_hls))     ::   zz_dz_i, zz_dz_j, zz_drho_i, zz_drho_j    ! temporary arrays 
    650653      REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   zcpx, zcpy   !W/D pressure filter 
    651654      !!---------------------------------------------------------------------- 
    652655      ! 
    653656      IF( ln_wd_il ) THEN 
    654          ALLOCATE( zcpx(jpi,jpj) , zcpy(jpi,jpj) ) 
     657         ALLOCATE( zcpx(A2D(nn_hls)) , zcpy(A2D(nn_hls)) ) 
    655658        DO_2D( 0, 0, 0, 0 ) 
    656659          ll_tmp1 = MIN(  ssh(ji,jj,Kmm)              ,  ssh(ji+1,jj,Kmm) ) >                & 
    … …  
    689692          END IF 
    690693        END_2D 
    691         CALL lbc_lnk( 'dynhpg', zcpx, 'U', 1.0_wp, zcpy, 'V', 1.0_wp ) 
    692694      END IF 
    693695 
    694       IF( kt == nit000 ) THEN 
    695          IF(lwp) WRITE(numout,*) 
    696          IF(lwp) WRITE(numout,*) 'dyn:hpg_djc : hydrostatic pressure gradient trend' 
    697          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   s-coordinate case, density Jacobian with cubic polynomial scheme' 
     696      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     697         IF( kt == nit000 ) THEN 
     698            IF(lwp) WRITE(numout,*) 
     699            IF(lwp) WRITE(numout,*) 'dyn:hpg_djc : hydrostatic pressure gradient trend' 
     700            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   s-coordinate case, density Jacobian with cubic polynomial scheme' 
     701         ENDIF 
    698702      ENDIF 
    699703 
    … …  
    723727      zdz_k  (:,:,:) = 0._wp 
    724728 
    725       DO_3D( 1, 1, 1, 1, 2, jpk-2 )  
    726          cffw = 2._wp * zdrhoz(ji  ,jj  ,jk) * zdrhoz(ji,jj,jk+1) 
    727          IF( cffw > zep) THEN 
    728             zdrho_k(ji,jj,jk) = cffw / ( zdrhoz(ji,jj,jk) + zdrhoz(ji,jj,jk+1) ) 
    729          ENDIF 
     729      DO_3D( 1, 1, 1, 1, 2, jpk-2 ) 
     730         cffw = MAX( 2._wp * zdrhoz(ji,jj,jk) * zdrhoz(ji,jj,jk+1), 0._wp ) 
     731         z1_cff = zdrhoz(ji,jj,jk) + zdrhoz(ji,jj,jk+1) 
     732         zdrho_k(ji,jj,jk) = cffw / SIGN( MAX( ABS(z1_cff), zep ), z1_cff ) 
    730733         zdz_k(ji,jj,jk) = 2._wp *   zdzz(ji,jj,jk) * zdzz(ji,jj,jk+1)   & 
    731734            &                  / ( zdzz(ji,jj,jk) + zdzz(ji,jj,jk+1) ) 
    … …  
    737740 
    738741! mb for sea-ice shelves we will need to re-write this upper boundary condition in the same form as the lower boundary condition 
    739       zdrho_k(:,:,1) = aco_bc_vrt * ( rhd    (:,:,2) - rhd    (:,:,1) ) - bco_bc_vrt * zdrho_k(:,:,2) 
    740       zdz_k  (:,:,1) = aco_bc_vrt * (-gde3w(:,:,2) + gde3w(:,:,1) ) - bco_bc_vrt * zdz_k  (:,:,2) 
     742      DO_2D( 1, 1, 1, 1 ) 
     743         zdrho_k(ji,jj,1) = aco_bc_vrt * ( rhd  (ji,jj,2) - rhd  (ji,jj,1) ) - bco_bc_vrt * zdrho_k(ji,jj,2) 
     744         zdz_k  (ji,jj,1) = aco_bc_vrt * (-gde3w(ji,jj,2) + gde3w(ji,jj,1) ) - bco_bc_vrt * zdz_k  (ji,jj,2) 
     745      END_2D 
    741746 
    742747      DO_2D( 1, 1, 1, 1 ) 
    … …  
    785790      !  5. compute and store elementary horizontal differences in provisional arrays  
    786791      !---------------------------------------------------------------------------------------- 
    787  
    788       DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 
    789          zdrhox(ji,jj,jk) =   rhd    (ji+1,jj  ,jk) - rhd    (ji,jj,jk  ) 
    790          zdzx  (ji,jj,jk) = - gde3w(ji+1,jj  ,jk) + gde3w(ji,jj,jk  ) 
    791          zdrhoy(ji,jj,jk) =   rhd    (ji  ,jj+1,jk) - rhd    (ji,jj,jk  ) 
    792          zdzy  (ji,jj,jk) = - gde3w(ji  ,jj+1,jk) + gde3w(ji,jj,jk  ) 
    793       END_3D 
    794  
    795       CALL lbc_lnk( 'dynhpg', zdrhox, 'U', 1., zdzx, 'U', 1., zdrhoy, 'V', 1., zdzy, 'V', 1. )  
     792      zdrhox(:,:,:) = 0._wp 
     793      zdzx  (:,:,:) = 0._wp 
     794      zdrhoy(:,:,:) = 0._wp 
     795      zdzy  (:,:,:) = 0._wp 
     796 
     797      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
     798         zdrhox(ji,jj,jk) = rhd  (ji+1,jj  ,jk) - rhd  (ji  ,jj  ,jk) 
     799         zdzx  (ji,jj,jk) = gde3w(ji  ,jj  ,jk) - gde3w(ji+1,jj  ,jk) 
     800         zdrhoy(ji,jj,jk) = rhd  (ji  ,jj+1,jk) - rhd  (ji  ,jj  ,jk) 
     801         zdzy  (ji,jj,jk) = gde3w(ji  ,jj  ,jk) - gde3w(ji  ,jj+1,jk) 
     802      END_3D 
     803 
     804      IF( nn_hls == 1 ) CALL lbc_lnk( 'dynhpg', zdrhox, 'U', -1._wp, zdzx, 'U', -1._wp, zdrhoy, 'V', -1._wp, zdzy, 'V', -1._wp ) 
    796805 
    797806      !------------------------------------------------------------------------- 
    … …  
    800809 
    801810      DO_3D( 0, 1, 0, 1, 1, jpkm1 ) 
    802          cffu = 2._wp * zdrhox(ji-1,jj  ,jk) * zdrhox(ji,jj,jk  ) 
    803          IF( cffu > zep ) THEN 
    804             zdrho_i(ji,jj,jk) = cffu / ( zdrhox(ji-1,jj,jk) + zdrhox(ji,jj,jk) ) 
    805          ELSE 
    806             zdrho_i(ji,jj,jk ) = 0._wp 
    807          ENDIF 
    808  
    809          cffx = 2._wp * zdzx  (ji-1,jj  ,jk) * zdzx  (ji,jj,jk  ) 
    810          IF( cffx > zep ) THEN 
    811             zdz_i(ji,jj,jk) = cffx / ( zdzx(ji-1,jj,jk) + zdzx(ji,jj,jk) ) 
    812          ELSE 
    813             zdz_i(ji,jj,jk) = 0._wp 
    814          ENDIF 
    815  
    816          cffv = 2._wp * zdrhoy(ji  ,jj-1,jk) * zdrhoy(ji,jj,jk  ) 
    817          IF( cffv > zep ) THEN 
    818             zdrho_j(ji,jj,jk) = cffv / ( zdrhoy(ji,jj-1,jk) + zdrhoy(ji,jj,jk) ) 
    819          ELSE 
    820             zdrho_j(ji,jj,jk) = 0._wp 
    821          ENDIF 
    822  
    823          cffy = 2._wp * zdzy  (ji  ,jj-1,jk) * zdzy  (ji,jj,jk  ) 
    824          IF( cffy > zep ) THEN 
    825             zdz_j(ji,jj,jk) = cffy / ( zdzy(ji,jj-1,jk) + zdzy(ji,jj,jk) ) 
    826          ELSE 
    827             zdz_j(ji,jj,jk) = 0._wp 
    828          ENDIF 
     811         cffu = MAX( 2._wp * zdrhox(ji-1,jj,jk) * zdrhox(ji,jj,jk), 0._wp ) 
     812         z1_cff = zdrhox(ji-1,jj,jk) + zdrhox(ji,jj,jk) 
     813         zdrho_i(ji,jj,jk) = cffu / SIGN( MAX( ABS(z1_cff), zep ), z1_cff ) 
     814 
     815         cffx = MAX( 2._wp * zdzx(ji-1,jj,jk)   * zdzx(ji,jj,jk), 0._wp ) 
     816         z1_cff = zdzx(ji-1,jj,jk)   + zdzx(ji,jj,jk) 
     817         zdz_i(ji,jj,jk)   = cffx / SIGN( MAX( ABS(z1_cff), zep ), z1_cff ) 
     818 
     819         cffv = MAX( 2._wp * zdrhoy(ji,jj-1,jk) * zdrhoy(ji,jj,jk), 0._wp ) 
     820         z1_cff = zdrhoy(ji,jj-1,jk) + zdrhoy(ji,jj,jk) 
     821         zdrho_j(ji,jj,jk) = cffv / SIGN( MAX( ABS(z1_cff), zep ), z1_cff ) 
     822 
     823         cffy = MAX( 2._wp * zdzy(ji,jj-1,jk)   * zdzy(ji,jj,jk), 0._wp ) 
     824         z1_cff = zdzy(ji,jj-1,jk)   + zdzy(ji,jj,jk) 
     825         zdz_j(ji,jj,jk)   = cffy / SIGN( MAX( ABS(z1_cff), zep ), z1_cff ) 
    829826      END_3D 
    830827       
    … …  
    840837         zz_drho_j(:,:) = zdrho_j(:,:,jk) 
    841838         zz_dz_j  (:,:) = zdz_j  (:,:,jk) 
    842          DO_2D( 0, 1, 0, 1) 
    843             ! Walls coming from left: should check from 2 to jpi-1 (and jpj=2-jpj) 
    844             IF (ji < jpi) THEN 
    845                IF ( umask(ji,jj,jk) > 0.5_wp .AND. umask(ji-1,jj,jk) < 0.5_wp .AND. umask(ji+1,jj,jk) > 0.5_wp)  THEN   
    846                   zz_drho_i(ji,jj) = aco_bc_hor * ( rhd    (ji+1,jj,jk) - rhd    (ji,jj,jk) ) - bco_bc_hor * zdrho_i(ji+1,jj,jk)  
    847                   zz_dz_i  (ji,jj) = aco_bc_hor * (-gde3w(ji+1,jj,jk) + gde3w(ji,jj,jk) ) - bco_bc_hor * zdz_i  (ji+1,jj,jk) 
    848                END IF 
     839         ! Walls coming from left: should check from 2 to jpi-1 (and jpj=2-jpj) 
     840         DO_2D( 0, 0, 0, 1 ) 
     841            IF ( umask(ji,jj,jk) > 0.5_wp .AND. umask(ji-1,jj,jk) < 0.5_wp .AND. umask(ji+1,jj,jk) > 0.5_wp)  THEN 
     842               zz_drho_i(ji,jj) = aco_bc_hor * ( rhd    (ji+1,jj,jk) - rhd    (ji,jj,jk) ) - bco_bc_hor * zdrho_i(ji+1,jj,jk) 
     843               zz_dz_i  (ji,jj) = aco_bc_hor * (-gde3w(ji+1,jj,jk) + gde3w(ji,jj,jk) ) - bco_bc_hor * zdz_i  (ji+1,jj,jk) 
    849844            END IF 
    850             ! Walls coming from right: should check from 3 to jpi (and jpj=2-jpj) 
    851             IF (ji > 2) THEN 
    852                IF ( umask(ji,jj,jk) < 0.5_wp .AND. umask(ji-1,jj,jk) > 0.5_wp .AND. umask(ji-2,jj,jk) > 0.5_wp) THEN 
    853                   zz_drho_i(ji,jj) = aco_bc_hor * ( rhd    (ji,jj,jk) - rhd    (ji-1,jj,jk) ) - bco_bc_hor * zdrho_i(ji-1,jj,jk)   
    854                   zz_dz_i  (ji,jj) = aco_bc_hor * (-gde3w(ji,jj,jk) + gde3w(ji-1,jj,jk) ) - bco_bc_hor * zdz_i  (ji-1,jj,jk) 
    855                END IF 
     845         END_2D 
     846         ! Walls coming from right: should check from 3 to jpi (and jpj=2-jpj) 
     847         DO_2D( -1, 1, 0, 1 ) 
     848            IF ( umask(ji,jj,jk) < 0.5_wp .AND. umask(ji-1,jj,jk) > 0.5_wp .AND. umask(ji-2,jj,jk) > 0.5_wp) THEN 
     849               zz_drho_i(ji,jj) = aco_bc_hor * ( rhd    (ji,jj,jk) - rhd    (ji-1,jj,jk) ) - bco_bc_hor * zdrho_i(ji-1,jj,jk) 
     850               zz_dz_i  (ji,jj) = aco_bc_hor * (-gde3w(ji,jj,jk) + gde3w(ji-1,jj,jk) ) - bco_bc_hor * zdz_i  (ji-1,jj,jk) 
    856851            END IF 
    857             ! Walls coming from left: should check from 2 to jpj-1 (and jpi=2-jpi) 
    858             IF (jj < jpj) THEN 
    859                IF ( vmask(ji,jj,jk) > 0.5_wp .AND. vmask(ji,jj-1,jk) < 0.5_wp .AND. vmask(ji,jj+1,jk) > 0.5_wp)  THEN 
    860                   zz_drho_j(ji,jj) = aco_bc_hor * ( rhd    (ji,jj+1,jk) - rhd    (ji,jj,jk) ) - bco_bc_hor * zdrho_j(ji,jj+1,jk) 
    861                   zz_dz_j  (ji,jj) = aco_bc_hor * (-gde3w(ji,jj+1,jk) + gde3w(ji,jj,jk) ) - bco_bc_hor * zdz_j  (ji,jj+1,jk) 
    862                END IF 
    863             END IF  
    864             ! Walls coming from right: should check from 3 to jpj (and jpi=2-jpi) 
    865             IF (jj > 2) THEN 
    866                IF ( vmask(ji,jj,jk) < 0.5_wp .AND. vmask(ji,jj-1,jk) > 0.5_wp .AND. vmask(ji,jj-2,jk) > 0.5_wp) THEN  
    867                   zz_drho_j(ji,jj) = aco_bc_hor * ( rhd    (ji,jj,jk) - rhd    (ji,jj-1,jk) ) - bco_bc_hor * zdrho_j(ji,jj-1,jk)  
    868                   zz_dz_j  (ji,jj) = aco_bc_hor * (-gde3w(ji,jj,jk) + gde3w(ji,jj-1,jk) ) - bco_bc_hor * zdz_j  (ji,jj-1,jk) 
    869                END IF 
     852         END_2D 
     853         ! Walls coming from left: should check from 2 to jpj-1 (and jpi=2-jpi) 
     854         DO_2D( 0, 1, 0, 0 ) 
     855            IF ( vmask(ji,jj,jk) > 0.5_wp .AND. vmask(ji,jj-1,jk) < 0.5_wp .AND. vmask(ji,jj+1,jk) > 0.5_wp)  THEN 
     856               zz_drho_j(ji,jj) = aco_bc_hor * ( rhd    (ji,jj+1,jk) - rhd    (ji,jj,jk) ) - bco_bc_hor * zdrho_j(ji,jj+1,jk) 
     857               zz_dz_j  (ji,jj) = aco_bc_hor * (-gde3w(ji,jj+1,jk) + gde3w(ji,jj,jk) ) - bco_bc_hor * zdz_j  (ji,jj+1,jk) 
     858            END IF 
     859         END_2D 
     860         ! Walls coming from right: should check from 3 to jpj (and jpi=2-jpi) 
     861         DO_2D( 0, 1, -1, 1 ) 
     862            IF ( vmask(ji,jj,jk) < 0.5_wp .AND. vmask(ji,jj-1,jk) > 0.5_wp .AND. vmask(ji,jj-2,jk) > 0.5_wp) THEN 
     863               zz_drho_j(ji,jj) = aco_bc_hor * ( rhd    (ji,jj,jk) - rhd    (ji,jj-1,jk) ) - bco_bc_hor * zdrho_j(ji,jj-1,jk) 
     864               zz_dz_j  (ji,jj) = aco_bc_hor * (-gde3w(ji,jj,jk) + gde3w(ji,jj-1,jk) ) - bco_bc_hor * zdz_j  (ji,jj-1,jk) 
    870865            END IF 
    871866         END_2D 
    … …  
    974969      REAL(wp) :: zrhdt1 
    975970      REAL(wp) :: zdpdx1, zdpdx2, zdpdy1, zdpdy2 
    976       REAL(wp), DIMENSION(jpi,jpj)     ::   zpgu, zpgv   ! 2D workspace 
    977       REAL(wp), DIMENSION(jpi,jpj)     ::   zsshu_n, zsshv_n 
    978       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdept, zrhh 
    979       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp 
     971      REAL(wp), DIMENSION(A2D(nn_hls))     ::   zpgu, zpgv   ! 2D workspace 
     972      REAL(wp), DIMENSION(A2D(nn_hls))     ::   zsshu_n, zsshv_n 
     973      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zdept, zrhh 
     974      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp 
    980975      REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   zcpx, zcpy   !W/D pressure filter 
    981976      !!---------------------------------------------------------------------- 
    982977      ! 
    983       IF( kt == nit000 ) THEN 
    984          IF(lwp) WRITE(numout,*) 
    985          IF(lwp) WRITE(numout,*) 'dyn:hpg_prj : hydrostatic pressure gradient trend' 
    986          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   s-coordinate case, cubic spline pressure Jacobian' 
     978      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     979         IF( kt == nit000 ) THEN 
     980            IF(lwp) WRITE(numout,*) 
     981            IF(lwp) WRITE(numout,*) 'dyn:hpg_prj : hydrostatic pressure gradient trend' 
     982            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   s-coordinate case, cubic spline pressure Jacobian' 
     983         ENDIF 
    987984      ENDIF 
    988985 
    … …  
    1001998      ! 
    1002999      IF( ln_wd_il ) THEN 
    1003          ALLOCATE( zcpx(jpi,jpj) , zcpy(jpi,jpj) ) 
     1000         ALLOCATE( zcpx(A2D(nn_hls)) , zcpy(A2D(nn_hls)) ) 
    10041001         DO_2D( 0, 0, 0, 0 ) 
    1005           ll_tmp1 = MIN(  ssh(ji,jj,Kmm)              ,  ssh(ji+1,jj,Kmm) ) >                & 
    1006                &    MAX( -ht_0(ji,jj)              , -ht_0(ji+1,jj) ) .AND.            & 
    1007                &    MAX(  ssh(ji,jj,Kmm) + ht_0(ji,jj),  ssh(ji+1,jj,Kmm) + ht_0(ji+1,jj) )  & 
    1008                &                                                      > rn_wdmin1 + rn_wdmin2 
    1009           ll_tmp2 = ( ABS( ssh(ji,jj,Kmm)             -  ssh(ji+1,jj,Kmm) ) > 1.E-12 ) .AND. (         & 
    1010                &    MAX(   ssh(ji,jj,Kmm)             ,  ssh(ji+1,jj,Kmm) ) >                & 
    1011                &    MAX(  -ht_0(ji,jj)             , -ht_0(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 ) 
    1012  
    1013           IF(ll_tmp1) THEN 
    1014             zcpx(ji,jj) = 1.0_wp 
    1015           ELSE IF(ll_tmp2) THEN 
    1016             ! no worries about  ssh(ji+1,jj,Kmm) -  ssh(ji  ,jj,Kmm) = 0, it won't happen ! here 
    1017             zcpx(ji,jj) = ABS( (ssh(ji+1,jj,Kmm) + ht_0(ji+1,jj) - ssh(ji,jj,Kmm) - ht_0(ji,jj)) & 
    1018                         &    / (ssh(ji+1,jj,Kmm) -  ssh(ji  ,jj,Kmm)) ) 
    1019             
    1020              zcpx(ji,jj) = max(min( zcpx(ji,jj) , 1.0_wp),0.0_wp) 
    1021           ELSE 
    1022             zcpx(ji,jj) = 0._wp 
    1023           END IF 
    1024     
    1025           ll_tmp1 = MIN(  ssh(ji,jj,Kmm)              ,  ssh(ji,jj+1,Kmm) ) >                & 
    1026                &    MAX( -ht_0(ji,jj)              , -ht_0(ji,jj+1) ) .AND.            & 
    1027                &    MAX(  ssh(ji,jj,Kmm) + ht_0(ji,jj),  ssh(ji,jj+1,Kmm) + ht_0(ji,jj+1) )  & 
    1028                &                                                      > rn_wdmin1 + rn_wdmin2 
    1029           ll_tmp2 = ( ABS( ssh(ji,jj,Kmm)             -  ssh(ji,jj+1,Kmm) ) > 1.E-12 ) .AND. (      & 
    1030                &    MAX(   ssh(ji,jj,Kmm)             ,  ssh(ji,jj+1,Kmm) ) >                & 
    1031                &    MAX(  -ht_0(ji,jj)             , -ht_0(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 ) 
    1032  
    1033           IF(ll_tmp1) THEN 
    1034             zcpy(ji,jj) = 1.0_wp 
    1035           ELSE IF(ll_tmp2) THEN 
    1036             ! no worries about  ssh(ji,jj+1,Kmm) -  ssh(ji,jj  ,Kmm) = 0, it won't happen ! here 
    1037             zcpy(ji,jj) = ABS( (ssh(ji,jj+1,Kmm) + ht_0(ji,jj+1) - ssh(ji,jj,Kmm) - ht_0(ji,jj)) & 
    1038                         &    / (ssh(ji,jj+1,Kmm) - ssh(ji,jj  ,Kmm)) ) 
    1039              zcpy(ji,jj) = max(min( zcpy(ji,jj) , 1.0_wp),0.0_wp) 
    1040  
     1002            ll_tmp1 = MIN(   ssh(ji,jj,Kmm)              ,   ssh(ji+1,jj,Kmm)                 ) >       & 
     1003               &      MAX( -ht_0(ji,jj)                  , -ht_0(ji+1,jj)                     ) .AND.   & 
     1004               &      MAX(   ssh(ji,jj,Kmm) + ht_0(ji,jj),   ssh(ji+1,jj,Kmm) + ht_0(ji+1,jj) ) >       & 
     1005               &      rn_wdmin1 + rn_wdmin2 
     1006            ll_tmp2 = ( ABS(   ssh(ji,jj,Kmm) -   ssh(ji+1,jj,Kmm) ) > 1.E-12 ) .AND.                   & 
     1007               &      ( MAX(   ssh(ji,jj,Kmm) ,   ssh(ji+1,jj,Kmm) ) >                                  & 
     1008               &        MAX( -ht_0(ji,jj)     , -ht_0(ji+1,jj)     ) + rn_wdmin1 + rn_wdmin2 ) 
     1009 
     1010            IF(ll_tmp1) THEN 
     1011               zcpx(ji,jj) = 1.0_wp 
     1012            ELSE IF(ll_tmp2) THEN 
     1013               ! no worries about  ssh(ji+1,jj,Kmm) -  ssh(ji  ,jj,Kmm) = 0, it won't happen ! here 
     1014               zcpx(ji,jj) = ABS( (ssh(ji+1,jj,Kmm) + ht_0(ji+1,jj) - ssh(ji,jj,Kmm) - ht_0(ji,jj)) & 
     1015                           &    / (ssh(ji+1,jj,Kmm) -  ssh(ji  ,jj,Kmm)) ) 
     1016               zcpx(ji,jj) = MAX(MIN( zcpx(ji,jj) , 1.0_wp),0.0_wp) 
     1017            ELSE 
     1018               zcpx(ji,jj) = 0._wp 
     1019            END IF 
     1020 
     1021            ll_tmp1 = MIN(   ssh(ji,jj,Kmm)              ,   ssh(ji,jj+1,Kmm)                 ) >       & 
     1022               &      MAX( -ht_0(ji,jj)                  , -ht_0(ji,jj+1)                     ) .AND.   & 
     1023               &      MAX(   ssh(ji,jj,Kmm) + ht_0(ji,jj),   ssh(ji,jj+1,Kmm) + ht_0(ji,jj+1) ) >       & 
     1024               &      rn_wdmin1 + rn_wdmin2 
     1025            ll_tmp2 = ( ABS(   ssh(ji,jj,Kmm) -   ssh(ji,jj+1,Kmm) ) > 1.E-12 ) .AND.                   & 
     1026               &      ( MAX(   ssh(ji,jj,Kmm) ,   ssh(ji,jj+1,Kmm) ) >                                  & 
     1027               &        MAX( -ht_0(ji,jj)     , -ht_0(ji,jj+1)     ) + rn_wdmin1 + rn_wdmin2 ) 
     1028 
     1029            IF(ll_tmp1) THEN 
     1030               zcpy(ji,jj) = 1.0_wp 
     1031            ELSE IF(ll_tmp2) THEN 
     1032               ! no worries about  ssh(ji,jj+1,Kmm) -  ssh(ji,jj  ,Kmm) = 0, it won't happen ! here 
     1033               zcpy(ji,jj) = ABS( (ssh(ji,jj+1,Kmm) + ht_0(ji,jj+1) - ssh(ji,jj,Kmm) - ht_0(ji,jj)) & 
     1034                           &    / (ssh(ji,jj+1,Kmm) -  ssh(ji,jj  ,Kmm)) ) 
     1035               zcpy(ji,jj) = MAX(MIN( zcpy(ji,jj) , 1.0_wp),0.0_wp) 
    10411036            ELSE 
    10421037               zcpy(ji,jj) = 0._wp 
    10431038            ENDIF 
    10441039         END_2D 
    1045          CALL lbc_lnk( 'dynhpg', zcpx, 'U', 1.0_wp, zcpy, 'V', 1.0_wp ) 
    10461040      ENDIF 
    10471041 
    10481042      ! Clean 3-D work arrays 
    10491043      zhpi(:,:,:) = 0._wp 
    1050       zrhh(:,:,:) = rhd(:,:,:) 
     1044      zrhh(:,:,:) = rhd(A2D(nn_hls),:) 
    10511045 
    10521046      ! Preparing vertical density profile "zrhh(:,:,:)" for hybrid-sco coordinate 
    10531047      DO_2D( 1, 1, 1, 1 ) 
    1054        jk = mbkt(ji,jj) 
    1055        IF(     jk <=  1   ) THEN   ;   zrhh(ji,jj,    :   ) = 0._wp 
    1056        ELSEIF( jk ==  2   ) THEN   ;   zrhh(ji,jj,jk+1:jpk) = rhd(ji,jj,jk) 
    1057        ELSEIF( jk < jpkm1 ) THEN 
    1058           DO jkk = jk+1, jpk 
    1059              zrhh(ji,jj,jkk) = interp1(gde3w(ji,jj,jkk  ), gde3w(ji,jj,jkk-1),   & 
    1060                 &                      gde3w(ji,jj,jkk-2), zrhh (ji,jj,jkk-1), zrhh(ji,jj,jkk-2)) 
    1061           END DO 
    1062        ENDIF 
     1048         jk = mbkt(ji,jj) 
     1049         IF(     jk <=  1   ) THEN   ;   zrhh(ji,jj,    :   ) = 0._wp 
     1050         ELSEIF( jk ==  2   ) THEN   ;   zrhh(ji,jj,jk+1:jpk) = rhd(ji,jj,jk) 
     1051         ELSEIF( jk < jpkm1 ) THEN 
     1052            DO jkk = jk+1, jpk 
     1053               zrhh(ji,jj,jkk) = interp1(gde3w(ji,jj,jkk  ), gde3w(ji,jj,jkk-1),   & 
     1054                  &                      gde3w(ji,jj,jkk-2), zrhh (ji,jj,jkk-1), zrhh(ji,jj,jkk-2)) 
     1055            END DO 
     1056         ENDIF 
    10631057      END_2D 
    10641058 
    … …  
    10821076      ! Integrate the hydrostatic pressure "zhpi(:,:,:)" at "T(ji,jj,1)" 
    10831077      DO_2D( 0, 1, 0, 1 ) 
    1084        zrhdt1 = zrhh(ji,jj,1) - interp3( zdept(ji,jj,1), asp(ji,jj,1), bsp(ji,jj,1),  & 
    1085           &                                              csp(ji,jj,1), dsp(ji,jj,1) ) * 0.25_wp * e3w(ji,jj,1,Kmm) 
    1086  
    1087        ! assuming linear profile across the top half surface layer 
    1088        zhpi(ji,jj,1) =  0.5_wp * e3w(ji,jj,1,Kmm) * zrhdt1 
     1078         zrhdt1 = zrhh(ji,jj,1) - interp3( zdept(ji,jj,1), asp(ji,jj,1), bsp(ji,jj,1),  & 
     1079            &                                              csp(ji,jj,1), dsp(ji,jj,1) ) * 0.25_wp * e3w(ji,jj,1,Kmm) 
     1080 
     1081         ! assuming linear profile across the top half surface layer 
     1082         zhpi(ji,jj,1) =  0.5_wp * e3w(ji,jj,1,Kmm) * zrhdt1 
    10891083      END_2D 
    10901084 
    10911085      ! Calculate the pressure "zhpi(:,:,:)" at "T(ji,jj,2:jpkm1)" 
    10921086      DO_3D( 0, 1, 0, 1, 2, jpkm1 ) 
    1093       zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) +                                  & 
    1094          &             integ_spline( zdept(ji,jj,jk-1), zdept(ji,jj,jk),   & 
    1095          &                           asp  (ji,jj,jk-1), bsp  (ji,jj,jk-1), & 
    1096          &                           csp  (ji,jj,jk-1), dsp  (ji,jj,jk-1)  ) 
     1087         zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) +                                  & 
     1088            &             integ_spline( zdept(ji,jj,jk-1), zdept(ji,jj,jk),   & 
     1089            &                           asp  (ji,jj,jk-1), bsp  (ji,jj,jk-1), & 
     1090            &                           csp  (ji,jj,jk-1), dsp  (ji,jj,jk-1)  ) 
    10971091      END_3D 
    10981092 
    … …  
    11071101!                         & r1_e1e2v(ji,jj) * vmask(ji,jj,1) * 0.5_wp  
    11081102!!gm not this: 
    1109        zsshu_n(ji,jj) = (e1e2u(ji,jj) * ssh(ji,jj,Kmm) + e1e2u(ji+1, jj) * ssh(ji+1,jj,Kmm)) * & 
    1110                       & r1_e1e2u(ji,jj) * umask(ji,jj,1) * 0.5_wp  
    1111        zsshv_n(ji,jj) = (e1e2v(ji,jj) * ssh(ji,jj,Kmm) + e1e2v(ji+1, jj) * ssh(ji,jj+1,Kmm)) * & 
    1112                       & r1_e1e2v(ji,jj) * vmask(ji,jj,1) * 0.5_wp  
    1113       END_2D 
    1114  
    1115       CALL lbc_lnk ('dynhpg', zsshu_n, 'U', 1.0_wp, zsshv_n, 'V', 1.0_wp ) 
     1103         zsshu_n(ji,jj) = (e1e2u(ji,jj) * ssh(ji,jj,Kmm) + e1e2u(ji+1, jj) * ssh(ji+1,jj,Kmm)) * & 
     1104                        & r1_e1e2u(ji,jj) * umask(ji,jj,1) * 0.5_wp 
     1105         zsshv_n(ji,jj) = (e1e2v(ji,jj) * ssh(ji,jj,Kmm) + e1e2v(ji+1, jj) * ssh(ji,jj+1,Kmm)) * & 
     1106                        & r1_e1e2v(ji,jj) * vmask(ji,jj,1) * 0.5_wp 
     1107      END_2D 
    11161108 
    11171109      DO_2D( 0, 0, 0, 0 ) 
    1118        zu(ji,jj,1) = - ( e3u(ji,jj,1,Kmm) - zsshu_n(ji,jj) )  
    1119        zv(ji,jj,1) = - ( e3v(ji,jj,1,Kmm) - zsshv_n(ji,jj) ) 
     1110         zu(ji,jj,1) = - ( e3u(ji,jj,1,Kmm) - zsshu_n(ji,jj) ) 
     1111         zv(ji,jj,1) = - ( e3v(ji,jj,1,Kmm) - zsshv_n(ji,jj) ) 
    11201112      END_2D 
    11211113 
    11221114      DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    1123       zu(ji,jj,jk) = zu(ji,jj,jk-1) - e3u(ji,jj,jk,Kmm) 
    1124       zv(ji,jj,jk) = zv(ji,jj,jk-1) - e3v(ji,jj,jk,Kmm) 
     1115         zu(ji,jj,jk) = zu(ji,jj,jk-1) - e3u(ji,jj,jk,Kmm) 
     1116         zv(ji,jj,jk) = zv(ji,jj,jk-1) - e3v(ji,jj,jk,Kmm) 
    11251117      END_3D 
    11261118 
    11271119      DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    1128       zu(ji,jj,jk) = zu(ji,jj,jk) + 0.5_wp * e3u(ji,jj,jk,Kmm) 
    1129       zv(ji,jj,jk) = zv(ji,jj,jk) + 0.5_wp * e3v(ji,jj,jk,Kmm) 
     1120         zu(ji,jj,jk) = zu(ji,jj,jk) + 0.5_wp * e3u(ji,jj,jk,Kmm) 
     1121         zv(ji,jj,jk) = zv(ji,jj,jk) + 0.5_wp * e3v(ji,jj,jk,Kmm) 
    11301122      END_3D 
    11311123 
    11321124      DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    1133       zu(ji,jj,jk) = MIN(  zu(ji,jj,jk) , MAX( -zdept(ji,jj,jk) , -zdept(ji+1,jj,jk) )  ) 
    1134       zu(ji,jj,jk) = MAX(  zu(ji,jj,jk) , MIN( -zdept(ji,jj,jk) , -zdept(ji+1,jj,jk) )  ) 
    1135       zv(ji,jj,jk) = MIN(  zv(ji,jj,jk) , MAX( -zdept(ji,jj,jk) , -zdept(ji,jj+1,jk) )  ) 
    1136       zv(ji,jj,jk) = MAX(  zv(ji,jj,jk) , MIN( -zdept(ji,jj,jk) , -zdept(ji,jj+1,jk) )  ) 
     1125         zu(ji,jj,jk) = MIN(  zu(ji,jj,jk) , MAX( -zdept(ji,jj,jk) , -zdept(ji+1,jj,jk) )  ) 
     1126         zu(ji,jj,jk) = MAX(  zu(ji,jj,jk) , MIN( -zdept(ji,jj,jk) , -zdept(ji+1,jj,jk) )  ) 
     1127         zv(ji,jj,jk) = MIN(  zv(ji,jj,jk) , MAX( -zdept(ji,jj,jk) , -zdept(ji,jj+1,jk) )  ) 
     1128         zv(ji,jj,jk) = MAX(  zv(ji,jj,jk) , MIN( -zdept(ji,jj,jk) , -zdept(ji,jj+1,jk) )  ) 
    11371129      END_3D 
    11381130 
    11391131 
    11401132      DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    1141       zpwes = 0._wp; zpwed = 0._wp 
    1142       zpnss = 0._wp; zpnsd = 0._wp 
    1143       zuijk = zu(ji,jj,jk) 
    1144       zvijk = zv(ji,jj,jk) 
    1145  
    1146       !!!!!     for u equation 
    1147       IF( jk <= mbku(ji,jj) ) THEN 
    1148          IF( -zdept(ji+1,jj,jk) >= -zdept(ji,jj,jk) ) THEN 
    1149            jis = ji + 1; jid = ji 
    1150          ELSE 
    1151            jis = ji;     jid = ji +1 
     1133         zpwes = 0._wp; zpwed = 0._wp 
     1134         zpnss = 0._wp; zpnsd = 0._wp 
     1135         zuijk = zu(ji,jj,jk) 
     1136         zvijk = zv(ji,jj,jk) 
     1137 
     1138         !!!!!     for u equation 
     1139         IF( jk <= mbku(ji,jj) ) THEN 
     1140            IF( -zdept(ji+1,jj,jk) >= -zdept(ji,jj,jk) ) THEN 
     1141              jis = ji + 1; jid = ji 
     1142            ELSE 
     1143              jis = ji;     jid = ji +1 
     1144            ENDIF 
     1145 
     1146            ! integrate the pressure on the shallow side 
     1147            jk1 = jk 
     1148            DO WHILE ( -zdept(jis,jj,jk1) > zuijk ) 
     1149               IF( jk1 == mbku(ji,jj) ) THEN 
     1150                  zuijk = -zdept(jis,jj,jk1) 
     1151                  EXIT 
     1152               ENDIF 
     1153               zdeps = MIN(zdept(jis,jj,jk1+1), -zuijk) 
     1154               zpwes = zpwes +                                      & 
     1155                  integ_spline(zdept(jis,jj,jk1), zdeps,            & 
     1156                                 asp(jis,jj,jk1), bsp(jis,jj,jk1),  & 
     1157                                 csp(jis,jj,jk1), dsp(jis,jj,jk1)) 
     1158               jk1 = jk1 + 1 
     1159            END DO 
     1160 
     1161            ! integrate the pressure on the deep side 
     1162            jk1 = jk 
     1163            DO WHILE ( -zdept(jid,jj,jk1) < zuijk ) 
     1164               IF( jk1 == 1 ) THEN 
     1165                  zdeps = zdept(jid,jj,1) + MIN(zuijk, ssh(jid,jj,Kmm)*znad) 
     1166                  zrhdt1 = zrhh(jid,jj,1) - interp3(zdept(jid,jj,1), asp(jid,jj,1), & 
     1167                                                    bsp(jid,jj,1)  , csp(jid,jj,1), & 
     1168                                                    dsp(jid,jj,1)) * zdeps 
     1169                  zpwed  = zpwed + 0.5_wp * (zrhh(jid,jj,1) + zrhdt1) * zdeps 
     1170                  EXIT 
     1171               ENDIF 
     1172               zdeps = MAX(zdept(jid,jj,jk1-1), -zuijk) 
     1173               zpwed = zpwed +                                        & 
     1174                  integ_spline(zdeps,             zdept(jid,jj,jk1),  & 
     1175                               asp(jid,jj,jk1-1), bsp(jid,jj,jk1-1),  & 
     1176                               csp(jid,jj,jk1-1), dsp(jid,jj,jk1-1) ) 
     1177               jk1 = jk1 - 1 
     1178            END DO 
     1179 
     1180            ! update the momentum trends in u direction 
     1181            zdpdx1 = zcoef0 * r1_e1u(ji,jj) * ( zhpi(ji+1,jj,jk) - zhpi(ji,jj,jk) ) 
     1182            IF( .NOT.ln_linssh ) THEN 
     1183               zdpdx2 = zcoef0 * r1_e1u(ji,jj) * & 
     1184                  &    ( REAL(jis-jid, wp) * (zpwes + zpwed) + (ssh(ji+1,jj,Kmm)-ssh(ji,jj,Kmm)) ) 
     1185            ELSE 
     1186               zdpdx2 = zcoef0 * r1_e1u(ji,jj) * REAL(jis-jid, wp) * (zpwes + zpwed) 
     1187            ENDIF 
     1188            IF( ln_wd_il ) THEN 
     1189               zdpdx1 = zdpdx1 * zcpx(ji,jj) * wdrampu(ji,jj) 
     1190               zdpdx2 = zdpdx2 * zcpx(ji,jj) * wdrampu(ji,jj) 
     1191            ENDIF 
     1192            puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + (zdpdx1 + zdpdx2 - zpgu(ji,jj)) * umask(ji,jj,jk) 
    11521193         ENDIF 
    11531194 
    1154          ! integrate the pressure on the shallow side 
    1155          jk1 = jk 
    1156          DO WHILE ( -zdept(jis,jj,jk1) > zuijk ) 
    1157            IF( jk1 == mbku(ji,jj) ) THEN 
    1158              zuijk = -zdept(jis,jj,jk1) 
    1159              EXIT 
    1160            ENDIF 
    1161            zdeps = MIN(zdept(jis,jj,jk1+1), -zuijk) 
    1162            zpwes = zpwes +                                    & 
    1163                 integ_spline(zdept(jis,jj,jk1), zdeps,            & 
    1164                        asp(jis,jj,jk1),    bsp(jis,jj,jk1), & 
    1165                        csp(jis,jj,jk1),    dsp(jis,jj,jk1)) 
    1166            jk1 = jk1 + 1 
    1167          END DO 
    1168  
    1169          ! integrate the pressure on the deep side 
    1170          jk1 = jk 
    1171          DO WHILE ( -zdept(jid,jj,jk1) < zuijk ) 
    1172            IF( jk1 == 1 ) THEN 
    1173              zdeps = zdept(jid,jj,1) + MIN(zuijk, ssh(jid,jj,Kmm)*znad) 
    1174              zrhdt1 = zrhh(jid,jj,1) - interp3(zdept(jid,jj,1), asp(jid,jj,1), & 
    1175                                                bsp(jid,jj,1),   csp(jid,jj,1), & 
    1176                                                dsp(jid,jj,1)) * zdeps 
    1177              zpwed  = zpwed + 0.5_wp * (zrhh(jid,jj,1) + zrhdt1) * zdeps 
    1178              EXIT 
    1179            ENDIF 
    1180            zdeps = MAX(zdept(jid,jj,jk1-1), -zuijk) 
    1181            zpwed = zpwed +                                        & 
    1182                   integ_spline(zdeps,              zdept(jid,jj,jk1), & 
    1183                          asp(jid,jj,jk1-1), bsp(jid,jj,jk1-1),  & 
    1184                          csp(jid,jj,jk1-1), dsp(jid,jj,jk1-1) ) 
    1185            jk1 = jk1 - 1 
    1186          END DO 
    1187  
    1188          ! update the momentum trends in u direction 
    1189  
    1190          zdpdx1 = zcoef0 * r1_e1u(ji,jj) * ( zhpi(ji+1,jj,jk) - zhpi(ji,jj,jk) ) 
    1191          IF( .NOT.ln_linssh ) THEN 
    1192            zdpdx2 = zcoef0 * r1_e1u(ji,jj) * & 
    1193               &    ( REAL(jis-jid, wp) * (zpwes + zpwed) + (ssh(ji+1,jj,Kmm)-ssh(ji,jj,Kmm)) ) 
    1194           ELSE 
    1195            zdpdx2 = zcoef0 * r1_e1u(ji,jj) * REAL(jis-jid, wp) * (zpwes + zpwed) 
     1195         !!!!!     for v equation 
     1196         IF( jk <= mbkv(ji,jj) ) THEN 
     1197            IF( -zdept(ji,jj+1,jk) >= -zdept(ji,jj,jk) ) THEN 
     1198               jjs = jj + 1; jjd = jj 
     1199            ELSE 
     1200               jjs = jj    ; jjd = jj + 1 
     1201            ENDIF 
     1202 
     1203            ! integrate the pressure on the shallow side 
     1204            jk1 = jk 
     1205            DO WHILE ( -zdept(ji,jjs,jk1) > zvijk ) 
     1206               IF( jk1 == mbkv(ji,jj) ) THEN 
     1207                  zvijk = -zdept(ji,jjs,jk1) 
     1208                  EXIT 
     1209               ENDIF 
     1210               zdeps = MIN(zdept(ji,jjs,jk1+1), -zvijk) 
     1211               zpnss = zpnss +                                       & 
     1212                  integ_spline(zdept(ji,jjs,jk1), zdeps,             & 
     1213                               asp(ji,jjs,jk1),   bsp(ji,jjs,jk1),   & 
     1214                               csp(ji,jjs,jk1),   dsp(ji,jjs,jk1) ) 
     1215              jk1 = jk1 + 1 
     1216            END DO 
     1217 
     1218            ! integrate the pressure on the deep side 
     1219            jk1 = jk 
     1220            DO WHILE ( -zdept(ji,jjd,jk1) < zvijk ) 
     1221               IF( jk1 == 1 ) THEN 
     1222                  zdeps = zdept(ji,jjd,1) + MIN(zvijk, ssh(ji,jjd,Kmm)*znad) 
     1223                  zrhdt1 = zrhh(ji,jjd,1) - interp3(zdept(ji,jjd,1), asp(ji,jjd,1), & 
     1224                                                    bsp(ji,jjd,1)  , csp(ji,jjd,1), & 
     1225                                                    dsp(ji,jjd,1) ) * zdeps 
     1226                  zpnsd  = zpnsd + 0.5_wp * (zrhh(ji,jjd,1) + zrhdt1) * zdeps 
     1227                  EXIT 
     1228               ENDIF 
     1229               zdeps = MAX(zdept(ji,jjd,jk1-1), -zvijk) 
     1230               zpnsd = zpnsd +                                        & 
     1231                  integ_spline(zdeps,             zdept(ji,jjd,jk1),  & 
     1232                               asp(ji,jjd,jk1-1), bsp(ji,jjd,jk1-1),  & 
     1233                               csp(ji,jjd,jk1-1), dsp(ji,jjd,jk1-1) ) 
     1234               jk1 = jk1 - 1 
     1235            END DO 
     1236 
     1237            ! update the momentum trends in v direction 
     1238            zdpdy1 = zcoef0 * r1_e2v(ji,jj) * ( zhpi(ji,jj+1,jk) - zhpi(ji,jj,jk) ) 
     1239            IF( .NOT.ln_linssh ) THEN 
     1240               zdpdy2 = zcoef0 * r1_e2v(ji,jj) * & 
     1241                       ( REAL(jjs-jjd, wp) * (zpnss + zpnsd) + (ssh(ji,jj+1,Kmm)-ssh(ji,jj,Kmm)) ) 
     1242            ELSE 
     1243               zdpdy2 = zcoef0 * r1_e2v(ji,jj) * REAL(jjs-jjd, wp) * (zpnss + zpnsd ) 
     1244            ENDIF 
     1245            IF( ln_wd_il ) THEN 
     1246               zdpdy1 = zdpdy1 * zcpy(ji,jj) * wdrampv(ji,jj) 
     1247               zdpdy2 = zdpdy2 * zcpy(ji,jj) * wdrampv(ji,jj) 
     1248            ENDIF 
     1249 
     1250            pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + (zdpdy1 + zdpdy2 - zpgv(ji,jj)) * vmask(ji,jj,jk) 
    11961251         ENDIF 
    1197          IF( ln_wd_il ) THEN 
    1198             zdpdx1 = zdpdx1 * zcpx(ji,jj) * wdrampu(ji,jj) 
    1199             zdpdx2 = zdpdx2 * zcpx(ji,jj) * wdrampu(ji,jj) 
    1200          ENDIF 
    1201          puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + (zdpdx1 + zdpdx2 - zpgu(ji,jj)) * umask(ji,jj,jk)  
    1202       ENDIF 
    1203  
    1204       !!!!!     for v equation 
    1205       IF( jk <= mbkv(ji,jj) ) THEN 
    1206          IF( -zdept(ji,jj+1,jk) >= -zdept(ji,jj,jk) ) THEN 
    1207            jjs = jj + 1; jjd = jj 
    1208          ELSE 
    1209            jjs = jj    ; jjd = jj + 1 
    1210          ENDIF 
    1211  
    1212          ! integrate the pressure on the shallow side 
    1213          jk1 = jk 
    1214          DO WHILE ( -zdept(ji,jjs,jk1) > zvijk ) 
    1215            IF( jk1 == mbkv(ji,jj) ) THEN 
    1216              zvijk = -zdept(ji,jjs,jk1) 
    1217              EXIT 
    1218            ENDIF 
    1219            zdeps = MIN(zdept(ji,jjs,jk1+1), -zvijk) 
    1220            zpnss = zpnss +                                      & 
    1221                   integ_spline(zdept(ji,jjs,jk1), zdeps,            & 
    1222                          asp(ji,jjs,jk1),    bsp(ji,jjs,jk1), & 
    1223                          csp(ji,jjs,jk1),    dsp(ji,jjs,jk1) ) 
    1224            jk1 = jk1 + 1 
    1225          END DO 
    1226  
    1227          ! integrate the pressure on the deep side 
    1228          jk1 = jk 
    1229          DO WHILE ( -zdept(ji,jjd,jk1) < zvijk ) 
    1230            IF( jk1 == 1 ) THEN 
    1231              zdeps = zdept(ji,jjd,1) + MIN(zvijk, ssh(ji,jjd,Kmm)*znad) 
    1232              zrhdt1 = zrhh(ji,jjd,1) - interp3(zdept(ji,jjd,1), asp(ji,jjd,1), & 
    1233                                                bsp(ji,jjd,1),   csp(ji,jjd,1), & 
    1234                                                dsp(ji,jjd,1) ) * zdeps 
    1235              zpnsd  = zpnsd + 0.5_wp * (zrhh(ji,jjd,1) + zrhdt1) * zdeps 
    1236              EXIT 
    1237            ENDIF 
    1238            zdeps = MAX(zdept(ji,jjd,jk1-1), -zvijk) 
    1239            zpnsd = zpnsd +                                        & 
    1240                   integ_spline(zdeps,              zdept(ji,jjd,jk1), & 
    1241                          asp(ji,jjd,jk1-1), bsp(ji,jjd,jk1-1), & 
    1242                          csp(ji,jjd,jk1-1), dsp(ji,jjd,jk1-1) ) 
    1243            jk1 = jk1 - 1 
    1244          END DO 
    1245  
    1246  
    1247          ! update the momentum trends in v direction 
    1248  
    1249          zdpdy1 = zcoef0 * r1_e2v(ji,jj) * ( zhpi(ji,jj+1,jk) - zhpi(ji,jj,jk) ) 
    1250          IF( .NOT.ln_linssh ) THEN 
    1251             zdpdy2 = zcoef0 * r1_e2v(ji,jj) * & 
    1252                     ( REAL(jjs-jjd, wp) * (zpnss + zpnsd) + (ssh(ji,jj+1,Kmm)-ssh(ji,jj,Kmm)) ) 
    1253          ELSE 
    1254             zdpdy2 = zcoef0 * r1_e2v(ji,jj) * REAL(jjs-jjd, wp) * (zpnss + zpnsd ) 
    1255          ENDIF 
    1256          IF( ln_wd_il ) THEN 
    1257             zdpdy1 = zdpdy1 * zcpy(ji,jj) * wdrampv(ji,jj)  
    1258             zdpdy2 = zdpdy2 * zcpy(ji,jj) * wdrampv(ji,jj)  
    1259          ENDIF 
    1260  
    1261          pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + (zdpdy1 + zdpdy2 - zpgv(ji,jj)) * vmask(ji,jj,jk) 
    1262       ENDIF 
    12631252         ! 
    12641253      END_3D 
    … …  
    12791268      !! Reference: CJC Kruger, Constrained Cubic Spline Interpoltation 
    12801269      !!---------------------------------------------------------------------- 
    1281       REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   fsp, xsp           ! value and coordinate 
    1282       REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   asp, bsp, csp, dsp ! coefficients of the interpoated function 
    1283       INTEGER                   , INTENT(in   ) ::   polynomial_type    ! 1: cubic spline   ;   2: Linear 
     1270      REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(in   ) ::   fsp, xsp           ! value and coordinate 
     1271      REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(  out) ::   asp, bsp, csp, dsp ! coefficients of the interpoated function 
     1272      INTEGER                             , INTENT(in   ) ::   polynomial_type    ! 1: cubic spline   ;   2: Linear 
    12841273      ! 
    12851274      INTEGER  ::   ji, jj, jk                 ! dummy loop indices 
    1286       INTEGER  ::   jpi, jpj, jpkm1 
    12871275      REAL(wp) ::   zdf1, zdf2, zddf1, zddf2, ztmp1, ztmp2, zdxtmp 
    12881276      REAL(wp) ::   zdxtmp1, zdxtmp2, zalpha 
    1289       REAL(wp) ::   zdf(size(fsp,3)) 
    1290       !!---------------------------------------------------------------------- 
    1291       ! 
    1292 !!gm  WHAT !!!!!   THIS IS VERY DANGEROUS !!!!!   
    1293       jpi   = size(fsp,1) 
    1294       jpj   = size(fsp,2) 
    1295       jpkm1 = MAX( 1, size(fsp,3) - 1 ) 
     1277      REAL(wp) ::   zdf(jpk) 
     1278      !!---------------------------------------------------------------------- 
    12961279      ! 
    12971280      IF (polynomial_type == 1) THEN     ! Constrained Cubic Spline 
    1298          DO ji = 1, jpi 
    1299             DO jj = 1, jpj 
    1300            !!Fritsch&Butland's method, 1984 (preferred, but more computation) 
    1301            !    DO jk = 2, jpkm1-1 
    1302            !       zdxtmp1 = xsp(ji,jj,jk)   - xsp(ji,jj,jk-1) 
    1303            !       zdxtmp2 = xsp(ji,jj,jk+1) - xsp(ji,jj,jk) 
    1304            !       zdf1    = ( fsp(ji,jj,jk)   - fsp(ji,jj,jk-1) ) / zdxtmp1 
    1305            !       zdf2    = ( fsp(ji,jj,jk+1) - fsp(ji,jj,jk)   ) / zdxtmp2 
    1306            ! 
    1307            !       zalpha = ( zdxtmp1 + 2._wp * zdxtmp2 ) / ( zdxtmp1 + zdxtmp2 ) / 3._wp 
    1308            ! 
    1309            !       IF(zdf1 * zdf2 <= 0._wp) THEN 
    1310            !           zdf(jk) = 0._wp 
    1311            !       ELSE 
    1312            !         zdf(jk) = zdf1 * zdf2 / ( ( 1._wp - zalpha ) * zdf1 + zalpha * zdf2 ) 
    1313            !       ENDIF 
    1314            !    END DO 
    1315  
    1316            !!Simply geometric average 
    1317                DO jk = 2, jpkm1-1 
    1318                   zdf1 = (fsp(ji,jj,jk  ) - fsp(ji,jj,jk-1)) / (xsp(ji,jj,jk  ) - xsp(ji,jj,jk-1)) 
    1319                   zdf2 = (fsp(ji,jj,jk+1) - fsp(ji,jj,jk  )) / (xsp(ji,jj,jk+1) - xsp(ji,jj,jk  )) 
    1320  
    1321                   IF(zdf1 * zdf2 <= 0._wp) THEN 
    1322                      zdf(jk) = 0._wp 
    1323                   ELSE 
    1324                      zdf(jk) = 2._wp * zdf1 * zdf2 / (zdf1 + zdf2) 
    1325                   ENDIF 
    1326                END DO 
    1327  
    1328                zdf(1)     = 1.5_wp * ( fsp(ji,jj,2) - fsp(ji,jj,1) ) / & 
    1329                           &          ( xsp(ji,jj,2) - xsp(ji,jj,1) )           -  0.5_wp * zdf(2) 
    1330                zdf(jpkm1) = 1.5_wp * ( fsp(ji,jj,jpkm1) - fsp(ji,jj,jpkm1-1) ) / & 
    1331                           &          ( xsp(ji,jj,jpkm1) - xsp(ji,jj,jpkm1-1) ) - 0.5_wp * zdf(jpkm1 - 1) 
    1332  
    1333                DO jk = 1, jpkm1 - 1 
    1334                  zdxtmp = xsp(ji,jj,jk+1) - xsp(ji,jj,jk) 
    1335                  ztmp1  = (zdf(jk+1) + 2._wp * zdf(jk)) / zdxtmp 
    1336                  ztmp2  =  6._wp * (fsp(ji,jj,jk+1) - fsp(ji,jj,jk)) / zdxtmp / zdxtmp 
    1337                  zddf1  = -2._wp * ztmp1 + ztmp2 
    1338                  ztmp1  = (2._wp * zdf(jk+1) + zdf(jk)) / zdxtmp 
    1339                  zddf2  =  2._wp * ztmp1 - ztmp2 
    1340  
    1341                  dsp(ji,jj,jk) = (zddf2 - zddf1) / 6._wp / zdxtmp 
    1342                  csp(ji,jj,jk) = ( xsp(ji,jj,jk+1) * zddf1 - xsp(ji,jj,jk)*zddf2 ) / 2._wp / zdxtmp 
    1343                  bsp(ji,jj,jk) = ( fsp(ji,jj,jk+1) - fsp(ji,jj,jk) ) / zdxtmp - & 
    1344                                & csp(ji,jj,jk) * ( xsp(ji,jj,jk+1) + xsp(ji,jj,jk) ) - & 
    1345                                & dsp(ji,jj,jk) * ((xsp(ji,jj,jk+1) + xsp(ji,jj,jk))**2 - & 
    1346                                &                   xsp(ji,jj,jk+1) * xsp(ji,jj,jk)) 
    1347                  asp(ji,jj,jk) = fsp(ji,jj,jk) - xsp(ji,jj,jk) * (bsp(ji,jj,jk) + & 
    1348                                &                (xsp(ji,jj,jk) * (csp(ji,jj,jk) + & 
    1349                                &                 dsp(ji,jj,jk) * xsp(ji,jj,jk)))) 
    1350                END DO 
     1281         DO_2D( 1, 1, 1, 1 ) 
     1282            !!Fritsch&Butland's method, 1984 (preferred, but more computation) 
     1283            !    DO jk = 2, jpkm1-1 
     1284            !       zdxtmp1 = xsp(ji,jj,jk)   - xsp(ji,jj,jk-1) 
     1285            !       zdxtmp2 = xsp(ji,jj,jk+1) - xsp(ji,jj,jk) 
     1286            !       zdf1    = ( fsp(ji,jj,jk)   - fsp(ji,jj,jk-1) ) / zdxtmp1 
     1287            !       zdf2    = ( fsp(ji,jj,jk+1) - fsp(ji,jj,jk)   ) / zdxtmp2 
     1288            ! 
     1289            !       zalpha = ( zdxtmp1 + 2._wp * zdxtmp2 ) / ( zdxtmp1 + zdxtmp2 ) / 3._wp 
     1290            ! 
     1291            !       IF(zdf1 * zdf2 <= 0._wp) THEN 
     1292            !           zdf(jk) = 0._wp 
     1293            !       ELSE 
     1294            !         zdf(jk) = zdf1 * zdf2 / ( ( 1._wp - zalpha ) * zdf1 + zalpha * zdf2 ) 
     1295            !       ENDIF 
     1296            !    END DO 
     1297 
     1298            !!Simply geometric average 
     1299            DO jk = 2, jpk-2 
     1300               zdf1 = (fsp(ji,jj,jk  ) - fsp(ji,jj,jk-1)) / (xsp(ji,jj,jk  ) - xsp(ji,jj,jk-1)) 
     1301               zdf2 = (fsp(ji,jj,jk+1) - fsp(ji,jj,jk  )) / (xsp(ji,jj,jk+1) - xsp(ji,jj,jk  )) 
     1302 
     1303               IF(zdf1 * zdf2 <= 0._wp) THEN 
     1304                  zdf(jk) = 0._wp 
     1305               ELSE 
     1306                  zdf(jk) = 2._wp * zdf1 * zdf2 / (zdf1 + zdf2) 
     1307               ENDIF 
    13511308            END DO 
    1352          END DO 
     1309 
     1310            zdf(1)     = 1.5_wp * ( fsp(ji,jj,2) - fsp(ji,jj,1) ) / & 
     1311                       &          ( xsp(ji,jj,2) - xsp(ji,jj,1) )           -  0.5_wp * zdf(2) 
     1312            zdf(jpkm1) = 1.5_wp * ( fsp(ji,jj,jpkm1) - fsp(ji,jj,jpkm1-1) ) / & 
     1313                       &          ( xsp(ji,jj,jpkm1) - xsp(ji,jj,jpkm1-1) ) - 0.5_wp * zdf(jpk - 2) 
     1314 
     1315            DO jk = 1, jpk-2 
     1316               zdxtmp = xsp(ji,jj,jk+1) - xsp(ji,jj,jk) 
     1317               ztmp1  = (zdf(jk+1) + 2._wp * zdf(jk)) / zdxtmp 
     1318               ztmp2  =  6._wp * (fsp(ji,jj,jk+1) - fsp(ji,jj,jk)) / zdxtmp / zdxtmp 
     1319               zddf1  = -2._wp * ztmp1 + ztmp2 
     1320               ztmp1  = (2._wp * zdf(jk+1) + zdf(jk)) / zdxtmp 
     1321               zddf2  =  2._wp * ztmp1 - ztmp2 
     1322 
     1323               dsp(ji,jj,jk) = (zddf2 - zddf1) / 6._wp / zdxtmp 
     1324               csp(ji,jj,jk) = ( xsp(ji,jj,jk+1) * zddf1 - xsp(ji,jj,jk)*zddf2 ) / 2._wp / zdxtmp 
     1325               bsp(ji,jj,jk) = ( fsp(ji,jj,jk+1) - fsp(ji,jj,jk) ) / zdxtmp - & 
     1326                             & csp(ji,jj,jk) * ( xsp(ji,jj,jk+1) + xsp(ji,jj,jk) ) - & 
     1327                             & dsp(ji,jj,jk) * ((xsp(ji,jj,jk+1) + xsp(ji,jj,jk))**2 - & 
     1328                             &                   xsp(ji,jj,jk+1) * xsp(ji,jj,jk)) 
     1329               asp(ji,jj,jk) = fsp(ji,jj,jk) - xsp(ji,jj,jk) * (bsp(ji,jj,jk) + & 
     1330                             &                (xsp(ji,jj,jk) * (csp(ji,jj,jk) + & 
     1331                             &                 dsp(ji,jj,jk) * xsp(ji,jj,jk)))) 
     1332            END DO 
     1333         END_2D 
    13531334 
    13541335      ELSEIF ( polynomial_type == 2 ) THEN     ! Linear 
    1355          DO ji = 1, jpi 
    1356             DO jj = 1, jpj 
    1357                DO jk = 1, jpkm1-1 
    1358                   zdxtmp =xsp(ji,jj,jk+1) - xsp(ji,jj,jk) 
    1359                   ztmp1 = fsp(ji,jj,jk+1) - fsp(ji,jj,jk) 
    1360  
    1361                   dsp(ji,jj,jk) = 0._wp 
    1362                   csp(ji,jj,jk) = 0._wp 
    1363                   bsp(ji,jj,jk) = ztmp1 / zdxtmp 
    1364                   asp(ji,jj,jk) = fsp(ji,jj,jk) - bsp(ji,jj,jk) * xsp(ji,jj,jk) 
    1365                END DO 
    1366             END DO 
    1367          END DO 
     1336         DO_3D( 1, 1, 1, 1, 1, jpk-2 ) 
     1337            zdxtmp =xsp(ji,jj,jk+1) - xsp(ji,jj,jk) 
     1338            ztmp1 = fsp(ji,jj,jk+1) - fsp(ji,jj,jk) 
     1339 
     1340            dsp(ji,jj,jk) = 0._wp 
     1341            csp(ji,jj,jk) = 0._wp 
     1342            bsp(ji,jj,jk) = ztmp1 / zdxtmp 
     1343            asp(ji,jj,jk) = fsp(ji,jj,jk) - bsp(ji,jj,jk) * xsp(ji,jj,jk) 
     1344         END_3D 
    13681345         ! 
    13691346      ELSE 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/DYN/dynkeg.F90

    r13497 r14852  
    7878      INTEGER  ::   ji, jj, jk             ! dummy loop indices 
    7979      REAL(wp) ::   zu, zv                   ! local scalars 
    80       REAL(wp), DIMENSION(jpi,jpj,jpk)        ::   zhke 
     80      REAL(wp), DIMENSION(A2D(nn_hls),jpk)    ::   zhke 
    8181      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdu, ztrdv  
    8282      !!---------------------------------------------------------------------- 
    … …  
    8484      IF( ln_timing )   CALL timing_start('dyn_keg') 
    8585      ! 
    86       IF( kt == nit000 ) THEN 
    87          IF(lwp) WRITE(numout,*) 
    88          IF(lwp) WRITE(numout,*) 'dyn_keg : kinetic energy gradient trend, scheme number=', kscheme 
    89          IF(lwp) WRITE(numout,*) '~~~~~~~' 
     86      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     87         IF( kt == nit000 ) THEN 
     88            IF(lwp) WRITE(numout,*) 
     89            IF(lwp) WRITE(numout,*) 'dyn_keg : kinetic energy gradient trend, scheme number=', kscheme 
     90            IF(lwp) WRITE(numout,*) '~~~~~~~' 
     91         ENDIF 
    9092      ENDIF 
    9193 
    … …  
    109111         END_3D 
    110112      CASE ( nkeg_HW )                          !--  Hollingsworth scheme  --! 
    111          DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     113         DO_3D( 0, nn_hls-1, 0, nn_hls-1, 1, jpkm1 ) 
     114            ! round brackets added to fix the order of floating point operations 
     115            ! needed to ensure halo 1 - halo 2 compatibility 
    112116            zu = 8._wp * ( puu(ji-1,jj  ,jk,Kmm) * puu(ji-1,jj  ,jk,Kmm)    & 
    113117               &         + puu(ji  ,jj  ,jk,Kmm) * puu(ji  ,jj  ,jk,Kmm) )  & 
    114                &   +     ( puu(ji-1,jj-1,jk,Kmm) + puu(ji-1,jj+1,jk,Kmm) ) * ( puu(ji-1,jj-1,jk,Kmm) + puu(ji-1,jj+1,jk,Kmm) )   & 
    115                &   +     ( puu(ji  ,jj-1,jk,Kmm) + puu(ji  ,jj+1,jk,Kmm) ) * ( puu(ji  ,jj-1,jk,Kmm) + puu(ji  ,jj+1,jk,Kmm) ) 
     118               &   +     ( ( puu(ji-1,jj-1,jk,Kmm) + puu(ji-1,jj+1,jk,Kmm) ) * ( puu(ji-1,jj-1,jk,Kmm) + puu(ji-1,jj+1,jk,Kmm) )   & 
     119               &   +       ( puu(ji  ,jj-1,jk,Kmm) + puu(ji  ,jj+1,jk,Kmm) ) * ( puu(ji  ,jj-1,jk,Kmm) + puu(ji  ,jj+1,jk,Kmm) )   & 
     120               &         )                                                               ! bracket for halo 1 - halo 2 compatibility 
    116121               ! 
    117122            zv = 8._wp * ( pvv(ji  ,jj-1,jk,Kmm) * pvv(ji  ,jj-1,jk,Kmm)    & 
    118123               &         + pvv(ji  ,jj  ,jk,Kmm) * pvv(ji  ,jj  ,jk,Kmm) )  & 
    119                &  +      ( pvv(ji-1,jj-1,jk,Kmm) + pvv(ji+1,jj-1,jk,Kmm) ) * ( pvv(ji-1,jj-1,jk,Kmm) + pvv(ji+1,jj-1,jk,Kmm) )   & 
    120                &  +      ( pvv(ji-1,jj  ,jk,Kmm) + pvv(ji+1,jj  ,jk,Kmm) ) * ( pvv(ji-1,jj  ,jk,Kmm) + pvv(ji+1,jj  ,jk,Kmm) ) 
     124               &  +      ( ( pvv(ji-1,jj-1,jk,Kmm) + pvv(ji+1,jj-1,jk,Kmm) ) * ( pvv(ji-1,jj-1,jk,Kmm) + pvv(ji+1,jj-1,jk,Kmm) )  & 
     125               &  +        ( pvv(ji-1,jj  ,jk,Kmm) + pvv(ji+1,jj  ,jk,Kmm) ) * ( pvv(ji-1,jj  ,jk,Kmm) + pvv(ji+1,jj  ,jk,Kmm) )  & 
     126               &         )                                                               ! bracket for halo 1 - halo 2 compatibility 
    121127            zhke(ji,jj,jk) = r1_48 * ( zv + zu ) 
    122128         END_3D 
    123          CALL lbc_lnk( 'dynkeg', zhke, 'T', 1.0_wp ) 
     129         IF (nn_hls==1) CALL lbc_lnk( 'dynkeg', zhke, 'T', 1.0_wp ) 
    124130         ! 
    125131      END SELECT  

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/DYN/dynldf_iso.F90

    r14789 r14852  
    2828   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2929   USE prtctl          ! Print control 
     30#if defined key_loop_fusion 
     31   USE dynldf_iso_lf, ONLY: dyn_ldf_iso_lf   ! lateral mixing - loop fusion version (dyn_ldf_iso routine ) 
     32#endif 
    3033 
    3134   IMPLICIT NONE 
    … …  
    3639 
    3740   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   akzu, akzv   !: vertical component of rotated lateral viscosity 
    38     
    39    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zfuw, zdiu, zdju, zdj1u   ! 2D workspace (dyn_ldf_iso)  
    40    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zfvw, zdiv, zdjv, zdj1v   !  -      - 
    4141 
    4242   !! * Substitutions 
    … …  
    5454      !!                  ***  ROUTINE dyn_ldf_iso_alloc  *** 
    5555      !!---------------------------------------------------------------------- 
    56       ALLOCATE( akzu(jpi,jpj,jpk) , zfuw(jpi,jpk) , zdiu(jpi,jpk) , zdju(jpi,jpk) , zdj1u(jpi,jpk) ,     &  
    57          &      akzv(jpi,jpj,jpk) , zfvw(jpi,jpk) , zdiv(jpi,jpk) , zdjv(jpi,jpk) , zdj1v(jpi,jpk) , STAT=dyn_ldf_iso_alloc ) 
    58          ! 
    59       IF( dyn_ldf_iso_alloc /= 0 )   CALL ctl_warn('dyn_ldf_iso_alloc: array allocate failed.') 
     56      dyn_ldf_iso_alloc = 0 
     57      IF( .NOT. ALLOCATED( akzu ) ) THEN 
     58         ALLOCATE( akzu(jpi,jpj,jpk), akzv(jpi,jpj,jpk), STAT=dyn_ldf_iso_alloc ) 
     59            ! 
     60         IF( dyn_ldf_iso_alloc /= 0 )   CALL ctl_warn('dyn_ldf_iso_alloc: array allocate failed.') 
     61      ENDIF 
    6062   END FUNCTION dyn_ldf_iso_alloc 
    6163 
    … …  
    112114      REAL(wp) ::   zabe2, zmskf, zmkf, zvav, zvwslpi, zvwslpj   !   -      - 
    113115      REAL(wp) ::   zcof0, zcof1, zcof2, zcof3, zcof4, zaht_0    !   -      - 
    114       REAL(wp), DIMENSION(jpi,jpj) ::   ziut, zivf, zdku, zdk1u  ! 2D workspace 
    115       REAL(wp), DIMENSION(jpi,jpj) ::   zjuf, zjvt, zdkv, zdk1v  !  -      - 
     116      REAL(wp), DIMENSION(A2D(nn_hls))      ::   ziut, zivf, zdku, zdk1u  ! 2D workspace 
     117      REAL(wp), DIMENSION(A2D(nn_hls))      ::   zjuf, zjvt, zdkv, zdk1v  !  -      - 
     118      REAL(wp), DIMENSION(A1Di(nn_hls),jpk) ::   zfuw, zdiu, zdju, zdj1u  !  -      - 
     119      REAL(wp), DIMENSION(A1Di(nn_hls),jpk) ::   zfvw, zdiv, zdjv, zdj1v  !  -      - 
    116120      !!---------------------------------------------------------------------- 
    117121      ! 
    118       IF( kt == nit000 ) THEN 
    119          IF(lwp) WRITE(numout,*) 
    120          IF(lwp) WRITE(numout,*) 'dyn_ldf_iso : iso-neutral laplacian diffusive operator or ' 
    121          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   s-coordinate horizontal diffusive operator' 
    122          !                                      ! allocate dyn_ldf_bilap arrays 
    123          IF( dyn_ldf_iso_alloc() /= 0 )   CALL ctl_stop('STOP', 'dyn_ldf_iso: failed to allocate arrays') 
     122#if defined key_loop_fusion 
     123      CALL dyn_ldf_iso_lf( kt, Kbb, Kmm, puu, pvv, Krhs    ) 
     124#else 
     125 
     126      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     127         IF( kt == nit000 ) THEN 
     128            IF(lwp) WRITE(numout,*) 
     129            IF(lwp) WRITE(numout,*) 'dyn_ldf_iso : iso-neutral laplacian diffusive operator or ' 
     130            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   s-coordinate horizontal diffusive operator' 
     131            !                                      ! allocate dyn_ldf_iso arrays 
     132            IF( dyn_ldf_iso_alloc() /= 0 )   CALL ctl_stop('STOP', 'dyn_ldf_iso: failed to allocate arrays') 
     133         ENDIF 
    124134      ENDIF 
    125135 
    … …  
    128138      IF( ln_dynldf_hor .AND. ln_traldf_iso ) THEN 
    129139         ! 
    130          DO_3D( 0, 0, 0, 0, 1, jpk )      ! set the slopes of iso-level 
     140         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk )      ! set the slopes of iso-level 
    131141            uslp (ji,jj,jk) = - ( gdept(ji+1,jj,jk,Kbb) - gdept(ji ,jj ,jk,Kbb) ) * r1_e1u(ji,jj) * umask(ji,jj,jk) 
    132142            vslp (ji,jj,jk) = - ( gdept(ji,jj+1,jk,Kbb) - gdept(ji ,jj ,jk,Kbb) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk) 
    … …  
    135145         END_3D 
    136146         ! Lateral boundary conditions on the slopes 
    137          CALL lbc_lnk( 'dynldf_iso', uslp , 'U', -1.0_wp, vslp , 'V', -1.0_wp, wslpi, 'W', -1.0_wp, wslpj, 'W', -1.0_wp ) 
     147         IF (nn_hls == 1) CALL lbc_lnk( 'dynldf_iso', uslp , 'U', -1.0_wp, vslp , 'V', -1.0_wp, wslpi, 'W', -1.0_wp, wslpj, 'W', -1.0_wp ) 
    138148         ! 
    139        ENDIF 
     149      ENDIF 
    140150          
    141151      zaht_0 = 0.5_wp * rn_Ud * rn_Ld                  ! aht_0 from namtra_ldf = zaht_max 
    … …  
    150160         !                             zdkv(jk=1)=zdkv(jk=2) 
    151161 
    152          zdk1u(:,:) = ( puu(:,:,jk,Kbb) -puu(:,:,jk+1,Kbb) ) * umask(:,:,jk+1) 
    153          zdk1v(:,:) = ( pvv(:,:,jk,Kbb) -pvv(:,:,jk+1,Kbb) ) * vmask(:,:,jk+1) 
     162         DO_2D( 1, 1, 1, 1 ) 
     163            zdk1u(ji,jj) = ( puu(ji,jj,jk,Kbb) -puu(ji,jj,jk+1,Kbb) ) * umask(ji,jj,jk+1) 
     164            zdk1v(ji,jj) = ( pvv(ji,jj,jk,Kbb) -pvv(ji,jj,jk+1,Kbb) ) * vmask(ji,jj,jk+1) 
     165         END_2D 
    154166 
    155167         IF( jk == 1 ) THEN 
    … …  
    157169            zdkv(:,:) = zdk1v(:,:) 
    158170         ELSE 
    159             zdku(:,:) = ( puu(:,:,jk-1,Kbb) - puu(:,:,jk,Kbb) ) * umask(:,:,jk) 
    160             zdkv(:,:) = ( pvv(:,:,jk-1,Kbb) - pvv(:,:,jk,Kbb) ) * vmask(:,:,jk) 
     171            DO_2D( 1, 1, 1, 1 ) 
     172               zdku(ji,jj) = ( puu(ji,jj,jk-1,Kbb) - puu(ji,jj,jk,Kbb) ) * umask(ji,jj,jk) 
     173               zdkv(ji,jj) = ( pvv(ji,jj,jk-1,Kbb) - pvv(ji,jj,jk,Kbb) ) * vmask(ji,jj,jk) 
     174            END_2D 
    161175         ENDIF 
    162176 
    … …  
    286300 
    287301      !                                                ! =============== 
    288       DO jj = 2, jpjm1                                 !  Vertical slab 
     302      DO jj = ntsj, ntej                               !  Vertical slab 
    289303         !                                             ! =============== 
    290304 
    … …  
    299313 
    300314         DO jk = 1, jpk 
    301             DO ji = 2, jpi 
     315            DO ji = ntsi, ntei + nn_hls 
    302316               ! i-gradient of u at jj 
    303317               zdiu (ji,jk) = tmask(ji,jj  ,jk) * ( puu(ji,jj  ,jk,Kbb) - puu(ji-1,jj  ,jk,Kbb) ) 
    … …  
    311325         END DO 
    312326         DO jk = 1, jpk 
    313             DO ji = 1, jpim1 
     327            DO ji = ntsi - nn_hls, ntei 
    314328               ! i-gradient of v at jj 
    315329               zdiv (ji,jk) = fmask(ji,jj  ,jk) * ( pvv(ji+1,jj,jk,Kbb) - pvv(ji  ,jj  ,jk,Kbb) ) 
    … …  
    322336 
    323337         ! Surface and bottom vertical fluxes set to zero 
    324          DO ji = 1, jpi 
     338         DO ji = ntsi - nn_hls, ntei + nn_hls 
    325339            zfuw(ji, 1 ) = 0.e0 
    326340            zfvw(ji, 1 ) = 0.e0 
    … …  
    331345         ! interior (2=<jk=<jpk-1) on U field 
    332346         DO jk = 2, jpkm1 
    333             DO ji = 2, jpim1 
     347            DO ji = ntsi, ntei 
    334348               zcof0 = 0.5_wp * zaht_0 * umask(ji,jj,jk) 
    335349               ! 
    … …  
    357371         ! interior (2=<jk=<jpk-1) on V field 
    358372         DO jk = 2, jpkm1 
    359             DO ji = 2, jpim1 
     373            DO ji = ntsi, ntei 
    360374               zcof0 = 0.5_wp * zaht_0 * vmask(ji,jj,jk) 
    361375               ! 
    … …  
    385399         ! ------------------------------------------------------------------- 
    386400         DO jk = 1, jpkm1 
    387             DO ji = 2, jpim1 
     401            DO ji = ntsi, ntei 
    388402               puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + ( zfuw(ji,jk) - zfuw(ji,jk+1) ) * r1_e1e2u(ji,jj)   & 
    389403                  &               / e3u(ji,jj,jk,Kmm) 
    … …  
    395409      END DO                                           !   End of slab 
    396410      !                                                ! =============== 
     411#endif 
    397412   END SUBROUTINE dyn_ldf_iso 
    398413 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/DYN/dynldf_lap_blp.F90

    r14789 r14852  
    1414   USE oce            ! ocean dynamics and tracers 
    1515   USE dom_oce        ! ocean space and time domain 
     16   USE domutl, ONLY : is_tile 
    1617   USE ldfdyn         ! lateral diffusion: eddy viscosity coef. 
    1718   USE ldfslp         ! iso-neutral slopes  
    … …  
    2122   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    2223   USE lib_mpp 
    23     
     24#if defined key_loop_fusion 
     25   USE dynldf_lap_blp_lf 
     26#endif 
     27 
    2428   IMPLICIT NONE 
    2529   PRIVATE 
    … …  
    3943 
    4044   SUBROUTINE dyn_ldf_lap( kt, Kbb, Kmm, pu, pv, pu_rhs, pv_rhs, kpass ) 
     45      !! 
     46      INTEGER                   , INTENT(in   ) ::   kt               ! ocean time-step index 
     47      INTEGER                   , INTENT(in   ) ::   Kbb, Kmm         ! ocean time level indices 
     48      INTEGER                   , INTENT(in   ) ::   kpass            ! =1/2 first or second passage 
     49      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pu, pv           ! before velocity  [m/s] 
     50      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pu_rhs, pv_rhs   ! velocity trend   [m/s2] 
     51      !! 
     52#if defined key_loop_fusion 
     53      CALL dyn_ldf_lap_lf( kt, Kbb, Kmm, pu, pv, pu_rhs, pv_rhs, kpass ) 
     54#else 
     55      CALL dyn_ldf_lap_t( kt, Kbb, Kmm, pu, pv, is_tile(pu), pu_rhs, pv_rhs, is_tile(pu_rhs), kpass ) 
     56#endif 
     57 
     58   END SUBROUTINE dyn_ldf_lap 
     59 
     60 
     61   SUBROUTINE dyn_ldf_lap_t( kt, Kbb, Kmm, pu, pv, ktuv, pu_rhs, pv_rhs, ktuv_rhs, kpass ) 
    4162      !!---------------------------------------------------------------------- 
    4263      !!                     ***  ROUTINE dyn_ldf_lap  *** 
    … …  
    5273      !! Reference : S.Griffies, R.Hallberg 2000 Mon.Wea.Rev., DOI:/  
    5374      !!---------------------------------------------------------------------- 
    54       INTEGER                         , INTENT(in   ) ::   kt         ! ocean time-step index 
    55       INTEGER                         , INTENT(in   ) ::   Kbb, Kmm   ! ocean time level indices 
    56       INTEGER                         , INTENT(in   ) ::   kpass      ! =1/2 first or second passage 
    57       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pu, pv     ! before velocity  [m/s] 
    58       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu_rhs, pv_rhs   ! velocity trend   [m/s2] 
     75      INTEGER                                 , INTENT(in   ) ::   kt               ! ocean time-step index 
     76      INTEGER                                 , INTENT(in   ) ::   Kbb, Kmm         ! ocean time level indices 
     77      INTEGER                                 , INTENT(in   ) ::   kpass            ! =1/2 first or second passage 
     78      INTEGER                                 , INTENT(in   ) ::   ktuv, ktuv_rhs 
     79      REAL(wp), DIMENSION(A2D_T(ktuv)    ,JPK), INTENT(in   ) ::   pu, pv           ! before velocity  [m/s] 
     80      REAL(wp), DIMENSION(A2D_T(ktuv_rhs),JPK), INTENT(inout) ::   pu_rhs, pv_rhs   ! velocity trend   [m/s2] 
    5981      ! 
    6082      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     83      INTEGER  ::   iij 
    6184      REAL(wp) ::   zsign        ! local scalars 
    6285      REAL(wp) ::   zua, zva     ! local scalars 
    … …  
    6588      !!---------------------------------------------------------------------- 
    6689      ! 
    67       IF( kt == nit000 .AND. lwp ) THEN 
    68          WRITE(numout,*) 
    69          WRITE(numout,*) 'dyn_ldf : iso-level harmonic (laplacian) operator, pass=', kpass 
    70          WRITE(numout,*) '~~~~~~~ ' 
     90      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     91         IF( kt == nit000 .AND. lwp ) THEN 
     92            WRITE(numout,*) 
     93            WRITE(numout,*) 'dyn_ldf : iso-level harmonic (laplacian) operator, pass=', kpass 
     94            WRITE(numout,*) '~~~~~~~ ' 
     95         ENDIF 
     96      ENDIF 
     97      ! 
     98      ! Define pu_rhs/pv_rhs halo points for multi-point haloes in bilaplacian case 
     99      IF( nldf_dyn == np_blp .AND. kpass == 1 ) THEN ; iij = nn_hls 
     100      ELSE                                           ; iij = 1 
    71101      ENDIF 
    72102      ! 
    … …  
    79109      CASE ( np_typ_rot )       !==  Vorticity-Divergence operator  ==! 
    80110         ! 
    81          ALLOCATE( zcur(jpi,jpj) , zdiv(jpi,jpj) ) 
     111         ALLOCATE( zcur(A2D(nn_hls)) , zdiv(A2D(nn_hls)) ) 
    82112         ! 
    83113         DO jk = 1, jpkm1                                 ! Horizontal slab 
    84114            ! 
    85             DO_2D( 0, 1, 0, 1 ) 
     115            DO_2D( iij-1, iij, iij-1, iij ) 
    86116               !                                      ! ahm * e3 * curl  (computed from 1 to jpim1/jpjm1) 
    87117               zcur(ji-1,jj-1) = ahmf(ji-1,jj-1,jk) * e3f(ji-1,jj-1,jk) * r1_e1e2f(ji-1,jj-1)       &   ! ahmf already * by fmask 
    … …  
    94124            END_2D 
    95125            ! 
    96             DO_2D( 0, 0, 0, 0 )                       ! - curl( curl) + grad( div ) 
     126            DO_2D( iij-1, iij-1, iij-1, iij-1 )   ! - curl( curl) + grad( div ) 
    97127               pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * umask(ji,jj,jk) * (    &    ! * by umask is mandatory for dyn_ldf_blp use 
    98128                  &              - ( zcur(ji  ,jj) - zcur(ji,jj-1) ) * r1_e2u(ji,jj) / e3u(ji,jj,jk,Kmm)   & 
    … …  
    110140      CASE ( np_typ_sym )       !==  Symmetric operator  ==! 
    111141         ! 
    112          ALLOCATE( zten(jpi,jpj) , zshe(jpi,jpj) ) 
     142         ALLOCATE( zten(A2D(nn_hls)) , zshe(A2D(nn_hls)) ) 
    113143         ! 
    114144         DO jk = 1, jpkm1                                 ! Horizontal slab 
    115145            ! 
    116             DO_2D( 0, 1, 0, 1 ) 
     146            DO_2D( iij-1, iij, iij-1, iij ) 
    117147               !                                      ! shearing stress component (F-point)   NB : ahmf has already been multiplied by fmask 
    118148               zshe(ji-1,jj-1) = ahmf(ji-1,jj-1,jk)                                                              & 
    … …  
    129159            END_2D 
    130160            ! 
    131             DO_2D( 0, 0, 0, 0 ) 
     161            DO_2D( iij-1, iij-1, iij-1, iij-1 ) 
    132162               pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm)                               & 
    133163                  &    * (   (   zten(ji+1,jj  ) * e2t(ji+1,jj  )*e2t(ji+1,jj  ) * e3t(ji+1,jj  ,jk,Kmm)                       & 
    … …  
    150180      END SELECT 
    151181      ! 
    152    END SUBROUTINE dyn_ldf_lap 
     182   END SUBROUTINE dyn_ldf_lap_t 
    153183 
    154184 
    … …  
    171201      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu_rhs, pv_rhs   ! momentum trend 
    172202      ! 
    173       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zulap, zvlap   ! laplacian at u- and v-point 
    174       !!---------------------------------------------------------------------- 
    175       ! 
    176       IF( kt == nit000 )  THEN 
    177          IF(lwp) WRITE(numout,*) 
    178          IF(lwp) WRITE(numout,*) 'dyn_ldf_blp : bilaplacian operator momentum ' 
    179          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 
     203      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zulap, zvlap   ! laplacian at u- and v-point 
     204      !!---------------------------------------------------------------------- 
     205      ! 
     206#if defined key_loop_fusion 
     207      CALL dyn_ldf_blp_lf( kt, Kbb, Kmm, pu, pv, pu_rhs, pv_rhs ) 
     208#else 
     209      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     210         IF( kt == nit000 )  THEN 
     211            IF(lwp) WRITE(numout,*) 
     212            IF(lwp) WRITE(numout,*) 'dyn_ldf_blp : bilaplacian operator momentum ' 
     213            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 
     214         ENDIF 
    180215      ENDIF 
    181216      ! 
    … …  
    185220      CALL dyn_ldf_lap( kt, Kbb, Kmm, pu, pv, zulap, zvlap, 1 )   ! rotated laplacian applied to pt (output in zlap,Kbb) 
    186221      ! 
    187       CALL lbc_lnk( 'dynldf_lap_blp', zulap, 'U', -1.0_wp, zvlap, 'V', -1.0_wp )             ! Lateral boundary conditions 
     222      IF (nn_hls==1) CALL lbc_lnk( 'dynldf_lap_blp', zulap, 'U', -1.0_wp, zvlap, 'V', -1.0_wp )             ! Lateral boundary conditions 
    188223      ! 
    189224      CALL dyn_ldf_lap( kt, Kbb, Kmm, zulap, zvlap, pu_rhs, pv_rhs, 2 )   ! rotated laplacian applied to zlap (output in pt(:,:,:,:,Krhs)) 
    190225      ! 
     226#endif 
    191227   END SUBROUTINE dyn_ldf_blp 
    192228 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/DYN/dynspg_ts.F90

    r14789 r14852  
    730730      IF (ln_bt_fw) THEN 
    731731         IF( .NOT.( kt == nit000 .AND. l_1st_euler ) ) THEN 
    732             DO_2D( 1, 1, 1, 1 ) 
     732            DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    733733               zun_save = un_adv(ji,jj) 
    734734               zvn_save = vn_adv(ji,jj) 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/DYN/dynvor.F90

    r14789 r14852  
    240240      INTEGER  ::   ji, jj, jk           ! dummy loop indices 
    241241      REAL(wp) ::   zx1, zy1, zx2, zy2   ! local scalars 
    242       REAL(wp), DIMENSION(jpi,jpj)     ::   zwx, zwy, zwt   ! 2D workspace 
    243       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zwz      ! 3D workspace, jpkm1 -> avoid lbc_lnk on jpk that is not defined 
    244       !!---------------------------------------------------------------------- 
    245       ! 
    246       IF( kt == nit000 ) THEN 
    247          IF(lwp) WRITE(numout,*) 
    248          IF(lwp) WRITE(numout,*) 'dyn:vor_enT : vorticity term: t-point energy conserving scheme' 
    249          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
     242      REAL(wp), DIMENSION(A2D(nn_hls))        ::   zwx, zwy, zwt   ! 2D workspace 
     243      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zwz             ! 3D workspace, jpkm1 -> avoid lbc_lnk on jpk that is not defined 
     244      !!---------------------------------------------------------------------- 
     245      ! 
     246      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     247         IF( kt == nit000 ) THEN 
     248            IF(lwp) WRITE(numout,*) 
     249            IF(lwp) WRITE(numout,*) 'dyn:vor_enT : vorticity term: t-point energy conserving scheme' 
     250            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
     251         ENDIF 
    250252      ENDIF 
    251253      ! 
    … …  
    254256      ! 
    255257      CASE ( np_RVO , np_CRV )                  !* relative vorticity at f-point is used 
    256          ALLOCATE( zwz(jpi,jpj,jpk) ) 
     258         ALLOCATE( zwz(A2D(nn_hls),jpk) ) 
    257259         DO jk = 1, jpkm1                                ! Horizontal slab 
    258             DO_2D( 1, 0, 1, 0 ) 
     260            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    259261               zwz(ji,jj,jk) = (  e2v(ji+1,jj) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk)  & 
    260262                  &             - e1u(ji,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) * r1_e1e2f(ji,jj) 
    261263            END_2D 
    262264            IF( ln_dynvor_msk ) THEN                     ! mask relative vorticity 
    263                DO_2D( 1, 0, 1, 0 ) 
     265               DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    264266                  zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) 
    265267               END_2D 
    266268            ENDIF 
    267269         END DO 
    268          CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp ) 
     270         IF (nn_hls==1) CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp ) 
    269271         ! 
    270272      END SELECT 
    … …  
    277279         ! 
    278280         CASE ( np_COR )                           !* Coriolis (planetary vorticity) 
    279             zwt(:,:) = ff_t(:,:) * e1e2t(:,:)*e3t(:,:,jk,Kmm) 
     281            DO_2D( 0, 1, 0, 1 ) 
     282               zwt(ji,jj) = ff_t(ji,jj) * e1e2t(ji,jj)*e3t(ji,jj,jk,Kmm) 
     283            END_2D 
    280284         CASE ( np_RVO )                           !* relative vorticity 
    281285            DO_2D( 0, 1, 0, 1 ) 
    … …  
    356360      INTEGER  ::   ji, jj, jk           ! dummy loop indices 
    357361      REAL(wp) ::   zx1, zy1, zx2, zy2, ze3f, zmsk   ! local scalars 
    358       REAL(wp), DIMENSION(jpi,jpj) ::   zwx, zwy, zwz   ! 2D workspace 
    359       !!---------------------------------------------------------------------- 
    360       ! 
    361       IF( kt == nit000 ) THEN 
    362          IF(lwp) WRITE(numout,*) 
    363          IF(lwp) WRITE(numout,*) 'dyn:vor_ene : vorticity term: energy conserving scheme' 
    364          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
     362      REAL(wp), DIMENSION(A2D(nn_hls)) ::   zwx, zwy, zwz   ! 2D workspace 
     363      !!---------------------------------------------------------------------- 
     364      ! 
     365      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     366         IF( kt == nit000 ) THEN 
     367            IF(lwp) WRITE(numout,*) 
     368            IF(lwp) WRITE(numout,*) 'dyn:vor_ene : vorticity term: energy conserving scheme' 
     369            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
     370         ENDIF 
    365371      ENDIF 
    366372      ! 
    … …  
    371377         SELECT CASE( kvor )                 !==  vorticity considered  ==! 
    372378         CASE ( np_COR )                           !* Coriolis (planetary vorticity) 
    373             zwz(:,:) = ff_f(:,:) 
     379            DO_2D( 1, 0, 1, 0 ) 
     380               zwz(ji,jj) = ff_f(ji,jj) 
     381            END_2D 
    374382         CASE ( np_RVO )                           !* relative vorticity 
    375383            DO_2D( 1, 0, 1, 0 ) 
    … …  
    437445#endif 
    438446         !                                   !==  horizontal fluxes  ==! 
    439          zwx(:,:) = e2u(:,:) * e3u(:,:,jk,Kmm) * pu(:,:,jk) 
    440          zwy(:,:) = e1v(:,:) * e3v(:,:,jk,Kmm) * pv(:,:,jk) 
     447         DO_2D( 1, 1, 1, 1 ) 
     448            zwx(ji,jj) = e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * pu(ji,jj,jk) 
     449            zwy(ji,jj) = e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * pv(ji,jj,jk) 
     450         END_2D 
    441451         ! 
    442452         !                                   !==  compute and add the vorticity term trend  =! 
    … …  
    483493      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    484494      REAL(wp) ::   zuav, zvau, ze3f, zmsk   ! local scalars 
    485       REAL(wp), DIMENSION(jpi,jpj) ::   zwx, zwy, zwz, zww   ! 2D workspace 
    486       !!---------------------------------------------------------------------- 
    487       ! 
    488       IF( kt == nit000 ) THEN 
    489          IF(lwp) WRITE(numout,*) 
    490          IF(lwp) WRITE(numout,*) 'dyn:vor_ens : vorticity term: enstrophy conserving scheme' 
    491          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
     495      REAL(wp), DIMENSION(A2D(nn_hls)) ::   zwx, zwy, zwz   ! 2D workspace 
     496      !!---------------------------------------------------------------------- 
     497      ! 
     498      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     499         IF( kt == nit000 ) THEN 
     500            IF(lwp) WRITE(numout,*) 
     501            IF(lwp) WRITE(numout,*) 'dyn:vor_ens : vorticity term: enstrophy conserving scheme' 
     502            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
     503         ENDIF 
    492504      ENDIF 
    493505      !                                                ! =============== 
    … …  
    497509         SELECT CASE( kvor )                 !==  vorticity considered  ==! 
    498510         CASE ( np_COR )                           !* Coriolis (planetary vorticity) 
    499             zwz(:,:) = ff_f(:,:) 
     511            DO_2D( 1, 0, 1, 0 ) 
     512               zwz(ji,jj) = ff_f(ji,jj) 
     513            END_2D 
    500514         CASE ( np_RVO )                           !* relative vorticity 
    501515            DO_2D( 1, 0, 1, 0 ) 
    … …  
    564578#endif 
    565579         !                                   !==  horizontal fluxes  ==! 
    566          zwx(:,:) = e2u(:,:) * e3u(:,:,jk,Kmm) * pu(:,:,jk) 
    567          zwy(:,:) = e1v(:,:) * e3v(:,:,jk,Kmm) * pv(:,:,jk) 
     580         DO_2D( 1, 1, 1, 1 ) 
     581            zwx(ji,jj) = e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * pu(ji,jj,jk) 
     582            zwy(ji,jj) = e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * pv(ji,jj,jk) 
     583         END_2D 
    568584         ! 
    569585         !                                   !==  compute and add the vorticity term trend  =! 
    … …  
    609625      REAL(wp) ::   zua, zva     ! local scalars 
    610626      REAL(wp) ::   zmsk, ze3f   ! local scalars 
    611       REAL(wp), DIMENSION(jpi,jpj)       ::   zwx , zwy , z1_e3f 
    612       REAL(wp), DIMENSION(jpi,jpj)       ::   ztnw, ztne, ztsw, ztse 
    613       REAL(wp), DIMENSION(jpi,jpj,jpkm1) ::   zwz   ! 3D workspace, jpkm1 -> jpkm1 -> avoid lbc_lnk on jpk that is not defined 
    614       !!---------------------------------------------------------------------- 
    615       ! 
    616       IF( kt == nit000 ) THEN 
    617          IF(lwp) WRITE(numout,*) 
    618          IF(lwp) WRITE(numout,*) 'dyn:vor_een : vorticity term: energy and enstrophy conserving scheme' 
    619          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
     627      REAL(wp), DIMENSION(A2D(nn_hls))       ::   z1_e3f 
     628#if defined key_loop_fusion 
     629      REAL(wp) ::   ztne, ztnw, ztnw_ip1, ztse, ztse_jp1, ztsw_jp1, ztsw_ip1 
     630      REAL(wp) ::   zwx, zwx_im1, zwx_jp1, zwx_im1_jp1 
     631      REAL(wp) ::   zwy, zwy_ip1, zwy_jm1, zwy_ip1_jm1 
     632#else 
     633      REAL(wp), DIMENSION(A2D(nn_hls))       ::   zwx , zwy 
     634      REAL(wp), DIMENSION(A2D(nn_hls))       ::   ztnw, ztne, ztsw, ztse 
     635#endif 
     636      REAL(wp), DIMENSION(A2D(nn_hls),jpkm1) ::   zwz   ! 3D workspace, jpkm1 -> jpkm1 -> avoid lbc_lnk on jpk that is not defined 
     637      !!---------------------------------------------------------------------- 
     638      ! 
     639      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     640         IF( kt == nit000 ) THEN 
     641            IF(lwp) WRITE(numout,*) 
     642            IF(lwp) WRITE(numout,*) 'dyn:vor_een : vorticity term: energy and enstrophy conserving scheme' 
     643            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
     644         ENDIF 
    620645      ENDIF 
    621646      ! 
    … …  
    625650         ! 
    626651#if defined key_qco   ||   defined key_linssh 
    627          DO_2D( 1, 0, 1, 0 )                 ! == reciprocal of e3 at F-point (key_qco) 
     652         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )                 ! == reciprocal of e3 at F-point (key_qco) 
    628653            z1_e3f(ji,jj) = 1._wp / e3f_vor(ji,jj,jk) 
    629654         END_2D 
    … …  
    631656         SELECT CASE( nn_e3f_typ )           ! == reciprocal of e3 at F-point 
    632657         CASE ( 0 )                                   ! original formulation  (masked averaging of e3t divided by 4) 
    633             DO_2D( 1, 0, 1, 0 ) 
    634                ze3f = (  e3t(ji  ,jj+1,jk,Kmm)*tmask(ji  ,jj+1,jk)   & 
    635                   &    + e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk)   & 
    636                   &    + e3t(ji  ,jj  ,jk,Kmm)*tmask(ji  ,jj  ,jk)   & 
    637                   &    + e3t(ji+1,jj  ,jk,Kmm)*tmask(ji+1,jj  ,jk)  ) 
     658            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     659               ! round brackets added to fix the order of floating point operations 
     660               ! needed to ensure halo 1 - halo 2 compatibility 
     661               ze3f = (  (e3t(ji  ,jj+1,jk,Kmm)*tmask(ji  ,jj+1,jk)    & 
     662                  &    +  e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk))   & 
     663                  &    + (e3t(ji  ,jj  ,jk,Kmm)*tmask(ji  ,jj  ,jk)    & 
     664                  &    +  e3t(ji+1,jj  ,jk,Kmm)*tmask(ji+1,jj  ,jk))  ) 
    638665               IF( ze3f /= 0._wp ) THEN   ;   z1_e3f(ji,jj) = 4._wp / ze3f 
    639666               ELSE                       ;   z1_e3f(ji,jj) = 0._wp 
    … …  
    641668            END_2D 
    642669         CASE ( 1 )                                   ! new formulation  (masked averaging of e3t divided by the sum of mask) 
    643             DO_2D( 1, 0, 1, 0 ) 
    644                ze3f = (  e3t(ji  ,jj+1,jk,Kmm)*tmask(ji  ,jj+1,jk)   & 
    645                   &    + e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk)   & 
    646                   &    + e3t(ji  ,jj  ,jk,Kmm)*tmask(ji  ,jj  ,jk)   & 
    647                   &    + e3t(ji+1,jj  ,jk,Kmm)*tmask(ji+1,jj  ,jk)  ) 
     670            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     671               ! round brackets added to fix the order of floating point operations 
     672               ! needed to ensure halo 1 - halo 2 compatibility 
     673               ze3f = (  (e3t(ji  ,jj+1,jk,Kmm)*tmask(ji  ,jj+1,jk)    & 
     674                  &    +  e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk))   & 
     675                  &    + (e3t(ji  ,jj  ,jk,Kmm)*tmask(ji  ,jj  ,jk)    & 
     676                  &    +  e3t(ji+1,jj  ,jk,Kmm)*tmask(ji+1,jj  ,jk))  ) 
    648677               zmsk = (                    tmask(ji,jj+1,jk) +                     tmask(ji+1,jj+1,jk)   & 
    649678                  &                      + tmask(ji,jj  ,jk) +                     tmask(ji+1,jj  ,jk)  ) 
    … …  
    658687         ! 
    659688         CASE ( np_COR )                           !* Coriolis (planetary vorticity) 
    660             DO_2D( 1, 0, 1, 0 ) 
     689            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    661690               zwz(ji,jj,jk) = ff_f(ji,jj) * z1_e3f(ji,jj) 
    662691            END_2D 
    663692         CASE ( np_RVO )                           !* relative vorticity 
    664             DO_2D( 1, 0, 1, 0 ) 
     693            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    665694               zwz(ji,jj,jk) = ( e2v(ji+1,jj  ) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk)  & 
    666695                  &            - e1u(ji  ,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) * r1_e1e2f(ji,jj)*z1_e3f(ji,jj) 
    667696            END_2D 
    668697            IF( ln_dynvor_msk ) THEN                     ! mask the relative vorticity 
    669                DO_2D( 1, 0, 1, 0 ) 
     698               DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    670699                  zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) 
    671700               END_2D 
    672701            ENDIF 
    673702         CASE ( np_MET )                           !* metric term 
    674             DO_2D( 1, 0, 1, 0 ) 
     703            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    675704               zwz(ji,jj,jk) = (   ( pv(ji+1,jj,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   & 
    676705                  &              - ( pu(ji,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)   ) * z1_e3f(ji,jj) 
    677706            END_2D 
    678707         CASE ( np_CRV )                           !* Coriolis + relative vorticity 
    679             DO_2D( 1, 0, 1, 0 ) 
    680                zwz(ji,jj,jk) = (  ff_f(ji,jj) + (  e2v(ji+1,jj  ) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk)      & 
    681                   &                              - e1u(ji  ,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  )   & 
    682                   &                           * r1_e1e2f(ji,jj)   ) * z1_e3f(ji,jj) 
     708            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     709            ! round brackets added to fix the order of floating point operations 
     710            ! needed to ensure halo 1 - halo 2 compatibility 
     711               zwz(ji,jj,jk) = (  ff_f(ji,jj) + ( ( e2v(ji+1,jj  ) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk)      & 
     712                  &                               )                                                                  & ! bracket for halo 1 - halo 2 compatibility 
     713                  &                             - ( e1u(ji  ,jj+1) * pu(ji,jj+1,jk) - e1u(ji,jj) * pu(ji,jj,jk)      & 
     714                  &                               )                                                                  & ! bracket for halo 1 - halo 2 compatibility 
     715                  &                             ) * r1_e1e2f(ji,jj)   ) * z1_e3f(ji,jj) 
    683716            END_2D 
    684717            IF( ln_dynvor_msk ) THEN                     ! mask the relative vorticity 
    685                DO_2D( 1, 0, 1, 0 ) 
     718               DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    686719                  zwz(ji,jj,jk) = ( zwz(ji,jj,jk) - ff_f(ji,jj) ) * fmask(ji,jj,jk) + ff_f(ji,jj) 
    687720               END_2D 
    688721            ENDIF 
    689722         CASE ( np_CME )                           !* Coriolis + metric 
    690             DO_2D( 1, 0, 1, 0 ) 
     723            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    691724               zwz(ji,jj,jk) = (   ff_f(ji,jj) + ( pv(ji+1,jj  ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   & 
    692725                  &                            - ( pu(ji  ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)   ) * z1_e3f(ji,jj) 
    … …  
    699732      !                                                ! =============== 
    700733      ! 
    701       CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp ) 
    702       ! 
    703       !                                                ! =============== 
    704       DO jk = 1, jpkm1                                 ! Horizontal slab 
    705          !                                             ! =============== 
    706          ! 
     734      IF (nn_hls==1) CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp ) 
     735      ! 
     736      !                                                ! =============== 
     737      !                                                ! Horizontal slab 
     738      !                                                ! =============== 
     739#if defined key_loop_fusion 
     740      DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    707741         !                                   !==  horizontal fluxes  ==! 
    708          zwx(:,:) = e2u(:,:) * e3u(:,:,jk,Kmm) * pu(:,:,jk) 
    709          zwy(:,:) = e1v(:,:) * e3v(:,:,jk,Kmm) * pv(:,:,jk) 
     742         zwx         = e2u(ji  ,jj  ) * e3u(ji  ,jj  ,jk,Kmm) * pu(ji  ,jj  ,jk) 
     743         zwx_im1     = e2u(ji-1,jj  ) * e3u(ji-1,jj  ,jk,Kmm) * pu(ji-1,jj  ,jk) 
     744         zwx_jp1     = e2u(ji  ,jj+1) * e3u(ji  ,jj+1,jk,Kmm) * pu(ji  ,jj+1,jk) 
     745         zwx_im1_jp1 = e2u(ji-1,jj+1) * e3u(ji-1,jj+1,jk,Kmm) * pu(ji-1,jj+1,jk) 
     746         zwy         = e1v(ji  ,jj  ) * e3v(ji  ,jj  ,jk,Kmm) * pv(ji  ,jj  ,jk) 
     747         zwy_ip1     = e1v(ji+1,jj  ) * e3v(ji+1,jj  ,jk,Kmm) * pv(ji+1,jj  ,jk) 
     748         zwy_jm1     = e1v(ji  ,jj-1) * e3v(ji  ,jj-1,jk,Kmm) * pv(ji  ,jj-1,jk) 
     749         zwy_ip1_jm1 = e1v(ji+1,jj-1) * e3v(ji+1,jj-1,jk,Kmm) * pv(ji+1,jj-1,jk) 
     750         !                                   !==  compute and add the vorticity term trend  =! 
     751         ztne     = zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk) 
     752         ztnw     = zwz(ji-1,jj-1,jk) + zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) 
     753         ztnw_ip1 = zwz(ji  ,jj-1,jk) + zwz(ji  ,jj  ,jk) + zwz(ji+1,jj  ,jk) 
     754         ztse     = zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk) + zwz(ji-1,jj-1,jk) 
     755         ztse_jp1 = zwz(ji  ,jj+1,jk) + zwz(ji  ,jj  ,jk) + zwz(ji-1,jj  ,jk) 
     756         ztsw_jp1 = zwz(ji  ,jj  ,jk) + zwz(ji-1,jj  ,jk) + zwz(ji-1,jj+1,jk) 
     757         ztsw_ip1 = zwz(ji+1,jj-1,jk) + zwz(ji  ,jj-1,jk) + zwz(ji  ,jj  ,jk) 
     758         ! 
     759         zua = + r1_12 * r1_e1u(ji,jj) * (  ztne * zwy + ztnw_ip1 * zwy_ip1   & 
     760            &                             + ztse * zwy_jm1 + ztsw_ip1 * zwy_ip1_jm1 ) 
     761         zva = - r1_12 * r1_e2v(ji,jj) * (  ztsw_jp1 * zwx_im1_jp1 + ztse_jp1 * zwx_jp1   & 
     762            &                             + ztnw * zwx_im1 + ztne * zwx ) 
     763         pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zua 
     764         pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) + zva 
     765      END_3D 
     766#else 
     767      DO jk = 1, jpkm1 
     768         ! 
     769         !                                   !==  horizontal fluxes  ==! 
     770         DO_2D( 1, 1, 1, 1 ) 
     771            zwx(ji,jj) = e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * pu(ji,jj,jk) 
     772            zwy(ji,jj) = e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * pv(ji,jj,jk) 
     773         END_2D 
    710774         ! 
    711775         !                                   !==  compute and add the vorticity term trend  =! 
    … …  
    725789            pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) + zva 
    726790         END_2D 
    727          !                                             ! =============== 
    728       END DO                                           !   End of slab 
     791      END DO 
     792#endif 
     793         !                                             ! =============== 
     794         !                                             !   End of slab 
    729795      !                                                ! =============== 
    730796   END SUBROUTINE vor_een 
    … …  
    758824      REAL(wp) ::   zua, zva       ! local scalars 
    759825      REAL(wp) ::   zmsk, z1_e3t   ! local scalars 
    760       REAL(wp), DIMENSION(jpi,jpj)       ::   zwx , zwy 
    761       REAL(wp), DIMENSION(jpi,jpj)       ::   ztnw, ztne, ztsw, ztse 
    762       REAL(wp), DIMENSION(jpi,jpj,jpkm1) ::   zwz   ! 3D workspace, avoid lbc_lnk on jpk that is not defined 
    763       !!---------------------------------------------------------------------- 
    764       ! 
    765       IF( kt == nit000 ) THEN 
    766          IF(lwp) WRITE(numout,*) 
    767          IF(lwp) WRITE(numout,*) 'dyn:vor_eeT : vorticity term: energy and enstrophy conserving scheme' 
    768          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
     826      REAL(wp), DIMENSION(A2D(nn_hls))       ::   zwx , zwy 
     827      REAL(wp), DIMENSION(A2D(nn_hls))       ::   ztnw, ztne, ztsw, ztse 
     828      REAL(wp), DIMENSION(A2D(nn_hls),jpkm1) ::   zwz   ! 3D workspace, avoid lbc_lnk on jpk that is not defined 
     829      !!---------------------------------------------------------------------- 
     830      ! 
     831      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     832         IF( kt == nit000 ) THEN 
     833            IF(lwp) WRITE(numout,*) 
     834            IF(lwp) WRITE(numout,*) 'dyn:vor_eeT : vorticity term: energy and enstrophy conserving scheme' 
     835            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
     836         ENDIF 
    769837      ENDIF 
    770838      ! 
    … …  
    776844         SELECT CASE( kvor )                 !==  vorticity considered  ==! 
    777845         CASE ( np_COR )                           !* Coriolis (planetary vorticity) 
    778             DO_2D( 1, 0, 1, 0 ) 
     846            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    779847               zwz(ji,jj,jk) = ff_f(ji,jj) 
    780848            END_2D 
    781849         CASE ( np_RVO )                           !* relative vorticity 
    782             DO_2D( 1, 0, 1, 0 ) 
    783                zwz(ji,jj,jk) = (  e2v(ji+1,jj  ) * pv(ji+1,jj  ,jk) - e2v(ji,jj) * pv(ji,jj,jk)    & 
    784                   &             - e1u(ji  ,jj+1) * pu(ji  ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) & 
     850            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     851               ! round brackets added to fix the order of floating point operations 
     852               ! needed to ensure halo 1 - halo 2 compatibility 
     853               zwz(ji,jj,jk) = (  (e2v(ji+1,jj  ) * pv(ji+1,jj  ,jk) - e2v(ji,jj) * pv(ji,jj,jk))    & 
     854                  &             - (e1u(ji  ,jj+1) * pu(ji  ,jj+1,jk) - e1u(ji,jj) * pu(ji,jj,jk))  ) & 
    785855                  &          * r1_e1e2f(ji,jj) 
    786856            END_2D 
    787857            IF( ln_dynvor_msk ) THEN                     ! mask the relative vorticity 
    788                DO_2D( 1, 0, 1, 0 ) 
     858               DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    789859                  zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) 
    790860               END_2D 
    791861            ENDIF 
    792862         CASE ( np_MET )                           !* metric term 
    793             DO_2D( 1, 0, 1, 0 ) 
     863            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    794864               zwz(ji,jj,jk) = ( pv(ji+1,jj  ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   & 
    795865                  &          - ( pu(ji  ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj) 
    796866            END_2D 
    797867         CASE ( np_CRV )                           !* Coriolis + relative vorticity 
    798             DO_2D( 1, 0, 1, 0 ) 
    799                zwz(ji,jj,jk) = (  ff_f(ji,jj) + (  e2v(ji+1,jj  ) * pv(ji+1,jj  ,jk) - e2v(ji,jj) * pv(ji,jj,jk)    & 
    800                   &                              - e1u(ji  ,jj+1) * pu(ji  ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) & 
    801                   &                         * r1_e1e2f(ji,jj)    ) 
     868            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     869               ! round brackets added to fix the order of floating point operations 
     870               ! needed to ensure halo 1 - halo 2 compatibility 
     871               zwz(ji,jj,jk) = (  ff_f(ji,jj) + (  (e2v(ji+1,jj  ) * pv(ji+1,jj  ,jk) - e2v(ji,jj) * pv(ji,jj,jk))    & 
     872                  &                              - (e1u(ji  ,jj+1) * pu(ji  ,jj+1,jk) - e1u(ji,jj) * pu(ji,jj,jk))  ) & 
     873                  &                           * r1_e1e2f(ji,jj)    ) 
    802874            END_2D 
    803875            IF( ln_dynvor_msk ) THEN                     ! mask the relative vorticity 
    804                DO_2D( 1, 0, 1, 0 ) 
     876               DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    805877                  zwz(ji,jj,jk) = ( zwz(ji,jj,jk) - ff_f(ji,jj) ) * fmask(ji,jj,jk) + ff_f(ji,jj) 
    806878               END_2D 
    807879            ENDIF 
    808880         CASE ( np_CME )                           !* Coriolis + metric 
    809             DO_2D( 1, 0, 1, 0 ) 
     881            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    810882               zwz(ji,jj,jk) = ff_f(ji,jj) + ( pv(ji+1,jj  ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   & 
    811883                  &                        - ( pu(ji  ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj) 
    … …  
    819891      !                                                ! =============== 
    820892      ! 
    821       CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp ) 
     893      IF (nn_hls==1) CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp ) 
    822894      ! 
    823895      !                                                ! =============== 
    … …  
    826898         ! 
    827899         !                                   !==  horizontal fluxes  ==! 
    828          zwx(:,:) = e2u(:,:) * e3u(:,:,jk,Kmm) * pu(:,:,jk) 
    829          zwy(:,:) = e1v(:,:) * e3v(:,:,jk,Kmm) * pv(:,:,jk) 
     900         DO_2D( 1, 1, 1, 1 ) 
     901            zwx(ji,jj) = e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * pu(ji,jj,jk) 
     902            zwy(ji,jj) = e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * pv(ji,jj,jk) 
     903         END_2D 
    830904         ! 
    831905         !                                   !==  compute and add the vorticity term trend  =! 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/DYN/dynzad.F90

    r14789 r14852  
    6060      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    6161      REAL(wp) ::   zua, zva     ! local scalars 
    62       REAL(wp), DIMENSION(jpi,jpj)     ::   zww 
    63       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwuw, zwvw 
     62      REAL(wp), DIMENSION(A2D(nn_hls))     ::   zww 
     63      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zwuw, zwvw 
    6464      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdu, ztrdv 
    6565      !!---------------------------------------------------------------------- 
    … …  
    6767      IF( ln_timing )   CALL timing_start('dyn_zad') 
    6868      ! 
    69       IF( kt == nit000 ) THEN 
    70          IF(lwp) WRITE(numout,*) 
    71          IF(lwp) WRITE(numout,*) 'dyn_zad : 2nd order vertical advection scheme' 
     69      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     70         IF( kt == nit000 ) THEN 
     71            IF(lwp) WRITE(numout,*) 
     72            IF(lwp) WRITE(numout,*) 'dyn_zad : 2nd order vertical advection scheme' 
     73         ENDIF 
    7274      ENDIF 
    7375 
    … …  
    7981 
    8082      DO jk = 2, jpkm1                ! Vertical momentum advection at level w and u- and v- vertical 
    81          DO_2D( 0, 1, 0, 1 )              ! vertical fluxes 
    82           IF( ln_vortex_force ) THEN 
    83             zww(ji,jj) = 0.25_wp * e1e2t(ji,jj) * ( ww(ji,jj,jk) + wsd(ji,jj,jk) ) 
    84           ELSE 
    85             zww(ji,jj) = 0.25_wp * e1e2t(ji,jj) * ww(ji,jj,jk) 
    86           ENDIF 
    87          END_2D 
     83         IF( ln_vortex_force ) THEN       ! vertical fluxes 
     84            DO_2D( 0, 1, 0, 1 ) 
     85               zww(ji,jj) = 0.25_wp * e1e2t(ji,jj) * ( ww(ji,jj,jk) + wsd(ji,jj,jk) ) 
     86            END_2D 
     87         ELSE 
     88            DO_2D( 0, 1, 0, 1 ) 
     89               zww(ji,jj) = 0.25_wp * e1e2t(ji,jj) * ww(ji,jj,jk) 
     90            END_2D 
     91         ENDIF 
    8892         DO_2D( 0, 0, 0, 0 )              ! vertical momentum advection at w-point 
    8993            zwuw(ji,jj,jk) = ( zww(ji+1,jj  ) + zww(ji,jj) ) * ( puu(ji,jj,jk-1,Kmm) - puu(ji,jj,jk,Kmm) ) 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/DYN/dynzdf.F90

    r13497 r14852  
    1919   USE zdfdrg         ! vertical physics: top/bottom drag coef. 
    2020   USE dynadv    ,ONLY: ln_dynadv_vec    ! dynamics: advection form 
     21#if defined key_loop_fusion 
     22   USE dynldf_iso_lf,ONLY: akzu, akzv       ! dynamics: vertical component of rotated lateral mixing  
     23#else 
    2124   USE dynldf_iso,ONLY: akzu, akzv       ! dynamics: vertical component of rotated lateral mixing  
     25#endif 
    2226   USE ldfdyn         ! lateral diffusion: eddy viscosity coef. and type of operator 
    2327   USE trd_oce        ! trends: ocean variables 
    … …  
    7882      REAL(wp) ::   zWui, zWvi         !   -      - 
    7983      REAL(wp) ::   zWus, zWvs         !   -      - 
    80       REAL(wp), DIMENSION(jpi,jpj,jpk)        ::  zwi, zwd, zws   ! 3D workspace  
     84      REAL(wp), DIMENSION(A2D(nn_hls),jpk)        ::  zwi, zwd, zws   ! 3D workspace 
    8185      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdu, ztrdv   !  -      - 
    8286      !!--------------------------------------------------------------------- 
    … …  
    8488      IF( ln_timing )   CALL timing_start('dyn_zdf') 
    8589      ! 
    86       IF( kt == nit000 ) THEN       !* initialization 
    87          IF(lwp) WRITE(numout,*) 
    88          IF(lwp) WRITE(numout,*) 'dyn_zdf_imp : vertical momentum diffusion implicit operator' 
    89          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ ' 
    90          ! 
    91          If( ln_linssh ) THEN   ;    r_vvl = 0._wp    ! non-linear free surface indicator 
    92          ELSE                   ;    r_vvl = 1._wp 
     90      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     91         IF( kt == nit000 ) THEN       !* initialization 
     92            IF(lwp) WRITE(numout,*) 
     93            IF(lwp) WRITE(numout,*) 'dyn_zdf_imp : vertical momentum diffusion implicit operator' 
     94            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ ' 
     95            ! 
     96            If( ln_linssh ) THEN   ;    r_vvl = 0._wp    ! non-linear free surface indicator 
     97            ELSE                   ;    r_vvl = 1._wp 
     98            ENDIF 
    9399         ENDIF 
    94100      ENDIF 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/DYN/sshwzv.F90

    r14789 r14852  
    7878      REAL(wp), DIMENSION(jpi,jpj,jpt), INTENT(inout) ::   pssh           ! sea-surface height 
    7979      !  
    80       INTEGER  ::   jk      ! dummy loop index 
     80      INTEGER  ::   ji, jj, jk      ! dummy loop index 
    8181      REAL(wp) ::   zcoef   ! local scalar 
    8282      REAL(wp), DIMENSION(jpi,jpj) ::   zhdiv   ! 2D workspace 
    … …  
    103103      ! 
    104104      zhdiv(:,:) = 0._wp 
    105       DO jk = 1, jpkm1                                 ! Horizontal divergence of barotropic transports 
    106         zhdiv(:,:) = zhdiv(:,:) + e3t(:,:,jk,Kmm) * hdiv(:,:,jk) 
    107       END DO 
     105      DO_3D( 1, nn_hls, 1, nn_hls, 1, jpkm1 )                                 ! Horizontal divergence of barotropic transports 
     106        zhdiv(ji,jj) = zhdiv(ji,jj) + e3t(ji,jj,jk,Kmm) * hdiv(ji,jj,jk) 
     107      END_3D 
    108108      !                                                ! Sea surface elevation time stepping 
    109109      ! In time-split case we need a first guess of the ssh after (using the baroclinic timestep) in order to 
    110110      ! compute the vertical velocity which can be used to compute the non-linear terms of the momentum equations. 
    111111      !  
    112       pssh(:,:,Kaa) = (  pssh(:,:,Kbb) - rDt * ( zcoef * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) )  ) * ssmask(:,:) 
     112      DO_2D_OVR( 1, nn_hls, 1, nn_hls )                ! Loop bounds limited by hdiv definition in div_hor 
     113         pssh(ji,jj,Kaa) = (  pssh(ji,jj,Kbb) - rDt * ( zcoef * ( emp_b(ji,jj) + emp(ji,jj) ) + zhdiv(ji,jj) )  ) * ssmask(ji,jj) 
     114      END_2D 
     115      ! pssh must be defined everywhere (true for dyn_spg_ts, not for dyn_spg_exp) 
     116      IF ( .NOT. ln_dynspg_ts .AND. nn_hls == 2 ) CALL lbc_lnk( 'sshwzv', pssh(:,:,Kaa), 'T', 1.0_wp ) 
    113117      ! 
    114118#if defined key_agrif 
    … …  
    119123      IF ( .NOT.ln_dynspg_ts ) THEN 
    120124         IF( ln_bdy ) THEN 
    121             CALL lbc_lnk( 'sshwzv', pssh(:,:,Kaa), 'T', 1.0_wp )    ! Not sure that's necessary 
     125            IF (nn_hls==1) CALL lbc_lnk( 'sshwzv', pssh(:,:,Kaa), 'T', 1.0_wp )    ! Not sure that's necessary 
    122126            CALL bdy_ssh( pssh(:,:,Kaa) )             ! Duplicate sea level across open boundaries 
    123127         ENDIF 
    … …  
    178182            ! horizontal divergence of thickness diffusion transport ( velocity multiplied by e3t) 
    179183            ! - ML - note: computation already done in dom_vvl_sf_nxt. Could be optimized (not critical and clearer this way) 
    180             DO_2D( 0, 0, 0, 0 ) 
     184            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    181185               zhdiv(ji,jj,jk) = r1_e1e2t(ji,jj) * ( un_td(ji,jj,jk) - un_td(ji-1,jj,jk) + vn_td(ji,jj,jk) - vn_td(ji,jj-1,jk) ) 
    182186            END_2D 
    183187         END DO 
    184          CALL lbc_lnk('sshwzv', zhdiv, 'T', 1.0_wp)  ! - ML - Perhaps not necessary: not used for horizontal "connexions" 
     188         IF (nn_hls==1) CALL lbc_lnk('sshwzv', zhdiv, 'T', 1.0_wp)  ! - ML - Perhaps not necessary: not used for horizontal "connexions" 
    185189         !                             ! Is it problematic to have a wrong vertical velocity in boundary cells? 
    186190         !                             ! Same question holds for hdiv. Perhaps just for security 
    187          DO jk = jpkm1, 1, -1                       ! integrate from the bottom the hor. divergence 
     191         DO_3DS( 1, 1, 1, 1, jpkm1, 1, -1 )         ! integrate from the bottom the hor. divergence 
    188192            ! computation of w 
    189             pww(:,:,jk) = pww(:,:,jk+1) - (   e3t(:,:,jk,Kmm) * hdiv(:,:,jk)   & 
    190                &                            +                  zhdiv(:,:,jk)   & 
    191                &                            + r1_Dt * (  e3t(:,:,jk,Kaa)       & 
    192                &                                       - e3t(:,:,jk,Kbb) )   ) * tmask(:,:,jk) 
    193          END DO 
     193            pww(ji,jj,jk) = pww(ji,jj,jk+1) - (   e3t(ji,jj,jk,Kmm) * hdiv(ji,jj,jk)   & 
     194               &                                  +                  zhdiv(ji,jj,jk)   & 
     195               &                                  + r1_Dt * (  e3t(ji,jj,jk,Kaa)       & 
     196               &                                             - e3t(ji,jj,jk,Kbb) )   ) * tmask(ji,jj,jk) 
     197         END_3D 
    194198         !          IF( ln_vvl_layer ) pww(:,:,:) = 0.e0 
    195199         DEALLOCATE( zhdiv )  
    … …  
    197201      ELSEIF( ln_linssh )   THEN                      !==  linear free surface cases  ==! 
    198202         !                                            !=================================! 
    199          DO jk = jpkm1, 1, -1                               ! integrate from the bottom the hor. divergence 
    200             pww(:,:,jk) = pww(:,:,jk+1) - (  e3t(:,:,jk,Kmm) * hdiv(:,:,jk)  ) * tmask(:,:,jk) 
    201          END DO 
     203         DO_3DS( 1, 1, 1, 1, jpkm1, 1, -1 )                 ! integrate from the bottom the hor. divergence 
     204            pww(ji,jj,jk) = pww(ji,jj,jk+1) - (  e3t(ji,jj,jk,Kmm) * hdiv(ji,jj,jk)  ) * tmask(ji,jj,jk) 
     205         END_3D 
    202206         !                                            !==========================================! 
    203207      ELSE                                            !==  Quasi-Eulerian vertical coordinate  ==!   ('key_qco') 
    204208         !                                            !==========================================! 
    205          DO jk = jpkm1, 1, -1                               ! integrate from the bottom the hor. divergence 
    206             pww(:,:,jk) = pww(:,:,jk+1) - (  e3t(:,:,jk,Kmm) * hdiv(:,:,jk)                 & 
    207                &                            + r1_Dt * (  e3t(:,:,jk,Kaa)        & 
    208                &                                       - e3t(:,:,jk,Kbb)  )   ) * tmask(:,:,jk) 
    209          END DO 
     209         DO_3DS( 1, 1, 1, 1, jpkm1, 1, -1 )                 ! integrate from the bottom the hor. divergence 
     210            pww(ji,jj,jk) = pww(ji,jj,jk+1) - (  e3t(ji,jj,jk,Kmm) * hdiv(ji,jj,jk)    & 
     211               &                                 + r1_Dt * (  e3t(ji,jj,jk,Kaa)        & 
     212               &                                            - e3t(ji,jj,jk,Kbb)  )   ) * tmask(ji,jj,jk) 
     213         END_3D 
    210214      ENDIF 
    211215 
    … …  
    357361      zdt = 2._wp * rn_Dt                            ! 2*rn_Dt and not rDt (for restartability) 
    358362      IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN 
    359          DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     363         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
    360364            z1_e3t = 1._wp / e3t(ji,jj,jk,Kmm) 
    361365            Cu_adv(ji,jj,jk) =   zdt *                                                         & 
    … …  
    374378         END_3D 
    375379      ELSE 
    376          DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     380         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
    377381            z1_e3t = 1._wp / e3t(ji,jj,jk,Kmm) 
    378382            Cu_adv(ji,jj,jk) =   zdt *                                                      & 
    … …  
    387391         END_3D 
    388392      ENDIF 
    389       CALL lbc_lnk( 'sshwzv', Cu_adv, 'T', 1.0_wp ) 
     393      IF (nn_hls==1) CALL lbc_lnk( 'sshwzv', Cu_adv, 'T', 1.0_wp ) 
    390394      ! 
    391395      CALL iom_put("Courant",Cu_adv) 
    392396      ! 
    393397      IF( MAXVAL( Cu_adv(:,:,:) ) > Cu_min ) THEN       ! Quick check if any breaches anywhere 
    394          DO_3DS( 1, 1, 1, 1, jpkm1, 2, -1 )             ! or scan Courant criterion and partition ! w where necessary 
     398         DO_3DS( nn_hls, nn_hls, nn_hls, nn_hls, jpkm1, 2, -1 )             ! or scan Courant criterion and partition ! w where necessary 
    395399            ! 
    396400            zCu = MAX( Cu_adv(ji,jj,jk) , Cu_adv(ji,jj,jk-1) ) 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/DYN/wet_dry.F90

    r14789 r14852  
    117117         IF( ierr /= 0 ) CALL ctl_stop('STOP', 'wad_init : Array allocation error') 
    118118      ENDIF 
     119 
     120      IF( ln_tile .AND. ln_wd_il ) CALL ctl_warn('Tiling has not been tested with ln_wd_il = T') 
    119121      ! 
    120122   END SUBROUTINE wad_init 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/ICB/icbdia.F90

    r14789 r14852  
    491491   SUBROUTINE icb_dia_melt(ki, kj, pmnew, pheat_hcflux, pheat_latent, pmass_scale,     & 
    492492      &                    pdM, pdMbitsE, pdMbitsM, pdMb, pdMe,   & 
    493       &                    pdMv, pz1_dt_e1e2 ) 
     493      &                    pdMv, pz1_dt_e1e2, pz1_e1e2 ) 
    494494      !!---------------------------------------------------------------------- 
    495495      !!---------------------------------------------------------------------- 
    496496      INTEGER , INTENT(in) ::   ki, kj 
    497497      REAL(wp), INTENT(in) ::   pmnew, pheat_hcflux, pheat_latent, pmass_scale 
    498       REAL(wp), INTENT(in) ::   pdM, pdMbitsE, pdMbitsM, pdMb, pdMe, pdMv, pz1_dt_e1e2 
     498      REAL(wp), INTENT(in) ::   pdM, pdMbitsE, pdMbitsM, pdMb, pdMe, pdMv, pz1_dt_e1e2, pz1_e1e2 
    499499      !!---------------------------------------------------------------------- 
    500500      ! 
    … …  
    502502      ! 
    503503      berg_melt (ki,kj) = berg_melt (ki,kj) + pdM      * pz1_dt_e1e2   ! kg/m2/s 
    504       berg_melt_hcflx (ki,kj) = berg_melt_hcflx (ki,kj) + pheat_hcflux * pz1_dt_e1e2   ! J/m2/s 
    505       berg_melt_qlat (ki,kj) = berg_melt_qlat (ki,kj) + pheat_latent * pz1_dt_e1e2   ! J/m2/s 
     504      berg_melt_hcflx (ki,kj) = berg_melt_hcflx (ki,kj) + pheat_hcflux * pz1_e1e2   ! W/m2 
     505      berg_melt_qlat (ki,kj) = berg_melt_qlat (ki,kj) + pheat_latent * pz1_e1e2   ! W/m2 
    506506      bits_src  (ki,kj) = bits_src  (ki,kj) + pdMbitsE * pz1_dt_e1e2   ! mass flux into bergy bitskg/m2/s 
    507507      bits_melt (ki,kj) = bits_melt (ki,kj) + pdMbitsM * pz1_dt_e1e2   ! melt rate of bergy bits kg/m2/s 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/ICB/icbthm.F90

    r14789 r14852  
    241241            CALL icb_dia_melt( ii, ij, zMnew, zheat_hcflux, zheat_latent, this%mass_scaling,       & 
    242242               &                       zdM, zdMbitsE, zdMbitsM, zdMb, zdMe,   & 
    243                &                       zdMv, z1_dt_e1e2 ) 
     243               &                       zdMv, z1_dt_e1e2, z1_e1e2 ) 
    244244         ELSE 
    245245            WRITE(numout,*) 'icb_thm: berg ',this%number(:),' appears to have grounded  at ',narea,ii,ij 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/IOM/iom.F90

    r14789 r14852  
    20262026      IF( iom_use(cdname) ) THEN 
    20272027#if defined key_xios 
    2028          CALL xios_send_field( cdname, pfield2d ) 
     2028         IF( is_tile(pfield2d) == 1 ) THEN 
     2029            CALL xios_send_field( cdname, pfield2d, ntile - 1 ) 
     2030         ELSE IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN 
     2031            CALL xios_send_field( cdname, pfield2d ) 
     2032         ENDIF 
    20292033#else 
    20302034         WRITE(numout,*) pfield2d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 
    … …  
    20382042      IF( iom_use(cdname) ) THEN 
    20392043#if defined key_xios 
    2040          CALL xios_send_field( cdname, pfield2d ) 
     2044         IF( is_tile(pfield2d) == 1 ) THEN 
     2045            CALL xios_send_field( cdname, pfield2d, ntile - 1 ) 
     2046         ELSE IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN 
     2047            CALL xios_send_field( cdname, pfield2d ) 
     2048         ENDIF 
    20412049#else 
    20422050         WRITE(numout,*) pfield2d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 
    … …  
    20502058      IF( iom_use(cdname) ) THEN 
    20512059#if defined key_xios 
    2052          CALL xios_send_field( cdname, pfield3d ) 
     2060         IF( is_tile(pfield3d) == 1 ) THEN 
     2061            CALL xios_send_field( cdname, pfield3d, ntile - 1 ) 
     2062         ELSE IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN 
     2063            CALL xios_send_field( cdname, pfield3d ) 
     2064         ENDIF 
    20532065#else 
    20542066         WRITE(numout,*) pfield3d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 
    … …  
    20622074      IF( iom_use(cdname) ) THEN 
    20632075#if defined key_xios 
    2064          CALL xios_send_field( cdname, pfield3d ) 
     2076         IF( is_tile(pfield3d) == 1 ) THEN 
     2077            CALL xios_send_field( cdname, pfield3d, ntile - 1 ) 
     2078         ELSE IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN 
     2079            CALL xios_send_field( cdname, pfield3d ) 
     2080         ENDIF 
    20652081#else 
    20662082         WRITE(numout,*) pfield3d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 
    … …  
    20742090      IF( iom_use(cdname) ) THEN 
    20752091#if defined key_xios 
    2076          CALL xios_send_field (cdname, pfield4d ) 
     2092         IF( is_tile(pfield4d) == 1 ) THEN 
     2093            CALL xios_send_field( cdname, pfield4d, ntile - 1 ) 
     2094         ELSE IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN 
     2095            CALL xios_send_field( cdname, pfield4d ) 
     2096         ENDIF 
    20772097#else 
    20782098         WRITE(numout,*) pfield4d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 
    … …  
    20862106      IF( iom_use(cdname) ) THEN 
    20872107#if defined key_xios 
    2088          CALL xios_send_field (cdname, pfield4d ) 
     2108         IF( is_tile(pfield4d) == 1 ) THEN 
     2109            CALL xios_send_field( cdname, pfield4d, ntile - 1 ) 
     2110         ELSE IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN 
     2111            CALL xios_send_field( cdname, pfield4d ) 
     2112         ENDIF 
    20892113#else 
    20902114         WRITE(numout,*) pfield4d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 
    … …  
    21002124   SUBROUTINE iom_set_domain_attr( cdid, ni_glo, nj_glo, ibegin, jbegin, ni, nj,                                               & 
    21012125      &                                    data_dim, data_ibegin, data_ni, data_jbegin, data_nj, lonvalue, latvalue, mask,     & 
     2126      &                                  ntiles, tile_ibegin, tile_jbegin, tile_ni, tile_nj,                                   & 
     2127      &                                  tile_data_ibegin, tile_data_jbegin, tile_data_ni, tile_data_nj,                       & 
    21022128      &                                    nvertex, bounds_lon, bounds_lat, area ) 
    21032129      !!---------------------------------------------------------------------- 
    … …  
    21052131      CHARACTER(LEN=*)                  , INTENT(in) ::   cdid 
    21062132      INTEGER                 , OPTIONAL, INTENT(in) ::   ni_glo, nj_glo, ibegin, jbegin, ni, nj 
     2133      INTEGER,  DIMENSION(:)  , OPTIONAL, INTENT(in) ::   tile_ibegin, tile_jbegin, tile_ni, tile_nj 
     2134      INTEGER,  DIMENSION(:)  , OPTIONAL, INTENT(in) ::   tile_data_ibegin, tile_data_jbegin, tile_data_ni, tile_data_nj 
    21072135      INTEGER                 , OPTIONAL, INTENT(in) ::   data_dim, data_ibegin, data_ni, data_jbegin, data_nj 
    2108       INTEGER                 , OPTIONAL, INTENT(in) ::   nvertex 
     2136      INTEGER                 , OPTIONAL, INTENT(in) ::   nvertex, ntiles 
    21092137      REAL(dp), DIMENSION(:)  , OPTIONAL, INTENT(in) ::   lonvalue, latvalue 
    21102138      REAL(dp), DIMENSION(:,:), OPTIONAL, INTENT(in) ::   bounds_lon, bounds_lat, area 
    … …  
    21152143         CALL xios_set_domain_attr     ( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   & 
    21162144            &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj ,   & 
     2145            &    ntiles=ntiles, tile_ibegin=tile_ibegin, tile_jbegin=tile_jbegin, tile_ni=tile_ni, tile_nj=tile_nj,        & 
     2146            &    tile_data_ibegin=tile_data_ibegin, tile_data_jbegin=tile_data_jbegin,                                     & 
     2147            &    tile_data_ni=tile_data_ni, tile_data_nj=tile_data_nj,                                                     & 
    21172148            &    lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_1D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon,      & 
    21182149            &    bounds_lat_1D=bounds_lat, area=area, type='curvilinear') 
    … …  
    21212152         CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   & 
    21222153            &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj ,   & 
     2154            &    ntiles=ntiles, tile_ibegin=tile_ibegin, tile_jbegin=tile_jbegin, tile_ni=tile_ni, tile_nj=tile_nj,        & 
     2155            &    tile_data_ibegin=tile_data_ibegin, tile_data_jbegin=tile_data_jbegin,                                     & 
     2156            &    tile_data_ni=tile_data_ni, tile_data_nj=tile_data_nj,                                                     & 
    21232157            &    lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_1D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon,      & 
    21242158            &    bounds_lat_1D=bounds_lat, area=area, type='curvilinear' ) 
    … …  
    22882322      ! 
    22892323      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zmask 
     2324      INTEGER :: jn 
     2325      INTEGER, DIMENSION(nijtile) :: ini, inj, idb 
    22902326      LOGICAL, INTENT(IN) :: ldxios, ldrxios 
    22912327      !!---------------------------------------------------------------------- 
    … …  
    22932329      CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=Ni0glo,nj_glo=Nj0glo,ibegin=mig0(Nis0)-1,jbegin=mjg0(Njs0)-1,ni=Ni_0,nj=Nj_0) 
    22942330      CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = -nn_hls, data_ni=jpi, data_jbegin = -nn_hls, data_nj=jpj) 
     2331 
     2332      IF( ln_tile ) THEN 
     2333         DO jn = 1, nijtile 
     2334            ini(jn) = ntei_a(jn) - ntsi_a(jn) + 1     ! Tile size in i and j 
     2335            inj(jn) = ntej_a(jn) - ntsj_a(jn) + 1 
     2336            idb(jn) = -nn_hls                         ! Tile data offset (halo size) 
     2337         END DO 
     2338 
     2339         ! Tile_[ij]begin are defined with respect to the processor data domain, so data_[ij]begin is added 
     2340         CALL iom_set_domain_attr("grid_"//cdgrd, ntiles=nijtile,                                     & 
     2341            & tile_ibegin=ntsi_a(1:nijtile) + idb(:) - 1, tile_jbegin=ntsj_a(1:nijtile) + idb(:) - 1, & 
     2342            & tile_ni=ini(:), tile_nj=inj(:),                                                         & 
     2343            & tile_data_ibegin=idb(:), tile_data_jbegin=idb(:),                                       & 
     2344            & tile_data_ni=ini(:) - 2 * idb(:), tile_data_nj=inj(:) - 2 * idb(:)) 
     2345      ENDIF 
     2346 
    22952347!don't define lon and lat for restart reading context. 
    22962348      IF ( .NOT.ldrxios ) & 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/IOM/restart.F90

    r14789 r14852  
    410410               ssh(:,:,Kbb) = -ssh_ref 
    411411               ! 
    412                DO_2D( 1, 1, 1, 1 ) 
     412               DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    413413                  IF( ht_0(ji,jj)-ssh_ref <  rn_wdmin1 ) THEN   ! if total depth is less than min depth 
    414414                     ssh(ji,jj,Kbb) = rn_wdmin1 - ht_0(ji,jj) 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/ISF/isfhdiv.F90

    r13295 r14852  
    5252         IF ( ln_isfpar_mlt ) CALL isf_hdiv_mlt(misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par, fwfisf_par, fwfisf_par_b, phdiv) 
    5353         ! 
    54          ! ice sheet coupling contribution  
     54         ! ice sheet coupling contribution 
    5555         IF ( ln_isfcpl .AND. kt /= 0 ) THEN 
    5656            ! 
    … …  
    9191      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    9292      INTEGER  ::   ikt, ikb  
    93       REAL(wp), DIMENSION(jpi,jpj) :: zhdiv 
     93      REAL(wp), DIMENSION(A2D(nn_hls)) :: zhdiv 
    9494      !!---------------------------------------------------------------------- 
    9595      ! 
    … …  
    9797      ! 
    9898      ! compute integrated divergence correction 
    99       zhdiv(:,:) = 0.5_wp * ( pfwf(:,:) + pfwf_b(:,:) ) * r1_rho0 / phtbl(:,:) 
     99      DO_2D( nn_hls-1, nn_hls, nn_hls-1, nn_hls ) 
     100         zhdiv(ji,jj) = 0.5_wp * ( pfwf(ji,jj) + pfwf_b(ji,jj) ) * r1_rho0 / phtbl(ji,jj) 
     101      END_2D 
    100102      ! 
    101103      ! update divergence at each level affected by ice shelf top boundary layer 
    102       DO_2D( 1, 1, 1, 1 ) 
     104      DO_2D_OVR( nn_hls-1, nn_hls, nn_hls-1, nn_hls ) 
    103105         ikt = ktop(ji,jj) 
    104106         ikb = kbot(ji,jj) 
    … …  
    131133      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) :: pqvol 
    132134      !!---------------------------------------------------------------------- 
    133       INTEGER :: jk 
     135      INTEGER :: ji, jj, jk 
    134136      !!---------------------------------------------------------------------- 
    135137      ! 
    136       DO jk=1,jpk  
    137          phdiv(:,:,jk) =  phdiv(:,:,jk) + pqvol(:,:,jk) * r1_e1e2t(:,:)   & 
    138             &                             / e3t(:,:,jk,Kmm) 
    139       END DO 
     138      DO_3D_OVR( nn_hls-1, nn_hls, nn_hls-1, nn_hls, 1, jpk ) 
     139         phdiv(ji,jj,jk) =  phdiv(ji,jj,jk) + pqvol(ji,jj,jk) * r1_e1e2t(ji,jj)   & 
     140            &                             / e3t(ji,jj,jk,Kmm) 
     141      END_3D 
    140142      ! 
    141143   END SUBROUTINE isf_hdiv_cpl 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/ISF/isftbl.F90

    r14789 r14852  
    176176      ! 
    177177      ! get htbl 
    178       DO_2D( 1, 1, 1, 1 ) 
     178      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    179179         ! 
    180180         ! tbl top/bottom indices initialisation 
    … …  
    193193      ! 
    194194      ! get pfrac 
    195       DO_2D( 1, 1, 1, 1 ) 
     195      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    196196         ! 
    197197         ! tbl top/bottom indices initialisation 
    … …  
    227227      ! 
    228228      ! get ktbl 
    229       DO_2D( 1, 1, 1, 1 ) 
     229      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    230230         ! 
    231231         ! determine the deepest level influenced by the boundary layer 
    … …  
    261261      ! test: this routine run with pdep = 0 should return 1 
    262262      ! 
    263       DO_2D( 1, 1, 1, 1 ) 
     263      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    264264         ! comput ktop 
    265265         ikt = 2 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/LBC/lbc_lnk_neicoll_generic.h90

    r14789 r14852  
    2626      INTEGER, DIMENSION(8)  ::   isizej, ishtSj, ishtRj, ishtPj 
    2727      INTEGER, DIMENSION(8)  ::   ifill, iszall 
     28      INTEGER, DIMENSION(8)  ::   jnf 
    2829      INTEGER, DIMENSION(:), ALLOCATABLE  ::   iScnt, iRcnt    ! number of elements to be sent/received 
    2930      INTEGER, DIMENSION(:), ALLOCATABLE  ::   iSdpl, iRdpl    ! displacement in halos arrays 
    … …  
    192193      ! 
    193194      idx = 1 
     195      ! MPI3 bug fix when domain decomposition has 2 columns/rows 
     196      IF (jpni .eq. 2) THEN 
     197         IF (jpnj .eq. 2) THEN 
     198            jnf(1:8) = (/ 2, 1, 4, 3, 8, 7, 6, 5 /) 
     199         ELSE 
     200            jnf(1:8) = (/ 2, 1, 3, 4, 6, 5, 8, 7 /) 
     201         ENDIF 
     202      ELSE 
     203         IF (jpnj .eq. 2) THEN 
     204            jnf(1:8) = (/ 1, 2, 4, 3, 7, 8, 5, 6 /) 
     205         ELSE 
     206            jnf(1:8) = (/ 1, 2, 3, 4, 5, 6, 7, 8 /) 
     207         ENDIF 
     208      ENDIF 
     209 
    194210      DO jn = 1, 8 
    195          ishti = ishtRi(jn) 
    196          ishtj = ishtRj(jn) 
    197          SELECT CASE ( ifill(jn) ) 
     211         ishti = ishtRi(jnf(jn)) 
     212         ishtj = ishtRj(jnf(jn)) 
     213         SELECT CASE ( ifill(jnf(jn)) ) 
    198214         CASE ( jpfillnothing )               ! no filling  
    199215         CASE ( jpfillmpi   )                 ! fill with data received by MPI 
    200             DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn) 
     216            DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jnf(jn))  ;  DO ji = 1,isizei(jnf(jn)) 
    201217               ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = BUFFRCV(idx) 
    202218               idx = idx + 1 
    203219            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    204220         CASE ( jpfillperio )                 ! use periodicity 
    205             ishti2 = ishtPi(jn) 
    206             ishtj2 = ishtPj(jn) 
    207             DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn) 
     221            ishti2 = ishtPi(jnf(jn)) 
     222            ishtj2 = ishtPj(jnf(jn)) 
     223            DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jnf(jn))  ;  DO ji = 1,isizei(jnf(jn)) 
    208224               ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl) 
    209225            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    210226         CASE ( jpfillcopy  )                 ! filling with inner domain values 
    211             ishti2 = ishtSi(jn) 
    212             ishtj2 = ishtSj(jn) 
    213             DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn) 
     227            ishti2 = ishtSi(jnf(jn)) 
     228            ishtj2 = ishtSj(jnf(jn)) 
     229            DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jnf(jn))  ;  DO ji = 1,isizei(jnf(jn)) 
    214230               ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl) 
    215231            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    216232         CASE ( jpfillcst   )                 ! filling with constant value 
    217             DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn) 
     233            DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jnf(jn))  ;  DO ji = 1,isizei(jnf(jn)) 
    218234               ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = zland 
    219235            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/LBC/mppini.F90

    r14789 r14852  
    632632      klci(1:iresti      ,:) = kimax 
    633633      klci(iresti+1:knbi ,:) = kimax-1 
    634       IF( MINVAL(klci) < 2*i2hls ) THEN 
    635          WRITE(ctmp1,*) '   mpp_basesplit: minimum value of jpi must be >= ', 2*i2hls 
     634      IF( MINVAL(klci) < 3*khls ) THEN 
     635         WRITE(ctmp1,*) '   mpp_basesplit: minimum value of jpi must be >= ', 3*khls 
    636636         WRITE(ctmp2,*) '   We have ', MINVAL(klci) 
    637         CALL ctl_stop( 'STOP', ctmp1, ctmp2 ) 
     637         CALL ctl_stop( 'STOP', ctmp1, ctmp2 ) 
    638638      ENDIF 
    639639      IF( l_NFold ) THEN 
    … …  
    650650      ENDIF 
    651651      klcj(:,1:irestj) = kjmax 
    652       IF( MINVAL(klcj) < 2*i2hls ) THEN 
    653          WRITE(ctmp1,*) '   mpp_basesplit: minimum value of jpj must be >= ', 2*i2hls 
     652      IF( MINVAL(klcj) < 3*khls ) THEN 
     653         WRITE(ctmp1,*) '   mpp_basesplit: minimum value of jpj must be >= ', 3*khls 
    654654         WRITE(ctmp2,*) '   We have ', MINVAL(klcj) 
    655655         CALL ctl_stop( 'STOP', ctmp1, ctmp2 ) 
    … …  
    729729      iszjref = jpiglo*jpjglo+1 
    730730      ! 
    731       iszimin = 4*nn_hls          ! minimum size of the MPI subdomain so halos are always adressing neighbor inner domain 
    732       iszjmin = 4*nn_hls 
     731      iszimin = 3*nn_hls          ! minimum size of the MPI subdomain so halos are always adressing neighbor inner domain 
     732      iszjmin = 3*nn_hls 
    733733      IF( c_NFtype == 'T' )   iszjmin = MAX(iszjmin, 2+3*nn_hls)   ! V and F folding must be outside of southern halos 
    734734      IF( c_NFtype == 'F' )   iszjmin = MAX(iszjmin, 1+3*nn_hls)   ! V and F folding must be outside of southern halos 
    … …  
    760760         ENDIF 
    761761      END DO 
     762      IF( inbimax == 0 ) THEN 
     763         WRITE(ctmp1,'(a,i2,a,i2)') '   mpp_ini bestpartition: Ni0glo (', Ni0glo, ') is too small to be used with nn_hls = ', nn_hls 
     764         CALL ctl_stop( 'STOP', ctmp1 ) 
     765      ENDIF 
     766      IF( inbjmax == 0 ) THEN 
     767         WRITE(ctmp1,'(a,i2,a,i2)') '   mpp_ini bestpartition: Nj0glo (', Nj0glo, ') is too small to be used with nn_hls = ', nn_hls 
     768         CALL ctl_stop( 'STOP', ctmp1 ) 
     769      ENDIF 
    762770 
    763771      ! combine these 2 lists to get all possible knbi*knbj <  inbijmax 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/LDF/ldfc1d_c2d.F90

    r14789 r14852  
    135135      ! 
    136136      CASE( 'DYN' )                       ! T- and F-points 
    137          DO_2D( 1, 1, 1, 1 ) 
     137         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    138138            pah1(ji,jj,1) = pUfac * MAX( e1t(ji,jj) , e2t(ji,jj) )**knn 
    139139            pah2(ji,jj,1) = pUfac * MAX( e1f(ji,jj) , e2f(ji,jj) )**knn 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/LDF/ldfslp.F90

    r14789 r14852  
    371371         ! 
    372372         ip = jl   ;   jp = jl                ! guaranteed nonzero gradients ( absolute value larger than repsln) 
    373          DO_3D( 1, 0, 1, 0, 1, jpkm1 )        ! done each pair of triad ! NB: not masked ==>  a minimum value is set 
     373         DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )        ! done each pair of triad ! NB: not masked ==>  a minimum value is set 
    374374            zdit = ( ts(ji+1,jj,jk,jp_tem,Kbb) - ts(ji,jj,jk,jp_tem,Kbb) )    ! i-gradient of T & S at u-point 
    375375            zdis = ( ts(ji+1,jj,jk,jp_sal,Kbb) - ts(ji,jj,jk,jp_sal,Kbb) ) 
    … …  
    383383         ! 
    384384         IF( ln_zps .AND. l_grad_zps ) THEN     ! partial steps: correction of i- & j-grad on bottom 
    385             DO_2D( 1, 0, 1, 0 ) 
     385            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    386386               iku  = mbku(ji,jj)          ;   ikv  = mbkv(ji,jj)             ! last ocean level (u- & v-points) 
    387387               zdit = gtsu(ji,jj,jp_tem)   ;   zdjt = gtsv(ji,jj,jp_tem)      ! i- & j-gradient of Temperature 
    … …  
    397397 
    398398      DO kp = 0, 1                            !==  unmasked before density i- j-, k-gradients  ==! 
    399          DO_3D( 1, 1, 1, 1, 1, jpkm1 )        ! done each pair of triad ! NB: not masked ==>  a minimum value is set 
     399         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )      ! done each pair of triad ! NB: not masked ==>  a minimum value is set 
    400400            IF( jk+kp > 1 ) THEN              ! k-gradient of T & S a jk+kp 
    401401               zdkt = ( ts(ji,jj,jk+kp-1,jp_tem,Kbb) - ts(ji,jj,jk+kp,jp_tem,Kbb) ) 
    … …  
    412412      END DO 
    413413      ! 
    414       DO_2D( 1, 1, 1, 1 )                     !== Reciprocal depth of the w-point below ML base  ==! 
     414      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )                   !== Reciprocal depth of the w-point below ML base  ==! 
    415415         jk = MIN( nmln(ji,jj), mbkt(ji,jj) ) + 1     ! MIN in case ML depth is the ocean depth 
    416416         z1_mlbw(ji,jj) = 1._wp / gdepw(ji,jj,jk,Kmm) 
    … …  
    432432      DO jl = 0, 1                            ! calculate slope of the 4 triads immediately ONE level below mixed-layer base 
    433433         DO kp = 0, 1                         ! with only the slope-max limit   and   MASKED 
    434             DO_2D( 1, 0, 1, 0 ) 
     434            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    435435               ip = jl   ;   jp = jl 
    436436               ! 
    … …  
    469469               ! Must mask contribution to slope from dz/dx at constant s for triads jk=1,kp=0 that poke up though ocean surface 
    470470               znot_thru_surface = REAL( 1-1/(jk+kp), wp )  !jk+kp=1,=0.; otherwise=1.0 
    471                DO_2D( 1, 0, 1, 0 ) 
     471               DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    472472                  ! 
    473473                  ! Calculate slope relative to geopotentials used for GM skew fluxes 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/LDF/ldftra.F90

    r14789 r14852  
    633633      INTEGER                         , INTENT(in   ) ::   kt             ! ocean time-step index 
    634634      INTEGER                         , INTENT(in   ) ::   Kmm            ! ocean time level indices 
    635       REAL(wp)                        , INTENT(inout) ::   paei0          ! max value            [m2/s] 
     635      REAL(wp)                        , INTENT(in   ) ::   paei0          ! max value            [m2/s] 
    636636      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   paeiu, paeiv   ! eiv coefficient      [m2/s] 
    637637      ! 
    638638      INTEGER  ::   ji, jj, jk    ! dummy loop indices 
    639       REAL(wp) ::   zfw, ze3w, zn2, z1_f20, zaht, zaht_min, zzaei    ! local scalars 
     639      REAL(wp) ::   zfw, ze3w, zn2, z1_f20, zzaei    ! local scalars 
    640640      REAL(wp), DIMENSION(jpi,jpj) ::   zn, zah, zhw, zRo, zaeiw   ! 2D workspace 
    641641      !!---------------------------------------------------------------------- 
    … …  
    647647      !                       ! Compute lateral diffusive coefficient at T-point 
    648648      IF( ln_traldf_triad ) THEN 
    649          DO_3D( 0, 0, 0, 0, 1, jpk ) 
     649         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 
    650650            ! Take the max of N^2 and zero then take the vertical sum 
    651651            ! of the square root of the resulting N^2 ( required to compute 
    … …  
    661661         END_3D 
    662662      ELSE 
    663          DO_3D( 0, 0, 0, 0, 1, jpk ) 
     663         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 
    664664            ! Take the max of N^2 and zero then take the vertical sum 
    665665            ! of the square root of the resulting N^2 ( required to compute 
    … …  
    677677      ENDIF 
    678678 
    679       DO_2D( 0, 0, 0, 0 ) 
     679      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    680680         zfw = MAX( ABS( 2. * omega * SIN( rad * gphit(ji,jj) ) ) , 1.e-10 ) 
    681681         ! Rossby radius at w-point taken betwenn 2 km and  40km 
    … …  
    687687      !                                         !==  Bound on eiv coeff.  ==! 
    688688      z1_f20 = 1._wp / (  2._wp * omega * sin( rad * 20._wp )  ) 
    689       DO_2D( 0, 0, 0, 0 ) 
     689      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    690690         zzaei = MIN( 1._wp, ABS( ff_t(ji,jj) * z1_f20 ) ) * zaeiw(ji,jj)     ! tropical decrease 
    691691         zaeiw(ji,jj) = MIN( zzaei , paei0 )                                  ! Max value = paei0 
    … …  
    693693      CALL lbc_lnk( 'ldftra', zaeiw(:,:), 'W', 1.0_wp )       ! lateral boundary condition 
    694694      ! 
    695       DO_2D( 0, 0, 0, 0 )                       !== aei at u- and v-points  ==! 
     695      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    696696         paeiu(ji,jj,1) = 0.5_wp * ( zaeiw(ji,jj) + zaeiw(ji+1,jj  ) ) * umask(ji,jj,1) 
    697697         paeiv(ji,jj,1) = 0.5_wp * ( zaeiw(ji,jj) + zaeiw(ji  ,jj+1) ) * vmask(ji,jj,1) 
    … …  
    729729      INTEGER                     , INTENT(in   ) ::   Kmm, Krhs ! ocean time level indices 
    730730      CHARACTER(len=3)            , INTENT(in   ) ::   cdtype    ! =TRA or TRC (tracer indicator) 
    731       REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(inout) ::   pu        ! in : 3 ocean transport components   [m3/s] 
    732       REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(inout) ::   pv        ! out: 3 ocean transport components   [m3/s] 
    733       REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(inout) ::   pw        ! increased by the eiv                [m3/s] 
     731      ! TEMP: [tiling] Can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct 
     732      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu        ! in : 3 ocean transport components   [m3/s] 
     733      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pv        ! out: 3 ocean transport components   [m3/s] 
     734      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pw        ! increased by the eiv                [m3/s] 
    734735      !! 
    735736      INTEGER  ::   ji, jj, jk                 ! dummy loop indices 
    … …  
    739740      !!---------------------------------------------------------------------- 
    740741      ! 
    741       IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     742      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
    742743         IF( kt == kit000 )  THEN 
    743744            IF(lwp) WRITE(numout,*) 
    … …  
    751752      zpsi_uw(:,:,jpk) = 0._wp   ;   zpsi_vw(:,:,jpk) = 0._wp 
    752753      ! 
    753       DO_3D( 1, 0, 1, 0, 2, jpkm1 ) 
     754      DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 2, jpkm1 ) 
    754755         zpsi_uw(ji,jj,jk) = - r1_4 * e2u(ji,jj) * ( wslpi(ji,jj,jk  ) + wslpi(ji+1,jj,jk) )   & 
    755756            &                                    * ( aeiu (ji,jj,jk-1) + aeiu (ji  ,jj,jk) ) * wumask(ji,jj,jk) 
    … …  
    758759      END_3D 
    759760      ! 
    760       DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 
     761      DO_3D_OVR( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) 
    761762         pu(ji,jj,jk) = pu(ji,jj,jk) - ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji,jj,jk+1) ) 
    762763         pv(ji,jj,jk) = pv(ji,jj,jk) - ( zpsi_vw(ji,jj,jk) - zpsi_vw(ji,jj,jk+1) ) 
    763764      END_3D 
    764       DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     765      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
    765766         pw(ji,jj,jk) = pw(ji,jj,jk) + (  zpsi_uw(ji,jj,jk) - zpsi_uw(ji-1,jj  ,jk)   & 
    766             &                             + zpsi_vw(ji,jj,jk) - zpsi_vw(ji  ,jj-1,jk) ) 
     767            &                           + zpsi_vw(ji,jj,jk) - zpsi_vw(ji  ,jj-1,jk) ) 
    767768      END_3D 
    768769      ! 
    … …  
    783784      !! 
    784785      !!---------------------------------------------------------------------- 
    785       REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(inout) ::   psi_uw, psi_vw   ! streamfunction   [m3/s] 
    786       INTEGER                     , INTENT(in   ) ::   Kmm   ! ocean time level indices 
     786      REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(in) ::   psi_uw, psi_vw   ! streamfunction   [m3/s] 
     787      INTEGER                             , INTENT(in) ::   Kmm              ! ocean time level indices 
    787788      ! 
    788789      INTEGER  ::   ji, jj, jk    ! dummy loop indices 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/OBS/diaobs.F90

    r14789 r14852  
    687687                  &               nit000, idaystp, jvar,                   & 
    688688                  &               zprofvar(:,:,:,jvar),                    & 
    689                   &               gdept(:,:,:,Kmm), gdepw(:,:,:,Kmm),      &  
     689                  &               gdept(:,:,:,Kmm), gdepw(:,:,:,Kmm),      & 
    690690                  &               zprofmask(:,:,:,jvar),                   & 
    691691                  &               zglam(:,:,jvar), zgphi(:,:,jvar),        & 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/SBC/sbccpl.F90

    r14789 r14852  
    13011301         IF( llnewtau ) THEN 
    13021302            zcoef = 1. / ( zrhoa * zcdrag ) 
    1303             DO_2D( 1, 1, 1, 1 ) 
     1303            DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    13041304               frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef ) 
    13051305            END_2D 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/SBC/sbcmod.F90

    r14789 r14852  
    475475      END SELECT 
    476476 
    477       IF( ln_icebergs    )   THEN 
    478                                      CALL icb_stp( kt, Kmm )           ! compute icebergs 
    479          ! Icebergs do not melt over the haloes. 
    480          ! So emp values over the haloes are no more consistent with the inner domain values. 
    481          ! A lbc_lnk is therefore needed to ensure reproducibility and restartability. 
    482          ! see ticket #2113 for discussion about this lbc_lnk. 
    483          IF( .NOT. ln_passive_mode ) CALL lbc_lnk( 'sbcmod', emp, 'T', 1.0_wp ) ! ensure restartability with icebergs 
     477      IF( ln_icebergs    )   CALL icb_stp( kt, Kmm )              ! compute icebergs 
     478 
     479      ! Icebergs do not melt over the haloes. 
     480      ! So emp values over the haloes are no more consistent with the inner domain values. 
     481      ! A lbc_lnk is therefore needed to ensure reproducibility and restartability. 
     482      ! see ticket #2113 for discussion about this lbc_lnk. 
     483      ! The lbc_lnk is also needed for SI3 with nn_hls > 1 as emp is not yet defined for these points in iceupdate.F90 
     484      IF( (ln_icebergs .AND. .NOT. ln_passive_mode) .OR. (nn_ice == 2 .AND. nn_hls == 2) ) THEN 
     485         CALL lbc_lnk( 'sbcmod', emp, 'T', 1.0_wp ) 
    484486      ENDIF 
    485487 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/SBC/sbcrnf.F90

    r14789 r14852  
    211211      IF( ln_rnf_depth .OR. ln_rnf_depth_ini ) THEN      !==   runoff distributed over several levels   ==! 
    212212         IF( ln_linssh ) THEN    !* constant volume case : just apply the runoff input flow 
    213             DO_2D( 1, 1, 1, 1 ) 
     213            DO_2D_OVR( nn_hls-1, nn_hls, nn_hls-1, nn_hls ) 
    214214               DO jk = 1, nk_rnf(ji,jj) 
    215215                  phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_rho0 / h_rnf(ji,jj) 
    … …  
    217217            END_2D 
    218218         ELSE                    !* variable volume case 
    219             DO_2D( 1, 1, 1, 1 )              ! update the depth over which runoffs are distributed 
     219            DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls )         ! update the depth over which runoffs are distributed 
    220220               h_rnf(ji,jj) = 0._wp 
    221221               DO jk = 1, nk_rnf(ji,jj)                             ! recalculates h_rnf to be the depth in metres 
    … …  
    229229         ENDIF 
    230230      ELSE                       !==   runoff put only at the surface   ==! 
    231          h_rnf (:,:)   = e3t (:,:,1,Kmm)        ! update h_rnf to be depth of top box 
    232          phdivn(:,:,1) = phdivn(:,:,1) - ( rnf(:,:) + rnf_b(:,:) ) * zfact * r1_rho0 / e3t(:,:,1,Kmm) 
     231         DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls ) 
     232            h_rnf (ji,jj)   = e3t (ji,jj,1,Kmm)        ! update h_rnf to be depth of top box 
     233            phdivn(ji,jj,1) = phdivn(ji,jj,1) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_rho0 / e3t(ji,jj,1,Kmm) 
     234         END_2D 
    233235      ENDIF 
    234236      ! 
    … …  
    363365         ! 
    364366         nk_rnf(:,:) = 0                               ! set the number of level over which river runoffs are applied 
    365          DO_2D( 1, 1, 1, 1 ) 
     367         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    366368            IF( h_rnf(ji,jj) > 0._wp ) THEN 
    367369               jk = 2 
    … …  
    376378            ENDIF 
    377379         END_2D 
    378          DO_2D( 1, 1, 1, 1 )                           ! set the associated depth 
     380         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )                           ! set the associated depth 
    379381            h_rnf(ji,jj) = 0._wp 
    380382            DO jk = 1, nk_rnf(ji,jj) 
    … …  
    406408         WHERE( zrnfcl(:,:,1) > 0._wp )  h_rnf(:,:) = zacoef * zrnfcl(:,:,1)   ! compute depth for all runoffs 
    407409         ! 
    408          DO_2D( 1, 1, 1, 1 )                ! take in account min depth of ocean rn_hmin 
     410         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )                ! take in account min depth of ocean rn_hmin 
    409411            IF( zrnfcl(ji,jj,1) > 0._wp ) THEN 
    410412               jk = mbkt(ji,jj) 
    … …  
    414416         ! 
    415417         nk_rnf(:,:) = 0                       ! number of levels on which runoffs are distributed 
    416          DO_2D( 1, 1, 1, 1 ) 
     418         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    417419            IF( zrnfcl(ji,jj,1) > 0._wp ) THEN 
    418420               jk = 2 
    … …  
    425427         END_2D 
    426428         ! 
    427          DO_2D( 1, 1, 1, 1 )                          ! set the associated depth 
     429         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )                          ! set the associated depth 
    428430            h_rnf(ji,jj) = 0._wp 
    429431            DO jk = 1, nk_rnf(ji,jj) 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/SBC/sbcssr.F90

    r14789 r14852  
    9898            ! 
    9999            IF( nn_sstr == 1 ) THEN                                   !* Temperature restoring term 
    100                DO_2D( 1, 1, 1, 1 ) 
     100               DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    101101                  zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj,1) ) * tmask(ji,jj,1) 
    102102                  qns(ji,jj) = qns(ji,jj) + zqrp 
    … …  
    108108              ! use fraction of ice ( fr_i ) to adjust relaxation under ice if nn_sssr_ice .ne. 1 
    109109              ! n.b. coefice is initialised and fixed to 1._wp if nn_sssr_ice = 1 
    110                DO_2D( 1, 1, 1, 1 ) 
     110               DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    111111                  SELECT CASE ( nn_sssr_ice ) 
    112112                    CASE ( 0 )    ;  coefice(ji,jj) = 1._wp - fr_i(ji,jj)              ! no/reduced damping under ice 
    … …  
    118118            IF( nn_sssr == 1 ) THEN                                   !* Salinity damping term (salt flux only (sfx)) 
    119119               zsrp = rn_deds / rday                                  ! from [mm/day] to [kg/m2/s] 
    120                DO_2D( 1, 1, 1, 1 ) 
     120               DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    121121                  zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths 
    122122                     &        *   coefice(ji,jj)            &      ! Optional control of damping under sea-ice 
    … …  
    129129               zsrp = rn_deds / rday                                  ! from [mm/day] to [kg/m2/s] 
    130130               zerp_bnd = rn_sssr_bnd / rday                          !       -              -     
    131                DO_2D( 1, 1, 1, 1 ) 
     131               DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    132132                  zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths 
    133133                     &        *   coefice(ji,jj)            &      ! Optional control of damping under sea-ice 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/TRA/eosbn2.F90

    r14789 r14852  
    577577 
    578578   SUBROUTINE eos_insitu_pot_2d( pts, prhop ) 
     579      !! 
     580      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celsius] 
     581      !                                                     ! 2 : salinity               [psu] 
     582      REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   prhop  ! potential density (surface referenced) 
     583      !! 
     584      CALL eos_insitu_pot_2d_t( pts, is_tile(pts), prhop, is_tile(prhop) ) 
     585   END SUBROUTINE eos_insitu_pot_2d 
     586 
     587 
     588   SUBROUTINE eos_insitu_pot_2d_t( pts, ktts, prhop, ktrhop ) 
    579589      !!---------------------------------------------------------------------- 
    580590      !!                  ***  ROUTINE eos_insitu_pot  *** 
    … …  
    589599      !! 
    590600      !!---------------------------------------------------------------------- 
    591       REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celsius] 
     601      INTEGER                              , INTENT(in   ) ::   ktts, ktrhop 
     602      REAL(wp), DIMENSION(A2D_T(ktts),JPTS), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celsius] 
    592603      !                                                                ! 2 : salinity               [psu] 
    593       REAL(wp), DIMENSION(jpi,jpj     ), INTENT(  out) ::   prhop  ! potential density (surface referenced) 
     604      REAL(wp), DIMENSION(A2D_T(ktrhop)   ), INTENT(  out) ::   prhop  ! potential density (surface referenced) 
    594605      ! 
    595606      INTEGER  ::   ji, jj, jk, jsmp             ! dummy loop indices 
    … …  
    606617      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==! 
    607618         ! 
    608             DO_2D( 1, 1, 1, 1 ) 
    609                ! 
    610                zt  = pts (ji,jj,jp_tem) * r1_T0                           ! temperature 
    611                zs  = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
    612                ztm = tmask(ji,jj,1)                                         ! tmask 
    613                ! 
    614                zn0 = (((((EOS060*zt   & 
    615                   &   + EOS150*zs+EOS050)*zt   & 
    616                   &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   & 
    617                   &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   & 
    618                   &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   & 
    619                   &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   & 
    620                   &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 
    621                   ! 
    622                ! 
    623                prhop(ji,jj) = zn0 * ztm                           ! potential density referenced at the surface 
    624                ! 
    625             END_2D 
     619         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     620            ! 
     621            zt  = pts (ji,jj,jp_tem) * r1_T0                           ! temperature 
     622            zs  = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity 
     623            ztm = tmask(ji,jj,1)                                         ! tmask 
     624            ! 
     625            zn0 = (((((EOS060*zt   & 
     626               &   + EOS150*zs+EOS050)*zt   & 
     627               &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   & 
     628               &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   & 
     629               &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   & 
     630               &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   & 
     631               &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 
     632               ! 
     633            ! 
     634            prhop(ji,jj) = zn0 * ztm                           ! potential density referenced at the surface 
     635            ! 
     636         END_2D 
    626637 
    627638      CASE( np_seos )                !==  simplified EOS  ==! 
    628639         ! 
    629          DO_2D( 1, 1, 1, 1 ) 
     640         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    630641            zt  = pts  (ji,jj,jp_tem) - 10._wp 
    631642            zs  = pts  (ji,jj,jp_sal) - 35._wp 
    … …  
    646657      IF( ln_timing )   CALL timing_stop('eos-pot') 
    647658      ! 
    648    END SUBROUTINE eos_insitu_pot_2d 
     659   END SUBROUTINE eos_insitu_pot_2d_t 
    649660 
    650661 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/TRA/traadv.F90

    r14789 r14852  
    1818   USE oce            ! ocean dynamics and active tracers 
    1919   USE dom_oce        ! ocean space and time domain 
    20    ! TEMP: [tiling] This change not necessary after extended haloes development 
     20   ! TEMP: [tiling] This change not necessary after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct 
    2121   USE domtile 
    2222   USE domvvl         ! variable vertical scale factors 
    … …  
    2525   USE traadv_cen     ! centered scheme            (tra_adv_cen  routine) 
    2626   USE traadv_fct     ! FCT      scheme            (tra_adv_fct  routine) 
    27    USE traadv_fct_lf  ! FCT      scheme            (tra_adv_fct  routine - loop fusion version) 
    2827   USE traadv_mus     ! MUSCL    scheme            (tra_adv_mus  routine) 
    29    USE traadv_mus_lf  ! MUSCL    scheme            (tra_adv_mus  routine - loop fusion version) 
    3028   USE traadv_ubs     ! UBS      scheme            (tra_adv_ubs  routine) 
    3129   USE traadv_qck     ! QUICKEST scheme            (tra_adv_qck  routine) 
    … …  
    6159   LOGICAL ::   ln_traadv_qck    ! QUICKEST scheme flag 
    6260 
    63    INTEGER ::   nadv             ! choice of the type of advection scheme 
     61   INTEGER, PUBLIC ::   nadv             ! choice of the type of advection scheme 
    6462   !                             ! associated indices: 
    65    INTEGER, PARAMETER ::   np_NO_adv  = 0   ! no T-S advection 
    66    INTEGER, PARAMETER ::   np_CEN     = 1   ! 2nd/4th order centered scheme 
    67    INTEGER, PARAMETER ::   np_FCT     = 2   ! 2nd/4th order Flux Corrected Transport scheme 
    68    INTEGER, PARAMETER ::   np_MUS     = 3   ! MUSCL scheme 
    69    INTEGER, PARAMETER ::   np_UBS     = 4   ! 3rd order Upstream Biased Scheme 
    70    INTEGER, PARAMETER ::   np_QCK     = 5   ! QUICK scheme 
     63   INTEGER, PARAMETER, PUBLIC ::   np_NO_adv  = 0   ! no T-S advection 
     64   INTEGER, PARAMETER, PUBLIC ::   np_CEN     = 1   ! 2nd/4th order centered scheme 
     65   INTEGER, PARAMETER, PUBLIC ::   np_FCT     = 2   ! 2nd/4th order Flux Corrected Transport scheme 
     66   INTEGER, PARAMETER, PUBLIC ::   np_MUS     = 3   ! MUSCL scheme 
     67   INTEGER, PARAMETER, PUBLIC ::   np_UBS     = 4   ! 3rd order Upstream Biased Scheme 
     68   INTEGER, PARAMETER, PUBLIC ::   np_QCK     = 5   ! QUICK scheme 
    7169 
    7270   !! * Substitutions 
    … …  
    9391      ! 
    9492      INTEGER ::   ji, jj, jk   ! dummy loop index 
    95       ! TEMP: [tiling] This change not necessary and can be A2D(nn_hls) if using XIOS (subdomain support) 
     93      ! TEMP: [tiling] This change not necessary and can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct 
    9694      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: zuu, zvv, zww   ! 3D workspace 
    9795      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdt, ztrds 
    98       ! TEMP: [tiling] This change not necessary after extra haloes development 
     96      ! TEMP: [tiling] This change not necessary after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct 
    9997      LOGICAL :: lskip 
    10098      !!---------------------------------------------------------------------- 
    … …  
    104102      lskip = .FALSE. 
    105103 
    106       ! TEMP: [tiling] These changes not necessary if using XIOS (subdomain support) 
    107       IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     104      ! TEMP: [tiling] These changes not necessary after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct 
     105      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
    108106         ALLOCATE( zuu(jpi,jpj,jpk), zvv(jpi,jpj,jpk), zww(jpi,jpj,jpk) ) 
    109107      ENDIF 
    110108 
    111       ! TEMP: [tiling] These changes not necessary after extra haloes development (lbc_lnk removed from tra_adv_*) and if XIOS has subdomain support (ldf_eiv_dia) 
    112       IF( nadv /= np_CEN .OR. (nadv == np_CEN .AND. nn_cen_h == 4) .OR. ln_ldfeiv_dia )  THEN 
    113          IF( ln_tile ) THEN 
    114             IF( ntile == 1 ) THEN 
    115                CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) 
    116             ELSE 
    117                lskip = .TRUE. 
    118             ENDIF 
     109      ! TEMP: [tiling] These changes not necessary after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct 
     110      IF( ln_tile .AND. nadv == np_FCT )  THEN 
     111         IF( ntile == 1 ) THEN 
     112            CALL dom_tile_stop( ldhold=.TRUE. ) 
     113         ELSE 
     114            lskip = .TRUE. 
    119115         ENDIF 
    120116      ENDIF 
    … …  
    122118         !                                         !==  effective transport  ==! 
    123119         IF( ln_wave .AND. ln_sdw )  THEN 
    124             DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
     120            DO_3D_OVR( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) 
    125121               zuu(ji,jj,jk) = e2u  (ji,jj) * e3u(ji,jj,jk,Kmm) * ( uu(ji,jj,jk,Kmm) + usd(ji,jj,jk) ) 
    126122               zvv(ji,jj,jk) = e1v  (ji,jj) * e3v(ji,jj,jk,Kmm) * ( vv(ji,jj,jk,Kmm) + vsd(ji,jj,jk) ) 
    … …  
    128124            END_3D 
    129125         ELSE 
    130             DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
     126            DO_3D_OVR( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) 
    131127               zuu(ji,jj,jk) = e2u  (ji,jj) * e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm)               ! eulerian transport only 
    132128               zvv(ji,jj,jk) = e1v  (ji,jj) * e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) 
    … …  
    136132         ! 
    137133         IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN                                ! add z-tilde and/or vvl corrections 
    138             DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
     134            DO_3D_OVR( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) 
    139135               zuu(ji,jj,jk) = zuu(ji,jj,jk) + un_td(ji,jj,jk) 
    140136               zvv(ji,jj,jk) = zvv(ji,jj,jk) + vn_td(ji,jj,jk) 
    … …  
    142138         ENDIF 
    143139         ! 
    144          DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     140         DO_2D_OVR( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    145141            zuu(ji,jj,jpk) = 0._wp                                                      ! no transport trough the bottom 
    146142            zvv(ji,jj,jpk) = 0._wp 
    … …  
    148144         END_2D 
    149145         ! 
    150          ! TEMP: [tiling] These changes not necessary if using XIOS (subdomain support) 
    151146         IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad )   & 
    152             &              CALL ldf_eiv_trp( kt, nit000, zuu(A2D(nn_hls),:), zvv(A2D(nn_hls),:), zww(A2D(nn_hls),:), & 
    153             &                                'TRA', Kmm, Krhs )   ! add the eiv transport (if necessary) 
    154          ! 
    155          IF( ln_mle    )   CALL tra_mle_trp( kt, nit000, zuu(A2D(nn_hls),:), zvv(A2D(nn_hls),:), zww(A2D(nn_hls),:), & 
    156             &                                'TRA', Kmm       )   ! add the mle transport (if necessary) 
    157          ! 
    158          ! TEMP: [tiling] This change not necessary if using XIOS (subdomain support) 
    159          IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only on the last tile 
     147            &              CALL ldf_eiv_trp( kt, nit000, zuu, zvv, zww, 'TRA', Kmm, Krhs )   ! add the eiv transport (if necessary) 
     148         ! 
     149         IF( ln_mle    )   CALL tra_mle_trp( kt, nit000, zuu, zvv, zww, 'TRA', Kmm       )   ! add the mle transport (if necessary) 
     150         ! 
     151         ! TEMP: [tiling] This change not necessary after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct 
     152         IF( .NOT. l_istiled .OR. ntile == nijtile )  THEN                ! Do only on the last tile 
    160153            CALL iom_put( "uocetr_eff", zuu )                                        ! output effective transport 
    161154            CALL iom_put( "vocetr_eff", zvv ) 
    … …  
    163156         ENDIF 
    164157         ! 
    165    !!gm ??? 
    166          ! TEMP: [tiling] This change not necessary if using XIOS (subdomain support) 
     158!!gm ??? 
     159         ! TEMP: [tiling] This copy-in not necessary after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct 
    167160         CALL dia_ptr( kt, Kmm, zvv(A2D(nn_hls),:) )                                    ! diagnose the effective MSF 
    168    !!gm ??? 
     161!!gm ??? 
    169162         ! 
    170163 
    … …  
    178171         ! 
    179172         CASE ( np_CEN )                                 ! Centered scheme : 2nd / 4th order 
    180             IF (nn_hls.EQ.2) CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kmm), 'T', 1. ) 
    181173            CALL tra_adv_cen    ( kt, nit000, 'TRA',         zuu, zvv, zww, Kmm, pts, jpts, Krhs, nn_cen_h, nn_cen_v ) 
    182174         CASE ( np_FCT )                                 ! FCT scheme      : 2nd / 4th order 
    183             IF (nn_hls.EQ.2) THEN 
    184                CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1., pts(:,:,:,:,Kmm), 'T', 1.) 
    185                CALL lbc_lnk( 'traadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1., zww(:,:,:), 'W', 1.) 
    186 #if defined key_loop_fusion 
    187                CALL tra_adv_fct_lf ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_fct_h, nn_fct_v ) 
    188 #else 
    189175               CALL tra_adv_fct    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_fct_h, nn_fct_v ) 
    190 #endif 
    191             ELSE 
    192                CALL tra_adv_fct    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_fct_h, nn_fct_v ) 
    193             END IF 
    194176         CASE ( np_MUS )                                 ! MUSCL 
    195             IF (nn_hls.EQ.2) THEN 
    196                 CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1.) 
    197 #if defined key_loop_fusion 
    198                 CALL tra_adv_mus_lf ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, ln_mus_ups ) 
    199 #else 
    200177                CALL tra_adv_mus    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, ln_mus_ups ) 
    201 #endif 
    202             ELSE 
    203                 CALL tra_adv_mus    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, ln_mus_ups ) 
    204             END IF 
    205178         CASE ( np_UBS )                                 ! UBS 
    206             IF (nn_hls.EQ.2) CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1.) 
    207179            CALL tra_adv_ubs    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_ubs_v   ) 
    208180         CASE ( np_QCK )                                 ! QUICKEST 
    209             IF (nn_hls.EQ.2) THEN 
    210                CALL lbc_lnk( 'traadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1.) 
    211                CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1.) 
    212             END IF 
    213181            CALL tra_adv_qck    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs ) 
    214182         ! 
    … …  
    225193         ENDIF 
    226194 
    227          ! TEMP: [tiling] This change not necessary after extra haloes development (lbc_lnk removed from tra_adv_*) and if XIOS has subdomain support (ldf_eiv_dia) 
    228          IF( ln_tile .AND. ntile == 0 ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 1 ) 
    229  
     195         ! TEMP: [tiling] This change not necessary after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct 
     196         IF( ln_tile .AND. .NOT. l_istiled ) CALL dom_tile_start( ldhold=.TRUE. ) 
    230197      ENDIF 
    231198      !                                              ! print mean trends (used for debugging) 
    … …  
    233200         &                                  tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    234201 
    235       ! TEMP: [tiling] This change not necessary if using XIOS (subdomain support) 
    236       IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only for the full domain 
     202      ! TEMP: [tiling] This change not necessary after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct 
     203      IF( .NOT. l_istiled .OR. ntile == nijtile )  THEN                ! Do only for the full domain 
    237204         DEALLOCATE( zuu, zvv, zww ) 
    238205      ENDIF 
    … …  
    306273        CALL ctl_stop( 'tra_adv_init: FCT scheme, choose 2nd or 4th order' ) 
    307274      ENDIF 
     275      ! TEMP: [tiling] This change not necessary after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct 
     276      IF( ln_traadv_fct .AND. ln_tile ) THEN 
     277         CALL ctl_warn( 'tra_adv_init: FCT scheme does not yet work with tiling' ) 
     278      ENDIF 
    308279      IF( ln_traadv_ubs .AND. ( nn_ubs_v /= 2 .AND. nn_ubs_v /= 4 )   ) THEN     ! UBS 
    309280        CALL ctl_stop( 'tra_adv_init: UBS scheme, choose 2nd or 4th order' ) 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/TRA/traadv_cen.F90

    r14789 r14852  
    2323   USE trc_oce        ! share passive tracers/Ocean variables 
    2424   USE lib_mpp        ! MPP library 
     25#if defined key_loop_fusion 
     26   USE traadv_cen_lf  ! centered scheme            (tra_adv_cen  routine - loop fusion version) 
     27#endif 
    2528 
    2629   IMPLICIT NONE 
    … …  
    7174      INTEGER                                  , INTENT(in   ) ::   kn_cen_h        ! =2/4 (2nd or 4th order scheme) 
    7275      INTEGER                                  , INTENT(in   ) ::   kn_cen_v        ! =2/4 (2nd or 4th order scheme) 
    73       ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support) 
     76      ! TEMP: [tiling] This can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct 
    7477      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume flux components 
    7578      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation 
    … …  
    8285      !!---------------------------------------------------------------------- 
    8386      ! 
    84       IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     87#if defined key_loop_fusion 
     88      CALL tra_adv_cen_lf    ( kt, nit000, cdtype, pU, pV, pW, Kmm, pt, kjpt, Krhs, kn_cen_h, kn_cen_v ) 
     89#else 
     90      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
    8591         IF( kt == kit000 )  THEN 
    8692            IF(lwp) WRITE(numout,*) 
    … …  
    119125               ztv(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) 
    120126            END_3D 
    121             IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_cen', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp )   ! Lateral boundary cond. 
     127            IF (nn_hls==1) CALL lbc_lnk( 'traadv_cen', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp, ld4only= .TRUE. )   ! Lateral boundary cond. 
    122128            ! 
    123129            DO_3D( nn_hls-1, 0, nn_hls-1, 0, 1, jpkm1 )           ! Horizontal advective fluxes 
    … …  
    131137               zwy(ji,jj,jk) =  0.5_wp * pV(ji,jj,jk) * zC4t_v 
    132138            END_3D 
    133             IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_cen', zwx, 'U', -1. , zwy, 'V', -1. ) 
     139            IF (nn_hls==1) CALL lbc_lnk( 'traadv_cen', zwx, 'U', -1. , zwy, 'V', -1. ) 
    134140            ! 
    135141         CASE DEFAULT 
    … …  
    184190      END DO 
    185191      ! 
     192#endif 
    186193   END SUBROUTINE tra_adv_cen 
    187194 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/TRA/traadv_fct.F90

    r14789 r14852  
    3434   PUBLIC   tra_adv_fct        ! called by traadv.F90 
    3535   PUBLIC   interp_4th_cpt     ! called by traadv_cen.F90 
    36    PUBLIC   tridia_solver      ! called by traadv_fct_lf.F90 
    37    PUBLIC   nonosc             ! called by traadv_fct_lf.F90 - key_agrif 
    3836 
    3937   LOGICAL  ::   l_trd   ! flag to compute trends 
    … …  
    8179      INTEGER                                  , INTENT(in   ) ::   kn_fct_v        ! order of the FCT scheme (=2 or 4) 
    8280      REAL(wp)                                 , INTENT(in   ) ::   p2dt            ! tracer time-step 
    83       ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support) 
     81      ! TEMP: [tiling] This can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case 
    8482      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume flux components 
    8583      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation 
    … …  
    9593      !!---------------------------------------------------------------------- 
    9694      ! 
    97       IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     95#if defined key_loop_fusion 
     96      CALL tra_adv_fct_lf ( kt, nit000, cdtype, p2dt, pU, pV, pW, Kbb, Kmm, pt, kjpt, Krhs, kn_fct_h, kn_fct_v ) 
     97#else 
     98      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
    9899         IF( kt == kit000 )  THEN 
    99100            IF(lwp) WRITE(numout,*) 
    … …  
    136137      ! If adaptive vertical advection, check if it is needed on this PE at this time 
    137138      IF( ln_zad_Aimp ) THEN 
    138          IF( MAXVAL( ABS( wi(A2D(nn_hls),:) ) ) > 0._wp ) ll_zAimp = .TRUE. 
     139         IF( MAXVAL( ABS( wi(A2D(1),:) ) ) > 0._wp ) ll_zAimp = .TRUE. 
    139140      END IF 
    140141      ! If active adaptive vertical advection, build tridiagonal matrix 
    … …  
    238239               END_2D 
    239240            END DO 
    240             CALL lbc_lnk( 'traadv_fct', zltu, 'T', 1.0_wp , zltv, 'T', 1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
    241             ! 
    242             DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 
     241            ! NOTE [ comm_cleanup ] : need to change sign to ensure halo 1 - halo 2 compatibility 
     242            CALL lbc_lnk( 'traadv_fct', zltu, 'T', -1.0_wp , zltv, 'T', -1.0_wp, ld4only= .TRUE. )   ! Lateral boundary cond. (unchanged sgn) 
     243            ! 
     244            DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) 
    243245               zC2t_u = pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj  ,jk,jn,Kmm)   ! 2 x C2 interpolation of T at u- & v-points 
    244246               zC2t_v = pt(ji,jj,jk,jn,Kmm) + pt(ji  ,jj+1,jk,jn,Kmm) 
    245247               !                                                        ! C4 minus upstream advective fluxes 
    246                zwx(ji,jj,jk) =  0.5_wp * pU(ji,jj,jk) * ( zC2t_u + zltu(ji,jj,jk) - zltu(ji+1,jj,jk) ) - zwx(ji,jj,jk) 
    247                zwy(ji,jj,jk) =  0.5_wp * pV(ji,jj,jk) * ( zC2t_v + zltv(ji,jj,jk) - zltv(ji,jj+1,jk) ) - zwy(ji,jj,jk) 
    248             END_3D 
    249             IF (nn_hls.EQ.2) CALL lbc_lnk( 'traadv_fct', zwx, 'U', -1.0_wp, zwy, 'V', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
     248               ! round brackets added to fix the order of floating point operations 
     249               ! needed to ensure halo 1 - halo 2 compatibility 
     250               zwx(ji,jj,jk) =  0.5_wp * pU(ji,jj,jk) * ( zC2t_u + ( zltu(ji,jj,jk) - zltu(ji+1,jj,jk)   & 
     251                             &                                     )                                     & ! bracket for halo 1 - halo 2 compatibility 
     252                             &                          ) - zwx(ji,jj,jk) 
     253               zwy(ji,jj,jk) =  0.5_wp * pV(ji,jj,jk) * ( zC2t_v + ( zltv(ji,jj,jk) - zltv(ji,jj+1,jk)   & 
     254                             &                                     )                                     & ! bracket for halo 1 - halo 2 compatibility 
     255                             &                          ) - zwy(ji,jj,jk) 
     256            END_3D 
    250257            ! 
    251258         CASE(  41 )                   !- 4th order centered       ==>>   !!gm coding attempt   need to be tested 
    252259            ztu(:,:,jpk) = 0._wp             ! Bottom value : flux set to zero 
    253260            ztv(:,:,jpk) = 0._wp 
    254             DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )    ! 1st derivative (gradient) 
     261            DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )    ! 1st derivative (gradient) 
    255262               ztu(ji,jj,jk) = ( pt(ji+1,jj  ,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * umask(ji,jj,jk) 
    256263               ztv(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) 
    257264            END_3D 
    258             IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_fct', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
     265            IF (nn_hls==1) CALL lbc_lnk( 'traadv_fct', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp, ld4only= .TRUE. )   ! Lateral boundary cond. (unchanged sgn) 
    259266            ! 
    260267            DO_3D( 0, 0, 0, 0, 1, jpkm1 )    ! Horizontal advective fluxes 
    … …  
    268275               zwy(ji,jj,jk) =  0.5_wp * pV(ji,jj,jk) * zC4t_v - zwy(ji,jj,jk) 
    269276            END_3D 
    270             IF (nn_hls.EQ.2) CALL lbc_lnk( 'traadv_fct', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
     277            IF (nn_hls==2) CALL lbc_lnk( 'traadv_fct', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
    271278            ! 
    272279         END SELECT 
    … …  
    291298         ENDIF 
    292299         ! 
    293          IF (nn_hls.EQ.1) THEN 
     300         IF (nn_hls==1) THEN 
    294301            CALL lbc_lnk( 'traadv_fct', zwi, 'T', 1.0_wp, zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp, zwz, 'T', 1.0_wp ) 
    295302         ELSE 
    … …  
    374381      ENDIF 
    375382      ! 
     383#endif 
    376384   END SUBROUTINE tra_adv_fct 
    377385 
    … …  
    449457         END_2D 
    450458      END DO 
    451       IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_fct', zbetup, 'T', 1.0_wp , zbetdo, 'T', 1.0_wp )   ! lateral boundary cond. (unchanged sign) 
     459      IF (nn_hls==1) CALL lbc_lnk( 'traadv_fct', zbetup, 'T', 1.0_wp , zbetdo, 'T', 1.0_wp, ld4only= .TRUE. )   ! lateral boundary cond. (unchanged sign) 
    452460 
    453461      ! 3. monotonic flux in the i & j direction (paa & pbb) 
    … …  
    670678   END SUBROUTINE tridia_solver 
    671679 
     680#if defined key_loop_fusion 
     681#define tracer_flux_i(out,zfp,zfm,ji,jj,jk) \ 
     682        zfp = pU(ji,jj,jk) + ABS( pU(ji,jj,jk) ) ; \ 
     683        zfm = pU(ji,jj,jk) - ABS( pU(ji,jj,jk) ) ; \ 
     684        out = 0.5 * ( zfp * pt(ji,jj,jk,jn,Kbb) + zfm * pt(ji+1,jj,jk,jn,Kbb) ) 
     685 
     686#define tracer_flux_j(out,zfp,zfm,ji,jj,jk) \ 
     687        zfp = pV(ji,jj,jk) + ABS( pV(ji,jj,jk) ) ; \ 
     688        zfm = pV(ji,jj,jk) - ABS( pV(ji,jj,jk) ) ; \ 
     689        out = 0.5 * ( zfp * pt(ji,jj,jk,jn,Kbb) + zfm * pt(ji,jj+1,jk,jn,Kbb) ) 
     690 
     691   SUBROUTINE tra_adv_fct_lf( kt, kit000, cdtype, p2dt, pU, pV, pW,       & 
     692      &                    Kbb, Kmm, pt, kjpt, Krhs, kn_fct_h, kn_fct_v ) 
     693      !!---------------------------------------------------------------------- 
     694      !!                  ***  ROUTINE tra_adv_fct  *** 
     695      !! 
     696      !! **  Purpose :   Compute the now trend due to total advection of tracers 
     697      !!               and add it to the general trend of tracer equations 
     698      !! 
     699      !! **  Method  : - 2nd or 4th FCT scheme on the horizontal direction 
     700      !!               (choice through the value of kn_fct) 
     701      !!               - on the vertical the 4th order is a compact scheme 
     702      !!               - corrected flux (monotonic correction) 
     703      !! 
     704      !! ** Action : - update pt(:,:,:,:,Krhs)  with the now advective tracer trends 
     705      !!             - send trends to trdtra module for further diagnostics (l_trdtra=T) 
     706      !!             - poleward advective heat and salt transport (ln_diaptr=T) 
     707      !!---------------------------------------------------------------------- 
     708      INTEGER                                  , INTENT(in   ) ::   kt              ! ocean time-step index 
     709      INTEGER                                  , INTENT(in   ) ::   Kbb, Kmm, Krhs  ! ocean time level indices 
     710      INTEGER                                  , INTENT(in   ) ::   kit000          ! first time step index 
     711      CHARACTER(len=3)                         , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator) 
     712      INTEGER                                  , INTENT(in   ) ::   kjpt            ! number of tracers 
     713      INTEGER                                  , INTENT(in   ) ::   kn_fct_h        ! order of the FCT scheme (=2 or 4) 
     714      INTEGER                                  , INTENT(in   ) ::   kn_fct_v        ! order of the FCT scheme (=2 or 4) 
     715      REAL(wp)                                 , INTENT(in   ) ::   p2dt            ! tracer time-step 
     716      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume flux components 
     717      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation 
     718      ! 
     719      INTEGER  ::   ji, jj, jk, jn                           ! dummy loop indices 
     720      REAL(wp) ::   ztra                                     ! local scalar 
     721      REAL(wp) ::   zwx_im1, zfp_ui, zfp_ui_m1, zfp_vj, zfp_vj_m1, zfp_wk, zC2t_u, zC4t_u   !   -      - 
     722      REAL(wp) ::   zwy_jm1, zfm_ui, zfm_ui_m1, zfm_vj, zfm_vj_m1, zfm_wk, zC2t_v, zC4t_v   !   -      - 
     723      REAL(wp) ::   ztu, ztv, ztu_im1, ztu_ip1, ztv_jm1, ztv_jp1 
     724      REAL(wp), DIMENSION(jpi,jpj,jpk)        ::   zwi, zwx_3d, zwy_3d, zwz, ztw, zltu_3d, zltv_3d 
     725      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdx, ztrdy, ztrdz, zptry 
     726      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   zwinf, zwdia, zwsup 
     727      LOGICAL  ::   ll_zAimp                                 ! flag to apply adaptive implicit vertical advection 
     728      !!---------------------------------------------------------------------- 
     729      ! 
     730      IF( kt == kit000 )  THEN 
     731         IF(lwp) WRITE(numout,*) 
     732         IF(lwp) WRITE(numout,*) 'tra_adv_fct_lf : FCT advection scheme on ', cdtype 
     733         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
     734      ENDIF 
     735      !! -- init to 0 
     736      zwx_3d(:,:,:) = 0._wp 
     737      zwy_3d(:,:,:) = 0._wp 
     738      zwz(:,:,:) = 0._wp 
     739      zwi(:,:,:) = 0._wp 
     740      ! 
     741      l_trd = .FALSE.            ! set local switches 
     742      l_hst = .FALSE. 
     743      l_ptr = .FALSE. 
     744      ll_zAimp = .FALSE. 
     745      IF( ( cdtype == 'TRA' .AND. l_trdtra  ) .OR. ( cdtype =='TRC' .AND. l_trdtrc ) )      l_trd = .TRUE. 
     746      IF(   cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) ) )    l_ptr = .TRUE. 
     747      IF(   cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR.  & 
     748         &                         iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) )  l_hst = .TRUE. 
     749      ! 
     750      IF( l_trd .OR. l_hst )  THEN 
     751         ALLOCATE( ztrdx(jpi,jpj,jpk), ztrdy(jpi,jpj,jpk), ztrdz(jpi,jpj,jpk) ) 
     752         ztrdx(:,:,:) = 0._wp   ;    ztrdy(:,:,:) = 0._wp   ;   ztrdz(:,:,:) = 0._wp 
     753      ENDIF 
     754      ! 
     755      IF( l_ptr ) THEN 
     756         ALLOCATE( zptry(jpi,jpj,jpk) ) 
     757         zptry(:,:,:) = 0._wp 
     758      ENDIF 
     759      ! 
     760      ! If adaptive vertical advection, check if it is needed on this PE at this time 
     761      IF( ln_zad_Aimp ) THEN 
     762         IF( MAXVAL( ABS( wi(:,:,:) ) ) > 0._wp ) ll_zAimp = .TRUE. 
     763      END IF 
     764      ! If active adaptive vertical advection, build tridiagonal matrix 
     765      IF( ll_zAimp ) THEN 
     766         ALLOCATE(zwdia(jpi,jpj,jpk), zwinf(jpi,jpj,jpk),zwsup(jpi,jpj,jpk)) 
     767         DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     768            zwdia(ji,jj,jk) =  1._wp + p2dt * ( MAX( wi(ji,jj,jk) , 0._wp ) - MIN( wi(ji,jj,jk+1) , 0._wp ) )   & 
     769            &                               / e3t(ji,jj,jk,Krhs) 
     770            zwinf(ji,jj,jk) =  p2dt * MIN( wi(ji,jj,jk  ) , 0._wp ) / e3t(ji,jj,jk,Krhs) 
     771            zwsup(ji,jj,jk) = -p2dt * MAX( wi(ji,jj,jk+1) , 0._wp ) / e3t(ji,jj,jk,Krhs) 
     772         END_3D 
     773      END IF 
     774      ! 
     775      DO jn = 1, kjpt            !==  loop over the tracers  ==! 
     776         ! 
     777         !        !==  upstream advection with initial mass fluxes & intermediate update  ==! 
     778         !                               !* upstream tracer flux in the k direction *! 
     779         DO_3D( 1, 1, 1, 1, 2, jpkm1 )      ! Interior value ( multiplied by wmask) 
     780            zfp_wk = pW(ji,jj,jk) + ABS( pW(ji,jj,jk) ) 
     781            zfm_wk = pW(ji,jj,jk) - ABS( pW(ji,jj,jk) ) 
     782            zwz(ji,jj,jk) = 0.5 * ( zfp_wk * pt(ji,jj,jk,jn,Kbb) + zfm_wk * pt(ji,jj,jk-1,jn,Kbb) ) * wmask(ji,jj,jk) 
     783         END_3D 
     784         IF( ln_linssh ) THEN               ! top ocean value (only in linear free surface as zwz has been w-masked) 
     785            IF( ln_isfcav ) THEN                        ! top of the ice-shelf cavities and at the ocean surface 
     786               DO_2D( 1, 1, 1, 1 ) 
     787                  zwz(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kbb)   ! linear free surface 
     788               END_2D 
     789            ELSE                                        ! no cavities: only at the ocean surface 
     790               DO_2D( 1, 1, 1, 1 ) 
     791                  zwz(ji,jj,1) = pW(ji,jj,1) * pt(ji,jj,1,jn,Kbb) 
     792               END_2D 
     793            ENDIF 
     794         ENDIF 
     795         ! 
     796         !                    !* upstream tracer flux in the i and j direction 
     797         DO jk = 1, jpkm1 
     798            DO jj = 1, jpj-1 
     799               tracer_flux_i(zwx_3d(1,jj,jk),zfp_ui,zfm_ui,1,jj,jk) 
     800               tracer_flux_j(zwy_3d(1,jj,jk),zfp_vj,zfm_vj,1,jj,jk) 
     801            END DO 
     802            DO ji = 1, jpi-1 
     803               tracer_flux_i(zwx_3d(ji,1,jk),zfp_ui,zfm_ui,ji,1,jk) 
     804               tracer_flux_j(zwy_3d(ji,1,jk),zfp_vj,zfm_vj,ji,1,jk) 
     805            END DO 
     806            DO_2D( 1, 1, 1, 1 ) 
     807               tracer_flux_i(zwx_3d(ji,jj,jk),zfp_ui,zfm_ui,ji,jj,jk) 
     808               tracer_flux_i(zwx_im1,zfp_ui_m1,zfm_ui_m1,ji-1,jj,jk) 
     809               tracer_flux_j(zwy_3d(ji,jj,jk),zfp_vj,zfm_vj,ji,jj,jk) 
     810               tracer_flux_j(zwy_jm1,zfp_vj_m1,zfm_vj_m1,ji,jj-1,jk) 
     811               ztra = - ( zwx_3d(ji,jj,jk) - zwx_im1 + zwy_3d(ji,jj,jk) - zwy_jm1 + zwz(ji,jj,jk) - zwz(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) 
     812               !                               ! update and guess with monotonic sheme 
     813               pt(ji,jj,jk,jn,Krhs) =                   pt(ji,jj,jk,jn,Krhs) +       ztra   & 
     814                  &                                  / e3t(ji,jj,jk,Kmm ) * tmask(ji,jj,jk) 
     815               zwi(ji,jj,jk)    = ( e3t(ji,jj,jk,Kbb) * pt(ji,jj,jk,jn,Kbb) + p2dt * ztra ) & 
     816                  &                                  / e3t(ji,jj,jk,Krhs) * tmask(ji,jj,jk) 
     817            END_2D 
     818         END DO 
     819 
     820         IF ( ll_zAimp ) THEN 
     821            CALL tridia_solver( zwdia, zwsup, zwinf, zwi, zwi , 0 ) 
     822            ! 
     823            ztw(:,:,1) = 0._wp ; ztw(:,:,jpk) = 0._wp ; 
     824            DO_3D( 1, 1, 1, 1, 2, jpkm1 )       ! Interior value ( multiplied by wmask) 
     825               zfp_wk = wi(ji,jj,jk) + ABS( wi(ji,jj,jk) ) 
     826               zfm_wk = wi(ji,jj,jk) - ABS( wi(ji,jj,jk) ) 
     827               ztw(ji,jj,jk) =  0.5 * e1e2t(ji,jj) * ( zfp_wk * zwi(ji,jj,jk) + zfm_wk * zwi(ji,jj,jk-1) ) * wmask(ji,jj,jk) 
     828               zwz(ji,jj,jk) = zwz(ji,jj,jk) + ztw(ji,jj,jk) ! update vertical fluxes 
     829            END_3D 
     830            DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     831               pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( ztw(ji,jj,jk) - ztw(ji  ,jj  ,jk+1) ) & 
     832                  &                                        * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 
     833            END_3D 
     834            ! 
     835         END IF 
     836         ! 
     837         IF( l_trd .OR. l_hst )  THEN             ! trend diagnostics (contribution of upstream fluxes) 
     838            ztrdx(:,:,:) = zwx_3d(:,:,:)   ;   ztrdy(:,:,:) = zwy_3d(:,:,:)   ;   ztrdz(:,:,:) = zwz(:,:,:) 
     839         END IF 
     840         !                             ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
     841         IF( l_ptr )   zptry(:,:,:) = zwy_3d(:,:,:) 
     842         ! 
     843         !        !==  anti-diffusive flux : high order minus low order  ==! 
     844         ! 
     845         SELECT CASE( kn_fct_h )    !* horizontal anti-diffusive fluxes 
     846         ! 
     847         CASE(  2  )                   !- 2nd order centered 
     848            DO_3D( 2, 1, 2, 1, 1, jpkm1 ) 
     849               zwx_3d(ji,jj,jk) = 0.5_wp * pU(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj,jk,jn,Kmm) ) - zwx_3d(ji,jj,jk) 
     850               zwy_3d(ji,jj,jk) = 0.5_wp * pV(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj+1,jk,jn,Kmm) ) - zwy_3d(ji,jj,jk) 
     851            END_3D 
     852            ! 
     853         CASE(  4  )                   !- 4th order centered 
     854            zltu_3d(:,:,jpk) = 0._wp            ! Bottom value : flux set to zero 
     855            zltv_3d(:,:,jpk) = 0._wp 
     856            !                          ! Laplacian 
     857            DO_3D( 0, 0, 0, 0, 1, jpkm1 )                 ! 2nd derivative * 1/ 6 
     858                  !             ! 1st derivative (gradient) 
     859                  ztu = ( pt(ji+1,jj,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * umask(ji,jj,jk) 
     860                  ztu_im1 = ( pt(ji,jj,jk,jn,Kmm) - pt(ji-1,jj,jk,jn,Kmm) ) * umask(ji-1,jj,jk) 
     861                  ztv = ( pt(ji,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) 
     862                  ztv_jm1 = ( pt(ji,jj,jk,jn,Kmm) - pt(ji,jj-1,jk,jn,Kmm) ) * vmask(ji,jj-1,jk) 
     863                  !             ! 2nd derivative * 1/ 6 
     864                  zltu_3d(ji,jj,jk) = (  ztu + ztu_im1  ) * r1_6 
     865                  zltv_3d(ji,jj,jk) = (  ztv + ztv_jm1  ) * r1_6 
     866               END_2D 
     867            END DO 
     868            ! NOTE [ comm_cleanup ] : need to change sign to ensure halo 1 - halo 2 compatibility 
     869            CALL lbc_lnk( 'traadv_fct', zltu_3d, 'T', -1.0_wp , zltv_3d, 'T', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
     870            ! 
     871            DO_3D( 2, 1, 2, 1, 1, jpkm1 ) 
     872               zC2t_u = pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj  ,jk,jn,Kmm)   ! 2 x C2 interpolation of T at u- & v-points 
     873               zC2t_v = pt(ji,jj,jk,jn,Kmm) + pt(ji  ,jj+1,jk,jn,Kmm) 
     874               !                                                        ! C4 minus upstream advective fluxes 
     875               ! round brackets added to fix the order of floating point operations 
     876               ! needed to ensure halo 1 - halo 2 compatibility 
     877               zwx_3d(ji,jj,jk) =  0.5_wp * pU(ji,jj,jk) * ( zC2t_u + ( zltu_3d(ji,jj,jk) - zltu_3d(ji+1,jj,jk)   & 
     878                             &                                        )                                           & ! bracket for halo 1 - halo 2 compatibility 
     879                             &                             ) - zwx_3d(ji,jj,jk) 
     880               zwy_3d(ji,jj,jk) =  0.5_wp * pV(ji,jj,jk) * ( zC2t_v + ( zltv_3d(ji,jj,jk) - zltv_3d(ji,jj+1,jk)   & 
     881                             &                                        )                                           & ! bracket for halo 1 - halo 2 compatibility 
     882                             &                             ) - zwy_3d(ji,jj,jk) 
     883            END_3D 
     884            ! 
     885         CASE(  41 )                   !- 4th order centered       ==>>   !!gm coding attempt   need to be tested 
     886            DO_3D( 0, 0, 0, 0, 1, jpkm1 )    ! Horizontal advective fluxes 
     887               ztu_im1 = ( pt(ji  ,jj  ,jk,jn,Kmm) - pt(ji-1,jj,jk,jn,Kmm) ) * umask(ji-1,jj,jk) 
     888               ztu_ip1 = ( pt(ji+2,jj  ,jk,jn,Kmm) - pt(ji+1,jj,jk,jn,Kmm) ) * umask(ji+1,jj,jk) 
     889 
     890               ztv_jm1 = ( pt(ji,jj  ,jk,jn,Kmm) - pt(ji,jj-1,jk,jn,Kmm) ) * vmask(ji,jj-1,jk) 
     891               ztv_jp1 = ( pt(ji,jj+2,jk,jn,Kmm) - pt(ji,jj+1,jk,jn,Kmm) ) * vmask(ji,jj+1,jk) 
     892               zC2t_u = pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj  ,jk,jn,Kmm)   ! 2 x C2 interpolation of T at u- & v-points (x2) 
     893               zC2t_v = pt(ji,jj,jk,jn,Kmm) + pt(ji  ,jj+1,jk,jn,Kmm) 
     894               !                                                  ! C4 interpolation of T at u- & v-points (x2) 
     895               zC4t_u =  zC2t_u + r1_6 * ( ztu_im1 - ztu_ip1 ) 
     896               zC4t_v =  zC2t_v + r1_6 * ( ztv_jm1 - ztv_jp1 ) 
     897               !                                                  ! C4 minus upstream advective fluxes 
     898               zwx_3d(ji,jj,jk) =  0.5_wp * pU(ji,jj,jk) * zC4t_u - zwx_3d(ji,jj,jk) 
     899               zwy_3d(ji,jj,jk) =  0.5_wp * pV(ji,jj,jk) * zC4t_v - zwy_3d(ji,jj,jk) 
     900            END_3D 
     901            CALL lbc_lnk( 'traadv_fct', zwx_3d, 'U', -1.0_wp , zwy_3d, 'V', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
     902            ! 
     903         END SELECT 
     904         ! 
     905         SELECT CASE( kn_fct_v )    !* vertical anti-diffusive fluxes (w-masked interior values) 
     906         ! 
     907         CASE(  2  )                   !- 2nd order centered 
     908            DO_3D( 1, 1, 1, 1, 2, jpkm1 ) 
     909               zwz(ji,jj,jk) =  (  pW(ji,jj,jk) * 0.5_wp * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj,jk-1,jn,Kmm) )   & 
     910                  &              - zwz(ji,jj,jk)  ) * wmask(ji,jj,jk) 
     911            END_3D 
     912            ! 
     913         CASE(  4  )                   !- 4th order COMPACT 
     914            CALL interp_4th_cpt( pt(:,:,:,jn,Kmm) , ztw )   ! zwt = COMPACT interpolation of T at w-point 
     915            DO_3D( 1, 1, 1, 1, 2, jpkm1 ) 
     916               zwz(ji,jj,jk) = ( pW(ji,jj,jk) * ztw(ji,jj,jk) - zwz(ji,jj,jk) ) * wmask(ji,jj,jk) 
     917            END_3D 
     918            ! 
     919         END SELECT 
     920         IF( ln_linssh ) THEN    ! top ocean value: high order = upstream  ==>>  zwz=0 
     921            zwz(:,:,1) = 0._wp   ! only ocean surface as interior zwz values have been w-masked 
     922         ENDIF 
     923         ! 
     924         CALL lbc_lnk( 'traadv_fct', zwi, 'T', 1.0_wp) 
     925         ! 
     926         IF ( ll_zAimp ) THEN 
     927            DO_3D( 1, 1, 1, 1, 1, jpkm1 )    !* trend and after field with monotonic scheme 
     928               !                                                ! total intermediate advective trends 
     929               ztra = - (  zwx_3d(ji,jj,jk) - zwx_3d(ji-1,jj  ,jk  )   & 
     930                  &      + zwy_3d(ji,jj,jk) - zwy_3d(ji  ,jj-1,jk  )   & 
     931                  &      + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) * r1_e1e2t(ji,jj) 
     932               ztw(ji,jj,jk) = zwi(ji,jj,jk) + p2dt * ztra / e3t(ji,jj,jk,Krhs) * tmask(ji,jj,jk) 
     933            END_3D 
     934            ! 
     935            CALL tridia_solver( zwdia, zwsup, zwinf, ztw, ztw , 0 ) 
     936            ! 
     937            DO_3D( 1, 1, 1, 1, 2, jpkm1 )       ! Interior value ( multiplied by wmask) 
     938               zfp_wk = wi(ji,jj,jk) + ABS( wi(ji,jj,jk) ) 
     939               zfm_wk = wi(ji,jj,jk) - ABS( wi(ji,jj,jk) ) 
     940               zwz(ji,jj,jk) = zwz(ji,jj,jk) + 0.5 * e1e2t(ji,jj) * ( zfp_wk * ztw(ji,jj,jk) + zfm_wk * ztw(ji,jj,jk-1) ) * wmask(ji,jj,jk) 
     941            END_3D 
     942         END IF 
     943         ! 
     944         !        !==  monotonicity algorithm  ==! 
     945         ! 
     946         CALL nonosc( Kmm, pt(:,:,:,jn,Kbb), zwx_3d, zwy_3d, zwz, zwi, p2dt ) 
     947         ! 
     948         !        !==  final trend with corrected fluxes  ==! 
     949         ! 
     950         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     951            ztra = - (  zwx_3d(ji,jj,jk) - zwx_3d(ji-1,jj  ,jk  )   & 
     952               &      + zwy_3d(ji,jj,jk) - zwy_3d(ji  ,jj-1,jk  )   & 
     953               &      + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) * r1_e1e2t(ji,jj) 
     954            pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) + ztra / e3t(ji,jj,jk,Kmm) 
     955            zwi(ji,jj,jk) = zwi(ji,jj,jk) + p2dt * ztra / e3t(ji,jj,jk,Krhs) * tmask(ji,jj,jk) 
     956         END_3D 
     957         ! 
     958         IF ( ll_zAimp ) THEN 
     959            ! 
     960            ztw(:,:,1) = 0._wp ; ztw(:,:,jpk) = 0._wp 
     961            DO_3D( 0, 0, 0, 0, 2, jpkm1 )      ! Interior value ( multiplied by wmask) 
     962               zfp_wk = wi(ji,jj,jk) + ABS( wi(ji,jj,jk) ) 
     963               zfm_wk = wi(ji,jj,jk) - ABS( wi(ji,jj,jk) ) 
     964               ztw(ji,jj,jk) = - 0.5 * e1e2t(ji,jj) * ( zfp_wk * zwi(ji,jj,jk) + zfm_wk * zwi(ji,jj,jk-1) ) * wmask(ji,jj,jk) 
     965               zwz(ji,jj,jk) = zwz(ji,jj,jk) + ztw(ji,jj,jk) ! Update vertical fluxes for trend diagnostic 
     966            END_3D 
     967            DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     968               pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( ztw(ji,jj,jk) - ztw(ji  ,jj  ,jk+1) ) & 
     969                  &                                        * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 
     970            END_3D 
     971         END IF 
     972         ! NOT TESTED - NEED l_trd OR l_hst TRUE 
     973         IF( l_trd .OR. l_hst ) THEN   ! trend diagnostics // heat/salt transport 
     974            ztrdx(:,:,:) = ztrdx(:,:,:) + zwx_3d(:,:,:)  ! <<< add anti-diffusive fluxes 
     975            ztrdy(:,:,:) = ztrdy(:,:,:) + zwy_3d(:,:,:)  !     to upstream fluxes 
     976            ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:)  ! 
     977            ! 
     978            IF( l_trd ) THEN              ! trend diagnostics 
     979               CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, ztrdx, pU, pt(:,:,:,jn,Kmm) ) 
     980               CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, ztrdy, pV, pt(:,:,:,jn,Kmm) ) 
     981               CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, ztrdz, pW, pt(:,:,:,jn,Kmm) ) 
     982            ENDIF 
     983            !                             ! heat/salt transport 
     984            IF( l_hst )   CALL dia_ar5_hst( jn, 'adv', ztrdx(:,:,:), ztrdy(:,:,:) ) 
     985            ! 
     986         ENDIF 
     987         ! NOT TESTED - NEED l_ptr TRUE 
     988         IF( l_ptr ) THEN              ! "Poleward" transports 
     989            zptry(:,:,:) = zptry(:,:,:) + zwy_3d(:,:,:)  ! <<< add anti-diffusive fluxes 
     990            CALL dia_ptr_hst( jn, 'adv', zptry(:,:,:) ) 
     991         ENDIF 
     992         ! 
     993      END DO                     ! end of tracer loop 
     994      ! 
     995      IF ( ll_zAimp ) THEN 
     996         DEALLOCATE( zwdia, zwinf, zwsup ) 
     997      ENDIF 
     998      IF( l_trd .OR. l_hst ) THEN 
     999         DEALLOCATE( ztrdx, ztrdy, ztrdz ) 
     1000      ENDIF 
     1001      IF( l_ptr ) THEN 
     1002         DEALLOCATE( zptry ) 
     1003      ENDIF 
     1004      ! 
     1005   END SUBROUTINE tra_adv_fct_lf 
     1006#endif 
    6721007   !!====================================================================== 
    6731008END MODULE traadv_fct 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/TRA/traadv_mus.F90

    r14789 r14852  
    8181      LOGICAL                                  , INTENT(in   ) ::   ld_msc_ups      ! use upstream scheme within muscl 
    8282      REAL(wp)                                 , INTENT(in   ) ::   p2dt            ! tracer time-step 
    83       ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support) 
     83      ! TEMP: [tiling] This can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct 
    8484      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume flux components 
    8585      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation 
    … …  
    9393      !!---------------------------------------------------------------------- 
    9494      ! 
    95       IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     95      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
    9696         IF( kt == kit000 )  THEN 
    9797            IF(lwp) WRITE(numout,*) 
    … …  
    139139            zwy(ji,jj,jk) = vmask(ji,jj,jk) * ( pt(ji,jj+1,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) ) 
    140140         END_3D 
    141          ! lateral boundary conditions   (changed sign) 
    142          IF ( nn_hls.EQ.1 ) CALL lbc_lnk( 'traadv_mus', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp ) 
    143141         !                                !-- Slopes of tracer 
    144142         zslpx(:,:,jpk) = 0._wp                 ! bottom values 
    145143         zslpy(:,:,jpk) = 0._wp 
    146          DO_3D( nn_hls-1, 1, nn_hls-1, 1, 1, jpkm1 ) 
     144         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
    147145            zslpx(ji,jj,jk) =                       ( zwx(ji,jj,jk) + zwx(ji-1,jj  ,jk) )   & 
    148146               &            * ( 0.25 + SIGN( 0.25_wp, zwx(ji,jj,jk) * zwx(ji-1,jj  ,jk) ) ) 
    … …  
    151149         END_3D 
    152150         ! 
    153          DO_3D( nn_hls-1, 1, nn_hls-1, 1, 1, jpkm1 )    !-- Slopes limitation 
     151         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )    !-- Slopes limitation 
    154152            zslpx(ji,jj,jk) = SIGN( 1.0_wp, zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji  ,jj,jk) ),   & 
    155153               &                                                     2.*ABS( zwx  (ji-1,jj,jk) ),   & 
    … …  
    159157               &                                                     2.*ABS( zwy  (ji,jj  ,jk) ) ) 
    160158         END_3D 
    161          ! 
    162          DO_3D( nn_hls-1, 0, nn_hls-1, 0, 1, jpkm1 )    !-- MUSCL horizontal advective fluxes 
     159         ! NOTE [ comm_cleanup ] : need to change sign to ensure halo 1 - halo 2 compatibility 
     160         IF ( nn_hls==1 ) CALL lbc_lnk( 'traadv_mus', zslpx, 'T', -1.0_wp , zslpy, 'T', -1.0_wp )   ! lateral boundary conditions   (changed sign) 
     161         ! 
     162         DO_3D( 1, 0, 1, 0, 1, jpkm1 )    !-- MUSCL horizontal advective fluxes 
    163163            ! MUSCL fluxes 
    164164            z0u = SIGN( 0.5_wp, pU(ji,jj,jk) ) 
    … …  
    176176            zwy(ji,jj,jk) = pV(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 
    177177         END_3D 
    178          IF ( nn_hls.EQ.1 ) CALL lbc_lnk( 'traadv_mus', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp )   ! lateral boundary conditions   (changed sign) 
    179178         ! 
    180179         DO_3D( 0, 0, 0, 0, 1, jpkm1 )    !-- Tracer advective trend 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/TRA/traadv_qck.F90

    r14789 r14852  
    2727   USE lbclnk          ! ocean lateral boundary condition (or mpp link) 
    2828   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
     29#if defined key_loop_fusion 
     30   USE traadv_qck_lf   ! QCK    scheme            (tra_adv_qck  routine - loop fusion version) 
     31#endif 
    2932 
    3033   IMPLICIT NONE 
    … …  
    9194      INTEGER                                  , INTENT(in   ) ::   kjpt            ! number of tracers 
    9295      REAL(wp)                                 , INTENT(in   ) ::   p2dt            ! tracer time-step 
    93       ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support) 
     96      ! TEMP: [tiling] This can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct 
    9497      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume transport components 
    9598      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation 
    9699      !!---------------------------------------------------------------------- 
    97100      ! 
    98       IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     101#if defined key_loop_fusion 
     102      CALL tra_adv_qck_lf ( kt, kit000, cdtype, p2dt, pU, pV, pW, Kbb, Kmm, pt, kjpt, Krhs ) 
     103#else 
     104      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
    99105         IF( kt == kit000 )  THEN 
    100106            IF(lwp) WRITE(numout,*) 
    … …  
    117123      CALL tra_adv_cen2_k( kt, cdtype, pW, Kmm, pt, kjpt, Krhs ) 
    118124      ! 
     125#endif 
    119126   END SUBROUTINE tra_adv_qck 
    120127 
    … …  
    129136      INTEGER                                  , INTENT(in   ) ::   kjpt       ! number of tracers 
    130137      REAL(wp)                                 , INTENT(in   ) ::   p2dt       ! tracer time-step 
    131       ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support) 
     138      ! TEMP: [tiling] This can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct 
    132139      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU        ! i-velocity components 
    133140      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! active tracers and RHS of tracer equation 
    … …  
    149156            zfd(ji,jj,jk) = pt(ji+1,jj,jk,jn,Kbb)        ! Downstream in the x-direction for the tracer 
    150157         END_3D 
    151          IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp )   ! Lateral boundary conditions 
     158         IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, ld4only= .TRUE. )   ! Lateral boundary conditions 
    152159 
    153160         ! 
    … …  
    167174         END_3D 
    168175         !--- Lateral boundary conditions 
    169          IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, zfc(:,:,:), 'T', 1.0_wp,  zwx(:,:,:), 'T', 1.0_wp ) 
     176         IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, zfc(:,:,:), 'T', 1.0_wp,  zwx(:,:,:), 'T', 1.0_wp ) 
    170177 
    171178         !--- QUICKEST scheme 
    … …  
    176183            zfu(ji,jj,jk) = tmask(ji-1,jj,jk) + tmask(ji,jj,jk) + tmask(ji+1,jj,jk) - 2. 
    177184         END_3D 
    178          IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp )      ! Lateral boundary conditions 
     185         IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp, ld4only= .TRUE. )      ! Lateral boundary conditions 
    179186 
    180187         ! 
    … …  
    214221      INTEGER                                  , INTENT(in   ) ::   kjpt       ! number of tracers 
    215222      REAL(wp)                                 , INTENT(in   ) ::   p2dt       ! tracer time-step 
    216       ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support) 
     223      ! TEMP: [tiling] This can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct 
    217224      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pV        ! j-velocity components 
    218225      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! active tracers and RHS of tracer equation 
    … …  
    229236         zfd(:,:,:) = 0.0     ;   zwy(:,:,:) = 0.0 
    230237         ! 
    231          DO jk = 1, jpkm1 
    232             ! 
    233             !--- Computation of the ustream and downstream value of the tracer and the mask 
    234             DO_2D( 0, 0, nn_hls-1, nn_hls-1 ) 
    235                ! Upstream in the x-direction for the tracer 
    236                zfc(ji,jj,jk) = pt(ji,jj-1,jk,jn,Kbb) 
    237                ! Downstream in the x-direction for the tracer 
    238                zfd(ji,jj,jk) = pt(ji,jj+1,jk,jn,Kbb) 
    239             END_2D 
    240          END DO 
    241          IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp )   ! Lateral boundary conditions 
     238         !--- Computation of the ustream and downstream value of the tracer and the mask 
     239         DO_3D( 0, 0, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
     240            ! Upstream in the x-direction for the tracer 
     241            zfc(ji,jj,jk) = pt(ji,jj-1,jk,jn,Kbb) 
     242            ! Downstream in the x-direction for the tracer 
     243            zfd(ji,jj,jk) = pt(ji,jj+1,jk,jn,Kbb) 
     244         END_3D 
     245 
     246         IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, ld4only= .TRUE. )   ! Lateral boundary conditions 
    242247 
    243248         ! 
    … …  
    259264 
    260265         !--- Lateral boundary conditions 
    261          IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, zfc(:,:,:), 'T', 1.0_wp, zwy(:,:,:), 'T', 1.0_wp ) 
     266         IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, zfc(:,:,:), 'T', 1.0_wp, zwy(:,:,:), 'T', 1.0_wp ) 
    262267 
    263268         !--- QUICKEST scheme 
    … …  
    268273            zfu(ji,jj,jk) = tmask(ji,jj-1,jk) + tmask(ji,jj,jk) + tmask(ji,jj+1,jk) - 2. 
    269274         END_3D 
    270          IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp )    !--- Lateral boundary conditions 
     275         IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp, ld4only= .TRUE. )    !--- Lateral boundary conditions 
    271276         ! 
    272277         ! Tracer flux on the x-direction 
    … …  
    306311      CHARACTER(len=3)                         , INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator) 
    307312      INTEGER                                  , INTENT(in   ) ::   kjpt     ! number of tracers 
    308       ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support) 
     313      ! TEMP: [tiling] This can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct 
    309314      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pW      ! vertical velocity 
    310315      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! active tracers and RHS of tracer equation 
    … …  
    365370      !---------------------------------------------------------------------- 
    366371      ! 
    367       DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
     372      DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 
    368373         zc     = puc(ji,jj,jk)                         ! Courant number 
    369374         zcurv  = pfd(ji,jj,jk) + pfu(ji,jj,jk) - 2. * pfc(ji,jj,jk) 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/TRA/traadv_ubs.F90

    r14789 r14852  
    2626   USE lbclnk         ! ocean lateral boundary condition (or mpp link) 
    2727   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
     28#if defined key_loop_fusion 
     29   USE traadv_ubs_lf  ! UBS      scheme            (tra_adv_ubs  routine - loop fusion version) 
     30#endif 
    2831 
    2932   IMPLICIT NONE 
    … …  
    9295      INTEGER                                  , INTENT(in   ) ::   kn_ubs_v        ! number of tracers 
    9396      REAL(wp)                                 , INTENT(in   ) ::   p2dt            ! tracer time-step 
    94       ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support) 
     97      ! TEMP: [tiling] This can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct 
    9598      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume transport components 
    9699      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation 
    … …  
    103106      !!---------------------------------------------------------------------- 
    104107      ! 
    105       IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     108#if defined key_loop_fusion 
     109      CALL tra_adv_ubs_lf    ( kt, kit000, cdtype, p2dt, pU, pV, pW, Kbb, Kmm, pt, kjpt, Krhs, kn_ubs_v ) 
     110#else 
     111      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
    106112         IF( kt == kit000 )  THEN 
    107113            IF(lwp) WRITE(numout,*) 
    … …  
    140146            ! 
    141147         END DO 
    142          IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_ubs', zltu, 'T', 1.0_wp, zltv, 'T', 1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
     148         IF (nn_hls==1) CALL lbc_lnk( 'traadv_ubs', zltu, 'T', 1.0_wp, zltv, 'T', 1.0_wp, ld4only= .TRUE. )   ! Lateral boundary cond. (unchanged sgn) 
    143149         ! 
    144150         DO_3D( 1, 0, 1, 0, 1, jpkm1 )   !==  Horizontal advective fluxes  ==!     (UBS) 
    … …  
    260266      END DO 
    261267      ! 
     268#endif 
    262269   END SUBROUTINE tra_adv_ubs 
    263270 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/TRA/trabbc.F90

    r14789 r14852  
    102102      ENDIF 
    103103      ! 
    104       IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only for the full domain 
    105          CALL iom_put ( "hfgeou" , rho0_rcp * qgh_trd0(:,:) ) 
    106       ENDIF 
     104      CALL iom_put ( "hfgeou" , rho0_rcp * qgh_trd0(:,:) ) 
     105 
    107106      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' bbc  - Ta: ', mask1=tmask, clinfo3='tra-ta' ) 
    108107      ! 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/TRA/trabbl.F90

    r14789 r14852  
    126126         CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' bbl_ldf  - Ta: ', mask1=tmask, & 
    127127            &          tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    128          IF( ntile == 0 .OR. ntile == nijtile ) THEN                       ! Do only on the last tile 
    129             CALL iom_put( "ahu_bbl", ahu_bbl )   ! bbl diffusive flux i-coef 
    130             CALL iom_put( "ahv_bbl", ahv_bbl )   ! bbl diffusive flux j-coef 
    131          ENDIF 
     128         CALL iom_put( "ahu_bbl", ahu_bbl )   ! bbl diffusive flux i-coef 
     129         CALL iom_put( "ahv_bbl", ahv_bbl )   ! bbl diffusive flux j-coef 
    132130         ! 
    133131      ENDIF 
    … …  
    139137         CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' bbl_adv  - Ta: ', mask1=tmask, & 
    140138            &          tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    141          IF( ntile == 0 .OR. ntile == nijtile ) THEN                       ! Do only on the last tile 
    142             ! lateral boundary conditions ; just need for outputs 
    143             CALL lbc_lnk( 'trabbl', utr_bbl, 'U', 1.0_wp , vtr_bbl, 'V', 1.0_wp ) 
    144             CALL iom_put( "uoce_bbl", utr_bbl )  ! bbl i-transport 
    145             CALL iom_put( "voce_bbl", vtr_bbl )  ! bbl j-transport 
    146          ENDIF 
     139         CALL iom_put( "uoce_bbl", utr_bbl )  ! bbl i-transport 
     140         CALL iom_put( "voce_bbl", vtr_bbl )  ! bbl j-transport 
    147141         ! 
    148142      ENDIF 
    … …  
    215209 
    216210 
     211   ! NOTE: [tiling] tiling changes the results, but only the order of floating point operations is different 
    217212   SUBROUTINE tra_bbl_adv( pt, pt_rhs, kjpt, Kmm ) 
    218213      !!---------------------------------------------------------------------- 
    … …  
    238233      INTEGER  ::   iis , iid , ijs , ijd    ! local integers 
    239234      INTEGER  ::   ikus, ikud, ikvs, ikvd   !   -       - 
    240       INTEGER  ::   isi, isj                 !   -       - 
    241235      REAL(wp) ::   zbtr, ztra               ! local scalars 
    242236      REAL(wp) ::   zu_bbl, zv_bbl           !   -      - 
    243237      !!---------------------------------------------------------------------- 
    244       ! 
    245       IF( ntsi == Nis0 ) THEN ; isi = 1 ; ELSE ; isi = 0 ; ENDIF    ! Avoid double-counting when using tiling 
    246       IF( ntsj == Njs0 ) THEN ; isj = 1 ; ELSE ; isj = 0 ; ENDIF 
    247238      !                                                          ! =========== 
    248239      DO jn = 1, kjpt                                            ! tracer loop 
    249240         !                                                       ! =========== 
    250          DO_2D( isi, 0, isj, 0 )            ! CAUTION start from i=1 to update i=2 when cyclic east-west 
     241         DO_2D_OVR( 1, 0, 1, 0 )            ! CAUTION start from i=1 to update i=2 when cyclic east-west 
    251242            IF( utr_bbl(ji,jj) /= 0.e0 ) THEN            ! non-zero i-direction bbl advection 
    252243               ! down-slope i/k-indices (deep)      &   up-slope i/k indices (shelf) 
    … …  
    340331      !!---------------------------------------------------------------------- 
    341332      ! 
    342       IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     333      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
    343334         IF( kt == kit000 )  THEN 
    344335            IF(lwp)  WRITE(numout,*) 
    … …  
    363354      IF( nn_bbl_ldf == 1 ) THEN          !   diffusive bbl   ! 
    364355         !                                !-------------------! 
    365          DO_2D( 1, 0, 1, 0 )                   ! (criteria for non zero flux: grad(rho).grad(h) < 0 ) 
     356         DO_2D_OVR( 1, 0, 1, 0 )                   ! (criteria for non zero flux: grad(rho).grad(h) < 0 ) 
    366357            !                                                   ! i-direction 
    367358            za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem)              ! 2*(alpha,beta) at u-point 
    … …  
    393384         ! 
    394385         CASE( 1 )                                   != use of upper velocity 
    395             DO_2D( 1, 0, 1, 0 )                              ! criteria: grad(rho).grad(h)<0  and grad(rho).grad(h)<0 
     386            DO_2D_OVR( 1, 0, 1, 0 )                              ! criteria: grad(rho).grad(h)<0  and grad(rho).grad(h)<0 
    396387               !                                                  ! i-direction 
    397388               za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem)               ! 2*(alpha,beta) at u-point 
    … …  
    422413         CASE( 2 )                                 != bbl velocity = F( delta rho ) 
    423414            zgbbl = grav * rn_gambbl 
    424             DO_2D( 1, 0, 1, 0 )                         ! criteria: rho_up > rho_down 
     415            DO_2D_OVR( 1, 0, 1, 0 )                         ! criteria: rho_up > rho_down 
    425416               !                                                  ! i-direction 
    426417               ! down-slope T-point i/k-index (deep)  &   up-slope T-point i/k-index (shelf) 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/TRA/traisf.F90

    r14789 r14852  
    4747      IF( ln_timing )   CALL timing_start('tra_isf') 
    4848      ! 
    49       IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     49      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
    5050         IF( kt == nit000 ) THEN 
    5151            IF(lwp) WRITE(numout,*) 
    … …  
    7979      ! 
    8080      IF ( ln_isfdebug ) THEN 
    81          IF( ntile == 0 .OR. ntile == nijtile ) THEN                       ! Do only for the full domain 
     81         IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN                       ! Do only for the full domain 
    8282            CALL debug('tra_isf: pts(:,:,:,:,Krhs) T', pts(:,:,:,1,Krhs)) 
    8383            CALL debug('tra_isf: pts(:,:,:,:,Krhs) S', pts(:,:,:,2,Krhs)) 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/TRA/traldf.F90

    r14789 r14852  
    1717   USE oce            ! ocean dynamics and tracers 
    1818   USE dom_oce        ! ocean space and time domain 
    19    ! TEMP: [tiling] This change not necessary after extra haloes development (lbc_lnk removed from tra_ldf_blp, zps_hde*) 
    20    USE domtile 
    2119   USE phycst         ! physical constants 
    2220   USE ldftra         ! lateral diffusion: eddy diffusivity & EIV coeff. 
    … …  
    5856      !! 
    5957      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt, ztrds 
    60       ! TEMP: [tiling] This change not necessary after extra haloes development (lbc_lnk removed from tra_ldf_blp, zps_hde*) 
    61       LOGICAL :: lskip 
    6258      !!---------------------------------------------------------------------- 
    6359      ! 
    6460      IF( ln_timing )   CALL timing_start('tra_ldf') 
    6561      ! 
    66       lskip = .FALSE. 
    67  
    6862      IF( l_trdtra )   THEN                    !* Save ta and sa trends 
    6963         ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 
    … …  
    7165         ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) 
    7266      ENDIF 
    73  
    74       ! TEMP: [tiling] These changes not necessary after extra haloes development (lbc_lnk removed from tra_ldf_blp, zps_hde*) 
    75       IF( nldf_tra == np_blp .OR. nldf_tra == np_blp_i .OR. nldf_tra == np_blp_it )  THEN 
    76          IF( ln_tile ) THEN 
    77             IF( ntile == 1 ) THEN 
    78                CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) 
    79             ELSE 
    80                lskip = .TRUE. 
    81             ENDIF 
    82          ENDIF 
    83       ENDIF 
    84       IF( .NOT. lskip ) THEN 
    85          ! 
    86          SELECT CASE ( nldf_tra )                 !* compute lateral mixing trend and add it to the general trend 
    87          CASE ( np_lap   )                                  ! laplacian: iso-level operator 
    88             CALL tra_ldf_lap  ( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs),                   jpts,  1 ) 
    89          CASE ( np_lap_i )                                  ! laplacian: standard iso-neutral operator (Madec) 
    90             CALL tra_ldf_iso  ( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts,  1 ) 
    91          CASE ( np_lap_it )                                 ! laplacian: triad iso-neutral operator (griffies) 
    92             CALL tra_ldf_triad( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts,  1 ) 
    93          CASE ( np_blp , np_blp_i , np_blp_it )             ! bilaplacian: iso-level & iso-neutral operators 
    94             IF(nn_hls.EQ.2) CALL lbc_lnk( 'tra_ldf', pts(:,:,:,:,Kbb), 'T',1.) 
    95             CALL tra_ldf_blp  ( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs),             jpts, nldf_tra ) 
    96          END SELECT 
    97          ! 
    98          IF( l_trdtra )   THEN                    !* save the horizontal diffusive trends for further diagnostics 
    99             ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:) 
    100             ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:) 
    101             CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_ldf, ztrdt ) 
    102             CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_ldf, ztrds ) 
    103             DEALLOCATE( ztrdt, ztrds ) 
    104          ENDIF 
    105  
    106          ! TEMP: [tiling] This change not necessary after extra haloes development (lbc_lnk removed from tra_ldf_blp, zps_hde*) 
    107          IF( ln_tile .AND. ntile == 0 ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 1 ) 
     67      ! 
     68      SELECT CASE ( nldf_tra )                 !* compute lateral mixing trend and add it to the general trend 
     69      CASE ( np_lap   )                                  ! laplacian: iso-level operator 
     70         CALL tra_ldf_lap  ( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs),                   jpts,  1 ) 
     71      CASE ( np_lap_i )                                  ! laplacian: standard iso-neutral operator (Madec) 
     72         CALL tra_ldf_iso  ( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts,  1 ) 
     73      CASE ( np_lap_it )                                 ! laplacian: triad iso-neutral operator (griffies) 
     74         CALL tra_ldf_triad( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts,  1 ) 
     75      CASE ( np_blp , np_blp_i , np_blp_it )             ! bilaplacian: iso-level & iso-neutral operators 
     76         CALL tra_ldf_blp  ( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs),             jpts, nldf_tra ) 
     77      END SELECT 
     78      ! 
     79      IF( l_trdtra )   THEN                    !* save the horizontal diffusive trends for further diagnostics 
     80         ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:) 
     81         ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:) 
     82         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_ldf, ztrdt ) 
     83         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_ldf, ztrds ) 
     84         DEALLOCATE( ztrdt, ztrds ) 
    10885      ENDIF 
    10986      !                                        !* print mean trends (used for debugging) 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/TRA/traldf_iso.F90

    r14789 r14852  
    132132      INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices 
    133133      INTEGER  ::  ikt 
    134       INTEGER  ::  ierr             ! local integer 
     134      INTEGER  ::  ierr, iij        ! local integer 
    135135      REAL(wp) ::  zmsku, zahu_w, zabe1, zcof1, zcoef3   ! local scalars 
    136136      REAL(wp) ::  zmskv, zahv_w, zabe2, zcof2, zcoef4   !   -      - 
    … …  
    141141      ! 
    142142      IF( kpass == 1 .AND. kt == kit000 )  THEN 
    143          IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     143         IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
    144144            IF(lwp) WRITE(numout,*) 
    145145            IF(lwp) WRITE(numout,*) 'tra_ldf_iso : rotated laplacian diffusion operator on ', cdtype 
    … …  
    147147         ENDIF 
    148148         ! 
    149          DO_3D( 0, 0, 0, 0, 1, jpk ) 
     149         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 
    150150            akz     (ji,jj,jk) = 0._wp 
    151151            ah_wslp2(ji,jj,jk) = 0._wp 
    … …  
    153153      ENDIF 
    154154      ! 
    155       IF( ntile == 0 .OR. ntile == 1 )  THEN                           ! Do only on the first tile 
     155      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                           ! Do only on the first tile 
    156156         l_hst = .FALSE. 
    157157         l_ptr = .FALSE. 
    … …  
    161161      ENDIF 
    162162      ! 
     163      ! Define pt_rhs halo points for multi-point haloes in bilaplacian case 
     164      IF( nldf_tra == np_blp_i .AND. kpass == 1 ) THEN ; iij = nn_hls 
     165      ELSE                                             ; iij = 1 
     166      ENDIF 
     167 
    163168      ! 
    164169      IF( kpass == 1 ) THEN   ;   zsign =  1._wp      ! bilaplacian operator require a minus sign (eddy diffusivity >0) 
    … …  
    172177      IF( kpass == 1 ) THEN                  !==  first pass only  ==! 
    173178         ! 
    174          DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     179         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    175180            ! 
    176181            zmsku = wmask(ji,jj,jk) / MAX(   umask(ji  ,jj,jk-1) + umask(ji-1,jj,jk)          & 
    … …  
    179184               &                           + vmask(ji,jj-1,jk-1) + vmask(ji,jj  ,jk) , 1._wp  ) 
    180185               ! 
    181             zahu_w = (   pahu(ji  ,jj,jk-1) + pahu(ji-1,jj,jk)    & 
    182                &       + pahu(ji-1,jj,jk-1) + pahu(ji  ,jj,jk)  ) * zmsku 
    183             zahv_w = (   pahv(ji,jj  ,jk-1) + pahv(ji,jj-1,jk)    & 
    184                &       + pahv(ji,jj-1,jk-1) + pahv(ji,jj  ,jk)  ) * zmskv 
     186            ! round brackets added to fix the order of floating point operations 
     187            ! needed to ensure halo 1 - halo 2 compatibility 
     188            zahu_w = ( (  pahu(ji  ,jj,jk-1) + pahu(ji-1,jj,jk)                    & 
     189               &       )                                                           & ! bracket for halo 1 - halo 2 compatibility 
     190               &       + ( pahu(ji-1,jj,jk-1) + pahu(ji  ,jj,jk)                   & 
     191               &         )                                                         & ! bracket for halo 1 - halo 2 compatibility 
     192               &     ) * zmsku 
     193            zahv_w = ( (  pahv(ji,jj  ,jk-1) + pahv(ji,jj-1,jk)                    & 
     194               &       )                                                           & ! bracket for halo 1 - halo 2 compatibility 
     195               &       + ( pahv(ji,jj-1,jk-1) + pahv(ji,jj  ,jk)                   & 
     196               &         )                                                         & ! bracket for halo 1 - halo 2 compatibility 
     197               &     ) * zmskv 
    185198               ! 
    186199            ah_wslp2(ji,jj,jk) = zahu_w * wslpi(ji,jj,jk) * wslpi(ji,jj,jk)   & 
    … …  
    189202         ! 
    190203         IF( ln_traldf_msc ) THEN                ! stabilizing vertical diffusivity coefficient 
    191             DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     204            DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
     205               ! round brackets added to fix the order of floating point operations 
     206               ! needed to ensure halo 1 - halo 2 compatibility 
    192207               akz(ji,jj,jk) = 0.25_wp * (                                                                     & 
    193                   &              ( pahu(ji  ,jj,jk) + pahu(ji  ,jj,jk-1) ) / ( e1u(ji  ,jj) * e1u(ji  ,jj) )   & 
     208                  &            ( ( pahu(ji  ,jj,jk) + pahu(ji  ,jj,jk-1) ) / ( e1u(ji  ,jj) * e1u(ji  ,jj) )   & 
    194209                  &            + ( pahu(ji-1,jj,jk) + pahu(ji-1,jj,jk-1) ) / ( e1u(ji-1,jj) * e1u(ji-1,jj) )   & 
    195                   &            + ( pahv(ji,jj  ,jk) + pahv(ji,jj  ,jk-1) ) / ( e2v(ji,jj  ) * e2v(ji,jj  ) )   & 
    196                   &            + ( pahv(ji,jj-1,jk) + pahv(ji,jj-1,jk-1) ) / ( e2v(ji,jj-1) * e2v(ji,jj-1) )   ) 
     210                  &            )                                                                               & ! bracket for halo 1 - halo 2 compatibility 
     211                  &            + ( ( pahv(ji,jj  ,jk) + pahv(ji,jj  ,jk-1) ) / ( e2v(ji,jj  ) * e2v(ji,jj  ) ) & 
     212                  &              + ( pahv(ji,jj-1,jk) + pahv(ji,jj-1,jk-1) ) / ( e2v(ji,jj-1) * e2v(ji,jj-1) ) & 
     213                  &              )                                                                             & ! bracket for halo 1 - halo 2 compatibility 
     214                  &                      ) 
    197215            END_3D 
    198216            ! 
    199217            IF( ln_traldf_blp ) THEN                ! bilaplacian operator 
    200                DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     218               DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    201219                  akz(ji,jj,jk) = 16._wp   & 
    202220                     &   * ah_wslp2   (ji,jj,jk)   & 
    … …  
    206224               END_3D 
    207225            ELSEIF( ln_traldf_lap ) THEN              ! laplacian operator 
    208                DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     226               DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    209227                  ze3w_2 = e3w(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm) 
    210228                  zcoef0 = rDt * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2  ) 
    … …  
    214232           ! 
    215233         ELSE                                    ! 33 flux set to zero with akz=ah_wslp2 ==>> computed in full implicit 
    216             DO_3D( 0, 0, 0, 0, 1, jpk ) 
     234            DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 
    217235               akz(ji,jj,jk) = ah_wslp2(ji,jj,jk) 
    218236            END_3D 
    … …  
    227245         !!   I - masked horizontal derivative 
    228246         !!---------------------------------------------------------------------- 
    229 !!gm : bug.... why (x,:,:)?   (1,jpj,:) and (jpi,1,:) should be sufficient.... 
    230          zdit (ntsi-nn_hls,:,:) = 0._wp     ;     zdit (ntei+nn_hls,:,:) = 0._wp 
    231          zdjt (ntsi-nn_hls,:,:) = 0._wp     ;     zdjt (ntei+nn_hls,:,:) = 0._wp 
    232          !!end 
     247         zdit(:,:,:) = 0._wp 
     248         zdjt(:,:,:) = 0._wp 
    233249 
    234250         ! Horizontal tracer gradient 
    235          DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 
     251         DO_3D( iij, iij-1, iij, iij-1, 1, jpkm1 ) 
    236252            zdit(ji,jj,jk) = ( pt(ji+1,jj  ,jk,jn) - pt(ji,jj,jk,jn) ) * umask(ji,jj,jk) 
    237253            zdjt(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn) - pt(ji,jj,jk,jn) ) * vmask(ji,jj,jk) 
    238254         END_3D 
    239255         IF( ln_zps ) THEN      ! botton and surface ocean correction of the horizontal gradient 
    240             DO_2D( 1, 0, 1, 0 )           ! bottom correction (partial bottom cell) 
     256            DO_2D( iij, iij-1, iij, iij-1 )            ! bottom correction (partial bottom cell) 
    241257               zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn) 
    242258               zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn) 
    243259            END_2D 
    244260            IF( ln_isfcav ) THEN      ! first wet level beneath a cavity 
    245                DO_2D( 1, 0, 1, 0 ) 
     261               DO_2D( iij, iij-1, iij, iij-1 ) 
    246262                  IF( miku(ji,jj) > 1 )   zdit(ji,jj,miku(ji,jj)) = pgui(ji,jj,jn) 
    247263                  IF( mikv(ji,jj) > 1 )   zdjt(ji,jj,mikv(ji,jj)) = pgvi(ji,jj,jn) 
    … …  
    256272         DO jk = 1, jpkm1                                 ! Horizontal slab 
    257273            ! 
    258             DO_2D( 1, 1, 1, 1 ) 
     274            DO_2D( iij, iij, iij, iij ) 
    259275               !                             !== Vertical tracer gradient 
    260276               zdk1t(ji,jj) = ( pt(ji,jj,jk,jn) - pt(ji,jj,jk+1,jn) ) * wmask(ji,jj,jk+1)     ! level jk+1 
    … …  
    265281            END_2D 
    266282            ! 
    267             DO_2D( 1, 0, 1, 0 )           !==  Horizontal fluxes 
     283            DO_2D( iij, iij-1, iij, iij-1 )           !==  Horizontal fluxes 
    268284               zabe1 = pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm) 
    269285               zabe2 = pahv(ji,jj,jk) * e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm) 
    … …  
    278294               zcof2 = - pahv(ji,jj,jk) * e1v(ji,jj) * vslp(ji,jj,jk) * zmskv 
    279295               ! 
    280                zftu(ji,jj,jk ) = (  zabe1 * zdit(ji,jj,jk)   & 
    281                   &               + zcof1 * (  zdkt (ji+1,jj) + zdk1t(ji,jj)      & 
    282                   &                          + zdk1t(ji+1,jj) + zdkt (ji,jj)  )  ) * umask(ji,jj,jk) 
    283                zftv(ji,jj,jk) = (  zabe2 * zdjt(ji,jj,jk)   & 
    284                   &               + zcof2 * (  zdkt (ji,jj+1) + zdk1t(ji,jj)      & 
    285                   &                          + zdk1t(ji,jj+1) + zdkt (ji,jj)  )  ) * vmask(ji,jj,jk) 
     296               ! round brackets added to fix the order of floating point operations 
     297               ! needed to ensure halo 1 - halo 2 compatibility 
     298               zftu(ji,jj,jk ) = (  zabe1 * zdit(ji,jj,jk)                       & 
     299                  &               + zcof1 * ( ( zdkt (ji+1,jj) + zdk1t(ji,jj)    & 
     300                  &                           )                                  & ! bracket for halo 1 - halo 2 compatibility 
     301                  &                         + ( zdk1t(ji+1,jj) + zdkt (ji,jj)    & 
     302                  &                           )                                  & ! bracket for halo 1 - halo 2 compatibility 
     303                  &                         ) ) * umask(ji,jj,jk) 
     304               zftv(ji,jj,jk) = (  zabe2 * zdjt(ji,jj,jk)                        & 
     305                  &              + zcof2 * ( ( zdkt (ji,jj+1) + zdk1t(ji,jj)     & 
     306                  &                           )                                  & ! bracket for halo 1 - halo 2 compatibility 
     307                  &                         + ( zdk1t(ji,jj+1) + zdkt (ji,jj)    & 
     308                  &                           )                                  & ! bracket for halo 1 - halo 2 compatibility 
     309                  &                         ) ) * vmask(ji,jj,jk) 
    286310            END_2D 
    287311            ! 
    288             DO_2D( 0, 0, 0, 0 )           !== horizontal divergence and add to pta 
    289                pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn)    & 
    290                   &       + zsign * (  zftu(ji,jj,jk) - zftu(ji-1,jj,jk) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)  )   & 
    291                   &                                              * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 
     312            DO_2D( iij-1, iij-1, iij-1, iij-1 )           !== horizontal divergence and add to pta 
     313               ! round brackets added to fix the order of floating point operations 
     314               ! needed to ensure halo 1 - halo 2 compatibility 
     315               pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn)                         & 
     316                  &       + zsign * ( ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk)        & 
     317                  &                   )                                          & ! bracket for halo 1 - halo 2 compatibility 
     318                  &                 + ( zftv(ji,jj,jk) - zftv(ji,jj-1,jk)        & 
     319                  &                   )                                          & ! bracket for halo 1 - halo 2 compatibility 
     320                  &                 ) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 
    292321            END_2D 
    293322         END DO                                        !   End of slab 
    … …  
    302331         ztfw(:,:, 1 ) = 0._wp      ;      ztfw(:,:,jpk) = 0._wp 
    303332 
    304          DO_3D( 0, 0, 0, 0, 2, jpkm1 )    ! interior (2=<jk=<jpk-1) 
     333         DO_3D( iij-1, iij-1, iij-1, iij-1, 2, jpkm1 )    ! interior (2=<jk=<jpk-1) 
    305334            ! 
    306335            zmsku = wmask(ji,jj,jk) / MAX(   umask(ji  ,jj,jk-1) + umask(ji-1,jj,jk)          & 
    … …  
    317346            zcoef4 = - zahv_w * e1t(ji,jj) * zmskv * wslpj (ji,jj,jk) 
    318347            ! 
    319             ztfw(ji,jj,jk) = zcoef3 * (   zdit(ji  ,jj  ,jk-1) + zdit(ji-1,jj  ,jk)      & 
    320                &                        + zdit(ji-1,jj  ,jk-1) + zdit(ji  ,jj  ,jk)  )   & 
    321                &           + zcoef4 * (   zdjt(ji  ,jj  ,jk-1) + zdjt(ji  ,jj-1,jk)      & 
    322                &                        + zdjt(ji  ,jj-1,jk-1) + zdjt(ji  ,jj  ,jk)  ) 
     348            ! round brackets added to fix the order of floating point operations 
     349            ! needed to ensure halo 1 - halo 2 compatibility 
     350            ztfw(ji,jj,jk) = zcoef3 * ( ( zdit(ji  ,jj  ,jk-1) + zdit(ji-1,jj  ,jk)    & 
     351                  &                     )                                              & ! bracket for halo 1 - halo 2 compatibility 
     352                  &                   + ( zdit(ji-1,jj  ,jk-1) + zdit(ji  ,jj  ,jk)    & 
     353                  &                     )                                              & ! bracket for halo 1 - halo 2 compatibility 
     354                  &                   )                                                & 
     355                  &        + zcoef4 * ( ( zdjt(ji  ,jj  ,jk-1) + zdjt(ji  ,jj-1,jk)    & 
     356                  &                     )                                              & ! bracket for halo 1 - halo 2 compatibility 
     357                  &                   + ( zdjt(ji  ,jj-1,jk-1) + zdjt(ji  ,jj  ,jk)    & 
     358                  &                     )                                              & ! bracket for halo 1 - halo 2 compatibility 
     359                  &                   ) 
    323360         END_3D 
    324361         !                                !==  add the vertical 33 flux  ==! 
    325362         IF( ln_traldf_lap ) THEN               ! laplacian case: eddy coef = ah_wslp2 - akz 
    326             DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     363            DO_3D( iij-1, iij-1, iij-1, iij-1, 2, jpkm1 ) 
    327364               ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk)   & 
    328365                  &                            * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) )               & 
    … …  
    333370            SELECT CASE( kpass ) 
    334371            CASE(  1  )                            ! 1st pass : eddy coef = ah_wslp2 
    335                DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     372               DO_3D( iij-1, iij-1, iij-1, iij-1, 2, jpkm1 ) 
    336373                  ztfw(ji,jj,jk) =   & 
    337374                     &  ztfw(ji,jj,jk) + ah_wslp2(ji,jj,jk) * e1e2t(ji,jj)   & 
    … …  
    347384         ENDIF 
    348385         ! 
    349          DO_3D( 0, 0, 0, 0, 1, jpkm1 )    !==  Divergence of vertical fluxes added to pta  ==! 
     386         DO_3D( iij-1, iij-1, iij-1, iij-1, 1, jpkm1 )    !==  Divergence of vertical fluxes added to pta  ==! 
    350387            pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) + zsign * (  ztfw (ji,jj,jk) - ztfw(ji,jj,jk+1)  ) * r1_e1e2t(ji,jj)   & 
    351388               &                                             / e3t(ji,jj,jk,Kmm) 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/TRA/traldf_lap_blp.F90

    r14789 r14852  
    103103      ! 
    104104      INTEGER  ::   ji, jj, jk, jn      ! dummy loop indices 
    105       INTEGER  ::   isi, iei, isj, iej  ! local integers 
     105      INTEGER  ::   iij 
    106106      REAL(wp) ::   zsign               ! local scalars 
    107107      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   ztu, ztv, zaheeu, zaheev 
    108108      !!---------------------------------------------------------------------- 
    109109      ! 
    110       IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     110      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
    111111         IF( kt == nit000 .AND. lwp )  THEN 
    112112            WRITE(numout,*) 
    … …  
    122122      ENDIF 
    123123      ! 
     124      ! Define pt_rhs halo points for multi-point haloes in bilaplacian case 
     125      IF( nldf_tra == np_blp .AND. kpass == 1 ) THEN ; iij = nn_hls 
     126      ELSE                                           ; iij = 1 
     127      ENDIF 
     128 
    124129      !                                !==  Initialization of metric arrays used for all tracers  ==! 
    125130      IF( kpass == 1 ) THEN   ;   zsign =  1._wp      ! bilaplacian operator require a minus sign (eddy diffusivity >0) 
    … …  
    127132      ENDIF 
    128133 
    129       IF( ntsi == Nis0 ) THEN ; isi = nn_hls - 1 ; ELSE ; isi = 0 ; ENDIF    ! Avoid double-counting when using tiling 
    130       IF( ntsj == Njs0 ) THEN ; isj = nn_hls - 1 ; ELSE ; isj = 0 ; ENDIF 
    131       IF( ntei == Nie0 ) THEN ; iei = nn_hls - 1 ; ELSE ; iei = 0 ; ENDIF 
    132       IF( ntej == Nje0 ) THEN ; iej = nn_hls - 1 ; ELSE ; iej = 0 ; ENDIF 
    133  
    134       DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )            !== First derivative (gradient)  ==! 
     134      DO_3D( iij, iij-1, iij, iij-1, 1, jpkm1 )            !== First derivative (gradient)  ==! 
    135135         zaheeu(ji,jj,jk) = zsign * pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm)   !!gm   * umask(ji,jj,jk) pah masked! 
    136136         zaheev(ji,jj,jk) = zsign * pahv(ji,jj,jk) * e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm)   !!gm   * vmask(ji,jj,jk) 
    … …  
    141141         !                          ! =========== ! 
    142142         ! 
    143          DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )            !== First derivative (gradient)  ==! 
     143         DO_3D( iij, iij-1, iij, iij-1, 1, jpkm1 )            !== First derivative (gradient)  ==! 
    144144            ztu(ji,jj,jk) = zaheeu(ji,jj,jk) * ( pt(ji+1,jj  ,jk,jn) - pt(ji,jj,jk,jn) ) 
    145145            ztv(ji,jj,jk) = zaheev(ji,jj,jk) * ( pt(ji  ,jj+1,jk,jn) - pt(ji,jj,jk,jn) ) 
    146146         END_3D 
    147147         IF( ln_zps ) THEN                             ! set gradient at bottom/top ocean level 
    148             DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )                              ! bottom 
     148            DO_2D( iij, iij-1, iij, iij-1 )                              ! bottom 
    149149               ztu(ji,jj,mbku(ji,jj)) = zaheeu(ji,jj,mbku(ji,jj)) * pgu(ji,jj,jn) 
    150150               ztv(ji,jj,mbkv(ji,jj)) = zaheev(ji,jj,mbkv(ji,jj)) * pgv(ji,jj,jn) 
    151151            END_2D 
    152152            IF( ln_isfcav ) THEN                             ! top in ocean cavities only 
    153                DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
     153               DO_2D( iij, iij-1, iij, iij-1 ) 
    154154                  IF( miku(ji,jj) > 1 )   ztu(ji,jj,miku(ji,jj)) = zaheeu(ji,jj,miku(ji,jj)) * pgui(ji,jj,jn) 
    155155                  IF( mikv(ji,jj) > 1 )   ztv(ji,jj,mikv(ji,jj)) = zaheev(ji,jj,mikv(ji,jj)) * pgvi(ji,jj,jn) 
    … …  
    158158         ENDIF 
    159159         ! 
    160          DO_3D( isi, iei, isj, iej, 1, jpkm1 )            !== Second derivative (divergence) added to the general tracer trends  ==! 
    161             pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) + (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)     & 
    162                &                                      +    ztv(ji,jj,jk) - ztv(ji,jj-1,jk) )   & 
    163                &                                      / ( e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) ) 
     160         DO_3D( iij-1, iij-1, iij-1, iij-1, 1, jpkm1 )            !== Second derivative (divergence) added to the general tracer trends  ==! 
     161            ! round brackets added to fix the order of floating point operations 
     162            ! needed to ensure halo 1 - halo 2 compatibility 
     163            pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) + ( ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk)    & 
     164               &                                          )                                    & ! bracket for halo 1 - halo 2 compatibility 
     165               &                                      +   ( ztv(ji,jj,jk) - ztv(ji,jj-1,jk)    & 
     166               &                                          )                                    & ! bracket for halo 1 - halo 2 compatibility 
     167               &                                        ) / ( e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) ) 
    164168         END_3D 
    165169         ! 
    … …  
    211215      !!--------------------------------------------------------------------- 
    212216      ! 
    213       IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     217      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
    214218         IF( kt == kit000 .AND. lwp )  THEN 
    215219            WRITE(numout,*) 
    … …  
    235239      END SELECT 
    236240      ! 
    237       CALL lbc_lnk( 'traldf_lap_blp', zlap(:,:,:,:) , 'T', 1.0_wp )     ! Lateral boundary conditions (unchanged sign) 
     241      IF (nn_hls==1) CALL lbc_lnk( 'traldf_lap_blp', zlap(:,:,:,:) , 'T', 1.0_wp )     ! Lateral boundary conditions (unchanged sign) 
    238242      !                                               ! Partial top/bottom cell: GRADh( zlap ) 
    239243      IF( ln_isfcav .AND. ln_zps ) THEN   ;   CALL zps_hde_isf( kt, Kmm, kjpt, zlap, zglu, zglv, zgui, zgvi )  ! both top & bottom 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/TRA/traldf_triad.F90

    r14789 r14852  
    1313   USE oce            ! ocean dynamics and active tracers 
    1414   USE dom_oce        ! ocean space and time domain 
    15    ! TEMP: [tiling] This change not necessary if XIOS has subdomain support 
    16    USE domtile 
    1715   USE domutl, ONLY : is_tile 
    1816   USE phycst         ! physical constants 
    … …  
    109107      REAL(wp), DIMENSION(A2D_T(ktt_rhs),JPK,KJPT), INTENT(inout) ::   pt_rhs     ! tracer trend 
    110108      ! 
    111       INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices 
    112       INTEGER  ::  ip,jp,kp         ! dummy loop indices 
    113       INTEGER  ::  ierr            ! local integer 
    114       REAL(wp) ::  zmsku, zabe1, zcof1, zcoef3    ! local scalars 
    115       REAL(wp) ::  zmskv, zabe2, zcof2, zcoef4    !   -      - 
     109      INTEGER  ::  ji, jj, jk, jn, kp, iij   ! dummy loop indices 
    116110      REAL(wp) ::  zcoef0, ze3w_2, zsign          !   -      - 
    117111      ! 
    118       REAL(wp) ::   zslope_skew, zslope_iso, zslope2, zbu, zbv 
    119       REAL(wp) ::   ze1ur, ze2vr, ze3wr, zdxt, zdyt, zdzt 
    120       REAL(wp) ::   zah, zah_slp, zaei_slp 
    121       REAL(wp), DIMENSION(A2D(nn_hls),0:1)     ::   zdkt3d                         ! vertical tracer gradient at 2 levels 
    122       REAL(wp), DIMENSION(A2D(nn_hls)        ) ::   z2d                            ! 2D workspace 
    123       REAL(wp), DIMENSION(A2D(nn_hls)    ,jpk) ::   zdit, zdjt, zftu, zftv, ztfw   ! 3D     - 
    124       ! TEMP: [tiling] This can be A2D(nn_hls) if XIOS has subdomain support 
    125       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zpsi_uw, zpsi_vw 
     112      REAL(wp) ::   zslope2, zbu, zbv, zbu1, zbv1, zslope21, zah, zah1, zah_ip1, zah_jp1, zbu_ip1, zbv_jp1 
     113      REAL(wp) ::   ze1ur, ze2vr, ze3wr, zdxt, zdyt, zdzt, zdyt_jp1, ze3wr_jp1, zdzt_jp1, zah_slp1, zah_slp_jp1, zaei_slp_jp1 
     114      REAL(wp) ::   zah_slp, zaei_slp, zdxt_ip1, ze3wr_ip1, zdzt_ip1, zah_slp_ip1, zaei_slp_ip1, zaei_slp1 
     115      REAL(wp), DIMENSION(A2D(nn_hls),0:1) ::   zdkt3d                                           ! vertical tracer gradient at 2 levels 
     116      REAL(wp), DIMENSION(A2D(nn_hls)    ) ::   z2d                                              ! 2D workspace 
     117      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zdit, zdjt, zftu, zftv, ztfw, zpsi_uw, zpsi_vw   ! 3D     - 
    126118      !!---------------------------------------------------------------------- 
    127119      ! 
    128       IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     120      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
    129121         IF( kpass == 1 .AND. kt == kit000 )  THEN 
    130122            IF(lwp) WRITE(numout,*) 
    … …  
    142134      ENDIF 
    143135      ! 
     136      ! Define pt_rhs halo points for multi-point haloes in bilaplacian case 
     137      IF( nldf_tra == np_blp_it .AND. kpass == 1 ) THEN ; iij = nn_hls 
     138      ELSE                                              ; iij = 1 
     139      ENDIF 
     140 
     141      ! 
    144142      IF( kpass == 1 ) THEN   ;   zsign =  1._wp      ! bilaplacian operator require a minus sign (eddy diffusivity >0) 
    145143      ELSE                    ;   zsign = -1._wp 
    … …  
    152150      IF( kpass == 1 ) THEN         !==  first pass only  and whatever the tracer is  ==! 
    153151         ! 
    154          DO_3D( 0, 0, 0, 0, 1, jpk ) 
     152         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 
    155153            akz     (ji,jj,jk) = 0._wp 
    156154            ah_wslp2(ji,jj,jk) = 0._wp 
    157155         END_3D 
    158156         ! 
    159          DO ip = 0, 1                            ! i-k triads 
    160             DO kp = 0, 1 
    161                DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    162                   ze3wr = 1._wp / e3w(ji,jj,jk+kp,Kmm) 
    163                   zbu   = e1e2u(ji-ip,jj) * e3u(ji-ip,jj,jk,Kmm) 
    164                   zah   = 0.25_wp * pahu(ji-ip,jj,jk) 
    165                   zslope_skew = triadi_g(ji,jj,jk,1-ip,kp) 
    166                   ! Subtract s-coordinate slope at t-points to give slope rel to s-surfaces (do this by *adding* gradient of depth) 
    167                   zslope2 = zslope_skew + ( gdept(ji-ip+1,jj,jk,Kmm) - gdept(ji-ip,jj,jk,Kmm) ) * r1_e1u(ji-ip,jj) * umask(ji-ip,jj,jk+kp) 
    168                   zslope2 = zslope2 *zslope2 
    169                   ah_wslp2(ji,jj,jk+kp) = ah_wslp2(ji,jj,jk+kp) + zah * zbu * ze3wr * r1_e1e2t(ji,jj) * zslope2 
    170                   akz     (ji,jj,jk+kp) = akz     (ji,jj,jk+kp) + zah * r1_e1u(ji-ip,jj)       & 
    171                      &                                                      * r1_e1u(ji-ip,jj) * umask(ji-ip,jj,jk+kp) 
    172                      ! 
    173                END_3D 
    174             END DO 
     157         DO kp = 0, 1                            ! i-k triads 
     158            DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
     159               ze3wr = 1._wp / e3w(ji,jj,jk+kp,Kmm) 
     160               zbu   = e1e2u(ji,jj) * e3u(ji,jj,jk,Kmm) 
     161               zbu1  = e1e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm) 
     162               zah   = 0.25_wp * pahu(ji,jj,jk) 
     163               zah1  = 0.25_wp * pahu(ji-1,jj,jk) 
     164               ! Subtract s-coordinate slope at t-points to give slope rel to s-surfaces (do this by *adding* gradient of depth) 
     165               zslope2 = triadi_g(ji,jj,jk,1,kp) + ( gdept(ji+1,jj,jk,Kmm) - gdept(ji,jj,jk,Kmm) ) * r1_e1u(ji,jj) * umask(ji,jj,jk+kp) 
     166               zslope2 = zslope2 *zslope2 
     167               zslope21 = triadi_g(ji,jj,jk,0,kp) + ( gdept(ji,jj,jk,Kmm) - gdept(ji-1,jj,jk,Kmm) ) * r1_e1u(ji-1,jj) * umask(ji-1,jj,jk+kp) 
     168               zslope21 = zslope21 *zslope21 
     169               ! round brackets added to fix the order of floating point operations 
     170               ! needed to ensure halo 1 - halo 2 compatibility 
     171               ah_wslp2(ji,jj,jk+kp) =  ah_wslp2(ji,jj,jk+kp) + ( zah * zbu * ze3wr * r1_e1e2t(ji,jj) * zslope2                    & 
     172                        &                                       + zah1 * zbu1 * ze3wr * r1_e1e2t(ji,jj) * zslope21                 & 
     173                        &                                       )                                                                  ! bracket for halo 1 - halo 2 compatibility 
     174               akz     (ji,jj,jk+kp) =  akz     (ji,jj,jk+kp) + ( zah * r1_e1u(ji,jj) * r1_e1u(ji,jj) * umask(ji,jj,jk+kp)         & 
     175                                                                + zah1 * r1_e1u(ji-1,jj) * r1_e1u(ji-1,jj) * umask(ji-1,jj,jk+kp)  & 
     176                        &                                       )                                                                  ! bracket for halo 1 - halo 2 compatibility 
     177            END_3D 
    175178         END DO 
    176179         ! 
    177          DO jp = 0, 1                            ! j-k triads 
    178             DO kp = 0, 1 
    179                DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    180                   ze3wr = 1.0_wp / e3w(ji,jj,jk+kp,Kmm) 
    181                   zbv   = e1e2v(ji,jj-jp) * e3v(ji,jj-jp,jk,Kmm) 
    182                   zah   = 0.25_wp * pahv(ji,jj-jp,jk) 
    183                   zslope_skew = triadj_g(ji,jj,jk,1-jp,kp) 
    184                   ! Subtract s-coordinate slope at t-points to give slope rel to s surfaces 
    185                   !    (do this by *adding* gradient of depth) 
    186                   zslope2 = zslope_skew + ( gdept(ji,jj-jp+1,jk,Kmm) - gdept(ji,jj-jp,jk,Kmm) ) * r1_e2v(ji,jj-jp) * vmask(ji,jj-jp,jk+kp) 
    187                   zslope2 = zslope2 * zslope2 
    188                   ah_wslp2(ji,jj,jk+kp) = ah_wslp2(ji,jj,jk+kp) + zah * zbv * ze3wr * r1_e1e2t(ji,jj) * zslope2 
    189                   akz     (ji,jj,jk+kp) = akz     (ji,jj,jk+kp) + zah * r1_e2v(ji,jj-jp)     & 
    190                      &                                                      * r1_e2v(ji,jj-jp) * vmask(ji,jj-jp,jk+kp) 
    191                   ! 
    192                END_3D 
    193             END DO 
     180         DO kp = 0, 1                            ! j-k triads 
     181            DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
     182               ze3wr = 1.0_wp / e3w(ji,jj,jk+kp,Kmm) 
     183               zbv   = e1e2v(ji,jj) * e3v(ji,jj,jk,Kmm) 
     184               zbv1   = e1e2v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm) 
     185               zah   = 0.25_wp * pahv(ji,jj,jk) 
     186               zah1   = 0.25_wp * pahv(ji,jj-1,jk) 
     187               ! Subtract s-coordinate slope at t-points to give slope rel to s surfaces 
     188               !    (do this by *adding* gradient of depth) 
     189               zslope2 = triadj_g(ji,jj,jk,1,kp) + ( gdept(ji,jj+1,jk,Kmm) - gdept(ji,jj,jk,Kmm) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk+kp) 
     190               zslope2 = zslope2 * zslope2 
     191               zslope21 = triadj_g(ji,jj,jk,0,kp) + ( gdept(ji,jj,jk,Kmm) - gdept(ji,jj-1,jk,Kmm) ) * r1_e2v(ji,jj-1) * vmask(ji,jj-1,jk+kp) 
     192               zslope21 = zslope21 * zslope21 
     193               ! round brackets added to fix the order of floating point operations 
     194               ! needed to ensure halo 1 - halo 2 compatibility 
     195               ah_wslp2(ji,jj,jk+kp) = ah_wslp2(ji,jj,jk+kp) + ( zah * zbv * ze3wr * r1_e1e2t(ji,jj) * zslope2                     & 
     196                        &                                      + zah1 * zbv1 * ze3wr * r1_e1e2t(ji,jj) * zslope21                  & 
     197                        &                                      )                                                                   ! bracket for halo 1 - halo 2 compatibility 
     198               akz     (ji,jj,jk+kp) = akz     (ji,jj,jk+kp) + ( zah * r1_e2v(ji,jj) * r1_e2v(ji,jj) * vmask(ji,jj,jk+kp)          & 
     199                        &                                      + zah1 * r1_e2v(ji,jj-1) * r1_e2v(ji,jj-1) * vmask(ji,jj-1,jk+kp)   & 
     200                        &                                      )                                                                   ! bracket for halo 1 - halo 2 compatibility 
     201            END_3D 
    194202         END DO 
    195203         ! 
    … …  
    197205            ! 
    198206            IF( ln_traldf_blp ) THEN                ! bilaplacian operator 
    199                DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     207               DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    200208                  akz(ji,jj,jk) = 16._wp           & 
    201209                     &   * ah_wslp2   (ji,jj,jk)   & 
    … …  
    205213               END_3D 
    206214            ELSEIF( ln_traldf_lap ) THEN              ! laplacian operator 
    207                DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     215               DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    208216                  ze3w_2 = e3w(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm) 
    209217                  zcoef0 = rDt * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2  ) 
    … …  
    213221           ! 
    214222         ELSE                                    ! 33 flux set to zero with akz=ah_wslp2 ==>> computed in full implicit 
    215             DO_3D( 0, 0, 0, 0, 1, jpk ) 
     223            DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 
    216224               akz(ji,jj,jk) = ah_wslp2(ji,jj,jk) 
    217225            END_3D 
    218226         ENDIF 
    219227         ! 
    220          ! TEMP: [tiling] These changes not necessary if XIOS has subdomain support 
    221          IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only for the full domain 
    222             IF( ln_ldfeiv_dia .AND. cdtype == 'TRA' ) THEN 
    223                IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) 
    224  
    225                zpsi_uw(:,:,:) = 0._wp 
    226                zpsi_vw(:,:,:) = 0._wp 
    227  
    228                DO jp = 0, 1 
    229                   DO kp = 0, 1 
    230                      DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 
    231                         zpsi_uw(ji,jj,jk+kp) = zpsi_uw(ji,jj,jk+kp) & 
    232                            & + 0.25_wp * aeiu(ji,jj,jk) * e2u(ji,jj) * triadi_g(ji+jp,jj,jk,1-jp,kp) 
    233                         zpsi_vw(ji,jj,jk+kp) = zpsi_vw(ji,jj,jk+kp) & 
    234                            & + 0.25_wp * aeiv(ji,jj,jk) * e1v(ji,jj) * triadj_g(ji,jj+jp,jk,1-jp,kp) 
    235                      END_3D 
    236                   END DO 
    237                END DO 
    238                CALL ldf_eiv_dia( zpsi_uw, zpsi_vw, Kmm ) 
    239  
    240                IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = nijtile ) 
    241             ENDIF 
     228         IF( ln_ldfeiv_dia .AND. cdtype == 'TRA' ) THEN 
     229            zpsi_uw(:,:,:) = 0._wp 
     230            zpsi_vw(:,:,:) = 0._wp 
     231 
     232            DO kp = 0, 1 
     233               DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 
     234                  ! round brackets added to fix the order of floating point operations 
     235                  ! needed to ensure halo 1 - halo 2 compatibility 
     236                  zpsi_uw(ji,jj,jk+kp) = zpsi_uw(ji,jj,jk+kp)                                     & 
     237                     & + ( 0.25_wp * aeiu(ji,jj,jk) * e2u(ji,jj) * triadi_g(ji,jj,jk,1,kp)        & 
     238                     &   + 0.25_wp * aeiu(ji,jj,jk) * e2u(ji,jj) * triadi_g(ji+1,jj,jk,0,kp)      & 
     239                     &   )                                                                        ! bracket for halo 1 - halo 2 compatibility 
     240                  zpsi_vw(ji,jj,jk+kp) = zpsi_vw(ji,jj,jk+kp)                                     & 
     241                     & + ( 0.25_wp * aeiv(ji,jj,jk) * e1v(ji,jj) * triadj_g(ji,jj,jk,1,kp)        & 
     242                     &   + 0.25_wp * aeiv(ji,jj,jk) * e1v(ji,jj) * triadj_g(ji,jj+1,jk,0,kp)      & 
     243                     &   )                                                                        ! bracket for halo 1 - halo 2 compatibility 
     244               END_3D 
     245            END DO 
     246            CALL ldf_eiv_dia( zpsi_uw, zpsi_vw, Kmm ) 
    242247         ENDIF 
    243248         ! 
    … …  
    252257         zftu(:,:,:) = 0._wp 
    253258         zftv(:,:,:) = 0._wp 
    254          ! 
    255          DO_3D( 1, 0, 1, 0, 1, jpkm1 )    !==  before lateral T & S gradients at T-level jk  ==! 
     259         zdit(:,:,:) = 0._wp 
     260         zdjt(:,:,:) = 0._wp 
     261         ! 
     262         DO_3D( iij, iij-1, iij, iij-1, 1, jpkm1 )    !==  before lateral T & S gradients at T-level jk  ==! 
    256263            zdit(ji,jj,jk) = ( pt(ji+1,jj  ,jk,jn) - pt(ji,jj,jk,jn) ) * umask(ji,jj,jk) 
    257264            zdjt(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn) - pt(ji,jj,jk,jn) ) * vmask(ji,jj,jk) 
    258265         END_3D 
    259266         IF( ln_zps .AND. l_grad_zps ) THEN    ! partial steps: correction at top/bottom ocean level 
    260             DO_2D( 1, 0, 1, 0 )                    ! bottom level 
     267            DO_2D( iij, iij-1, iij, iij-1 )                    ! bottom level 
    261268               zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn) 
    262269               zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn) 
    263270            END_2D 
    264271            IF( ln_isfcav ) THEN                   ! top level (ocean cavities only) 
    265                DO_2D( 1, 0, 1, 0 ) 
     272               DO_2D( iij, iij-1, iij, iij-1 ) 
    266273                  IF( miku(ji,jj)  > 1 )   zdit(ji,jj,miku(ji,jj) ) = pgui(ji,jj,jn) 
    267274                  IF( mikv(ji,jj)  > 1 )   zdjt(ji,jj,mikv(ji,jj) ) = pgvi(ji,jj,jn) 
    … …  
    276283         DO jk = 1, jpkm1 
    277284            !                    !==  Vertical tracer gradient at level jk and jk+1 
    278             DO_2D( 1, 1, 1, 1 ) 
     285            DO_2D( iij, iij, iij, iij ) 
    279286               zdkt3d(ji,jj,1) = ( pt(ji,jj,jk,jn) - pt(ji,jj,jk+1,jn) ) * tmask(ji,jj,jk+1) 
    280287            END_2D 
    … …  
    283290            IF( jk == 1 ) THEN   ;   zdkt3d(:,:,0) = zdkt3d(:,:,1) 
    284291            ELSE 
    285                DO_2D( 1, 1, 1, 1 ) 
     292               DO_2D( iij, iij, iij, iij ) 
    286293                  zdkt3d(ji,jj,0) = ( pt(ji,jj,jk-1,jn) - pt(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 
    287294               END_2D 
    … …  
    289296            ! 
    290297            zaei_slp = 0._wp 
     298            zaei_slp_ip1 = 0._wp 
     299            zaei_slp_jp1 = 0._wp 
     300            zaei_slp1 = 0._wp 
    291301            ! 
    292302            IF( ln_botmix_triad ) THEN 
    293                DO ip = 0, 1              !==  Horizontal & vertical fluxes 
    294                   DO kp = 0, 1 
    295                      DO_2D( 1, 0, 1, 0 ) 
    296                         ze1ur = r1_e1u(ji,jj) 
    297                         zdxt  = zdit(ji,jj,jk) * ze1ur 
    298                         ze3wr = 1._wp / e3w(ji+ip,jj,jk+kp,Kmm) 
    299                         zdzt  = zdkt3d(ji+ip,jj,kp) * ze3wr 
    300                         zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp) 
    301                         zslope_iso  = triadi  (ji+ip,jj,jk,1-ip,kp) 
    302                         ! 
    303                         zbu = 0.25_wp * e1e2u(ji,jj) * e3u(ji,jj,jk,Kmm) 
    304                         ! ln_botmix_triad is .T. don't mask zah for bottom half cells    !!gm ?????   ahu is masked.... 
    305                         zah = pahu(ji,jj,jk) 
    306                         zah_slp  = zah * zslope_iso 
    307                         IF( ln_ldfeiv )   zaei_slp = aeiu(ji,jj,jk) * zslope_skew 
    308                         zftu(ji   ,jj,jk   ) = zftu(ji   ,jj,jk   ) - ( zah * zdxt + (zah_slp - zaei_slp) * zdzt ) * zbu * ze1ur 
    309                         ztfw(ji+ip,jj,jk+kp) = ztfw(ji+ip,jj,jk+kp) - ( zah_slp + zaei_slp) * zdxt                 * zbu * ze3wr 
    310                      END_2D 
    311                   END DO 
     303               DO kp = 0, 1              !==  Horizontal & vertical fluxes 
     304                  DO_2D( iij, iij-1, iij, iij-1 ) 
     305                     ze1ur = r1_e1u(ji,jj) 
     306                     zdxt  = zdit(ji,jj,jk) * ze1ur 
     307                     zdxt_ip1  = zdit(ji+1,jj,jk) * r1_e1u(ji+1,jj) 
     308                     ze3wr = 1._wp / e3w(ji,jj,jk+kp,Kmm) 
     309                     ze3wr_ip1 = 1._wp / e3w(ji+1,jj,jk+kp,Kmm) 
     310                     zdzt  = zdkt3d(ji,jj,kp) * ze3wr 
     311                     zdzt_ip1  = zdkt3d(ji+1,jj,kp) * ze3wr_ip1 
     312                     ! 
     313                     zbu = 0.25_wp * e1e2u(ji,jj) * e3u(ji,jj,jk,Kmm) 
     314                     zbu_ip1 = 0.25_wp * e1e2u(ji+1,jj) * e3u(ji+1,jj,jk,Kmm) 
     315                     ! ln_botmix_triad is .T. don't mask zah for bottom half cells    !!gm ?????   ahu is masked.... 
     316                     zah = pahu(ji,jj,jk) 
     317                     zah_ip1 = pahu(ji+1,jj,jk) 
     318                     zah_slp  = zah * triadi(ji,jj,jk,1,kp) 
     319                     zah_slp_ip1  = zah_ip1 * triadi(ji+1,jj,jk,1,kp) 
     320                     zah_slp1  = zah * triadi(ji+1,jj,jk,0,kp) 
     321                     IF( ln_ldfeiv )   THEN 
     322                        zaei_slp = aeiu(ji,jj,jk) * triadi_g(ji,jj,jk,1,kp) 
     323                        zaei_slp_ip1 = aeiu(ji+1,jj,jk) * triadi_g(ji+1,jj,jk,1,kp) 
     324                        zaei_slp1 = aeiu(ji,jj,jk) * triadi_g(ji+1,jj,jk,0,kp) 
     325                     ENDIF 
     326                     ! round brackets added to fix the order of floating point operations 
     327                     ! needed to ensure halo 1 - halo 2 compatibility 
     328                     zftu(ji   ,jj,jk  ) =  zftu(ji   ,jj,jk )                                                               & 
     329                                         &    - ( ( zah * zdxt + ( zah_slp - zaei_slp ) * zdzt ) * zbu * ze1ur               & 
     330                                         &      + ( zah * zdxt + zah_slp1 * zdzt_ip1 - zaei_slp1 * zdzt_ip1 ) * zbu * ze1ur  & 
     331                                         &      )                                                                            ! bracket for halo 1 - halo 2 compatibility 
     332                     ztfw(ji+1,jj,jk+kp) =  ztfw(ji+1,jj,jk+kp)                                                              & 
     333                                         &    - ( (zah_slp_ip1 + zaei_slp_ip1) * zdxt_ip1 * zbu_ip1 * ze3wr_ip1              & 
     334                                         &      + ( zah_slp1 + zaei_slp1) * zdxt * zbu * ze3wr_ip1                           & 
     335                                         &      )                                                                            ! bracket for halo 1 - halo 2 compatibility 
     336                  END_2D 
    312337               END DO 
    313338               ! 
    314                DO jp = 0, 1 
    315                   DO kp = 0, 1 
    316                      DO_2D( 1, 0, 1, 0 ) 
    317                         ze2vr = r1_e2v(ji,jj) 
    318                         zdyt  = zdjt(ji,jj,jk) * ze2vr 
    319                         ze3wr = 1._wp / e3w(ji,jj+jp,jk+kp,Kmm) 
    320                         zdzt  = zdkt3d(ji,jj+jp,kp) * ze3wr 
    321                         zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp) 
    322                         zslope_iso  = triadj(ji,jj+jp,jk,1-jp,kp) 
    323                         zbv = 0.25_wp * e1e2v(ji,jj) * e3v(ji,jj,jk,Kmm) 
    324                         ! ln_botmix_triad is .T. don't mask zah for bottom half cells    !!gm ?????  ahv is masked... 
    325                         zah = pahv(ji,jj,jk) 
    326                         zah_slp = zah * zslope_iso 
    327                         IF( ln_ldfeiv )   zaei_slp = aeiv(ji,jj,jk) * zslope_skew 
    328                         zftv(ji,jj   ,jk   ) = zftv(ji,jj   ,jk   ) - ( zah * zdyt + (zah_slp - zaei_slp) * zdzt ) * zbv * ze2vr 
    329                         ztfw(ji,jj+jp,jk+kp) = ztfw(ji,jj+jp,jk+kp) - ( zah_slp + zaei_slp ) * zdyt                * zbv * ze3wr 
    330                      END_2D 
    331                   END DO 
     339               DO kp = 0, 1 
     340                  DO_2D( iij, iij-1, iij, iij-1 ) 
     341                     ze2vr = r1_e2v(ji,jj) 
     342                     zdyt  = zdjt(ji,jj,jk) * ze2vr 
     343                     zdyt_jp1  = zdjt(ji,jj+1,jk) * r1_e2v(ji,jj+1) 
     344                     ze3wr = 1._wp / e3w(ji,jj,jk+kp,Kmm) 
     345                     ze3wr_jp1 = 1._wp / e3w(ji,jj+1,jk+kp,Kmm) 
     346                     zdzt  = zdkt3d(ji,jj,kp) * ze3wr 
     347                     zdzt_jp1  = zdkt3d(ji,jj+1,kp) * ze3wr_jp1 
     348                     zbv = 0.25_wp * e1e2v(ji,jj) * e3v(ji,jj,jk,Kmm) 
     349                     zbv_jp1 = 0.25_wp * e1e2v(ji,jj+1) * e3v(ji,jj+1,jk,Kmm) 
     350                     ! ln_botmix_triad is .T. don't mask zah for bottom half cells    !!gm ?????   ahu is masked.... 
     351                     zah = pahv(ji,jj,jk)          ! pahv(ji,jj+jp,jk)  ???? 
     352                     zah_jp1 = pahv(ji,jj+1,jk) 
     353                     zah_slp = zah * triadj(ji,jj,jk,1,kp) 
     354                     zah_slp1 = zah * triadj(ji,jj+1,jk,0,kp) 
     355                     zah_slp_jp1 = zah_jp1 * triadj(ji,jj+1,jk,1,kp) 
     356                     IF( ln_ldfeiv )   THEN 
     357                        zaei_slp = aeiv(ji,jj,jk) * triadj_g(ji,jj,jk,1,kp) 
     358                        zaei_slp_jp1 = aeiv(ji,jj+1,jk) * triadj_g(ji,jj+1,jk,1,kp) 
     359                        zaei_slp1 = aeiv(ji,jj,jk) * triadj_g(ji,jj+1,jk,0,kp) 
     360                     ENDIF 
     361                     ! round brackets added to fix the order of floating point operations 
     362                     ! needed to ensure halo 1 - halo 2 compatibility 
     363                     zftv(ji,jj  ,jk   ) =  zftv(ji,jj  ,jk   )                                                              & 
     364                                         &    - ( ( zah * zdyt + ( zah_slp - zaei_slp ) * zdzt ) * zbv * ze2vr               & 
     365                                         &      + ( zah * zdyt + zah_slp1 * zdzt_jp1 - zaei_slp1 * zdzt_jp1 ) * zbv * ze2vr  & 
     366                                         &      )                                                                            ! bracket for halo 1 - halo 2 compatibility 
     367                     ztfw(ji,jj+1,jk+kp) =  ztfw(ji,jj+1,jk+kp)                                                              & 
     368                                         &    - ( ( zah_slp_jp1 + zaei_slp_jp1) * zdyt_jp1 * zbv_jp1 * ze3wr_jp1             & 
     369                                         &      + ( zah_slp1 + zaei_slp1) * zdyt * zbv * ze3wr_jp1                           & 
     370                                         &      )                                                                            ! bracket for halo 1 - halo 2 compatibility 
     371                  END_2D 
    332372               END DO 
    333373               ! 
    334374            ELSE 
    335375               ! 
    336                DO ip = 0, 1               !==  Horizontal & vertical fluxes 
    337                   DO kp = 0, 1 
    338                      DO_2D( 1, 0, 1, 0 ) 
    339                         ze1ur = r1_e1u(ji,jj) 
    340                         zdxt  = zdit(ji,jj,jk) * ze1ur 
    341                         ze3wr = 1._wp / e3w(ji+ip,jj,jk+kp,Kmm) 
    342                         zdzt  = zdkt3d(ji+ip,jj,kp) * ze3wr 
    343                         zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp) 
    344                         zslope_iso  = triadi(ji+ip,jj,jk,1-ip,kp) 
    345                         ! 
    346                         zbu = 0.25_wp * e1e2u(ji,jj) * e3u(ji,jj,jk,Kmm) 
    347                         ! ln_botmix_triad is .F. mask zah for bottom half cells 
    348                         zah = pahu(ji,jj,jk) * umask(ji,jj,jk+kp)         ! pahu(ji+ip,jj,jk)   ===>>  ???? 
    349                         zah_slp  = zah * zslope_iso 
    350                         IF( ln_ldfeiv )   zaei_slp = aeiu(ji,jj,jk) * zslope_skew        ! aeit(ji+ip,jj,jk)*zslope_skew 
    351                         zftu(ji   ,jj,jk   ) = zftu(ji   ,jj,jk   ) - ( zah * zdxt + (zah_slp - zaei_slp) * zdzt ) * zbu * ze1ur 
    352                         ztfw(ji+ip,jj,jk+kp) = ztfw(ji+ip,jj,jk+kp) - (zah_slp + zaei_slp) * zdxt * zbu * ze3wr 
    353                      END_2D 
    354                   END DO 
     376               DO kp = 0, 1               !==  Horizontal & vertical fluxes 
     377                  DO_2D( iij, iij-1, iij, iij-1 ) 
     378                     ze1ur = r1_e1u(ji,jj) 
     379                     zdxt  = zdit(ji,jj,jk) * ze1ur 
     380                     zdxt_ip1  = zdit(ji+1,jj,jk) * r1_e1u(ji+1,jj) 
     381                     ze3wr = 1._wp / e3w(ji,jj,jk+kp,Kmm) 
     382                     ze3wr_ip1 = 1._wp / e3w(ji+1,jj,jk+kp,Kmm) 
     383                     zdzt  = zdkt3d(ji,jj,kp) * ze3wr 
     384                     zdzt_ip1  = zdkt3d(ji+1,jj,kp) * ze3wr_ip1 
     385                     ! 
     386                     zbu = 0.25_wp * e1e2u(ji,jj) * e3u(ji,jj,jk,Kmm) 
     387                     zbu_ip1 = 0.25_wp * e1e2u(ji+1,jj) * e3u(ji+1,jj,jk,Kmm) 
     388                     ! ln_botmix_triad is .F. mask zah for bottom half cells 
     389                     zah = pahu(ji,jj,jk) * umask(ji,jj,jk+kp)         ! pahu(ji+ip,jj,jk)   ===>>  ???? 
     390                     zah_ip1 = pahu(ji+1,jj,jk) * umask(ji+1,jj,jk+kp) 
     391                     zah_slp  = zah * triadi(ji,jj,jk,1,kp) 
     392                     zah_slp_ip1  = zah_ip1 * triadi(ji+1,jj,jk,1,kp) 
     393                     zah_slp1  = zah * triadi(ji+1,jj,jk,0,kp) 
     394                     IF( ln_ldfeiv )   THEN 
     395                        zaei_slp = aeiu(ji,jj,jk) * triadi_g(ji,jj,jk,1,kp) 
     396                        zaei_slp_ip1 = aeiu(ji+1,jj,jk) * triadi_g(ji+1,jj,jk,1,kp) 
     397                        zaei_slp1 = aeiu(ji,jj,jk) * triadi_g(ji+1,jj,jk,0,kp) 
     398                     ENDIF 
     399                     ! round brackets added to fix the order of floating point operations 
     400                     ! needed to ensure halo 1 - halo 2 compatibility 
     401                     zftu(ji   ,jj,jk  ) =  zftu(ji   ,jj,jk )                                                               & 
     402                                         &    - ( ( zah * zdxt + ( zah_slp - zaei_slp ) * zdzt ) * zbu * ze1ur               & 
     403                                         &      + ( zah * zdxt + zah_slp1 * zdzt_ip1 - zaei_slp1 * zdzt_ip1 ) * zbu * ze1ur  & 
     404                                         &      )                                                                            ! bracket for halo 1 - halo 2 compatibility 
     405                     ztfw(ji+1,jj,jk+kp) =  ztfw(ji+1,jj,jk+kp)                                                              & 
     406                                         &    - ( (zah_slp_ip1 + zaei_slp_ip1) * zdxt_ip1 * zbu_ip1 * ze3wr_ip1              & 
     407                                         &      + ( zah_slp1 + zaei_slp1) * zdxt * zbu * ze3wr_ip1                           & 
     408                                         &      )                                                                            ! bracket for halo 1 - halo 2 compatibility 
     409                  END_2D 
    355410               END DO 
    356411               ! 
    357                DO jp = 0, 1 
    358                   DO kp = 0, 1 
    359                      DO_2D( 1, 0, 1, 0 ) 
    360                         ze2vr = r1_e2v(ji,jj) 
    361                         zdyt  = zdjt(ji,jj,jk) * ze2vr 
    362                         ze3wr = 1._wp / e3w(ji,jj+jp,jk+kp,Kmm) 
    363                         zdzt  = zdkt3d(ji,jj+jp,kp) * ze3wr 
    364                         zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp) 
    365                         zslope_iso  = triadj(ji,jj+jp,jk,1-jp,kp) 
    366                         zbv = 0.25_wp * e1e2v(ji,jj) * e3v(ji,jj,jk,Kmm) 
    367                         ! ln_botmix_triad is .F. mask zah for bottom half cells 
    368                         zah = pahv(ji,jj,jk) * vmask(ji,jj,jk+kp)         ! pahv(ji,jj+jp,jk)  ???? 
    369                         zah_slp = zah * zslope_iso 
    370                         IF( ln_ldfeiv )   zaei_slp = aeiv(ji,jj,jk) * zslope_skew        ! aeit(ji,jj+jp,jk)*zslope_skew 
    371                         zftv(ji,jj,jk) = zftv(ji,jj,jk) - ( zah * zdyt + (zah_slp - zaei_slp) * zdzt ) * zbv * ze2vr 
    372                         ztfw(ji,jj+jp,jk+kp) = ztfw(ji,jj+jp,jk+kp) - (zah_slp + zaei_slp) * zdyt * zbv * ze3wr 
    373                      END_2D 
    374                   END DO 
     412               DO kp = 0, 1 
     413                  DO_2D( iij, iij-1, iij, iij-1 ) 
     414                     ze2vr = r1_e2v(ji,jj) 
     415                     zdyt  = zdjt(ji,jj,jk) * ze2vr 
     416                     zdyt_jp1  = zdjt(ji,jj+1,jk) * r1_e2v(ji,jj+1) 
     417                     ze3wr = 1._wp / e3w(ji,jj,jk+kp,Kmm) 
     418                     ze3wr_jp1 = 1._wp / e3w(ji,jj+1,jk+kp,Kmm) 
     419                     zdzt  = zdkt3d(ji,jj,kp) * ze3wr 
     420                     zdzt_jp1  = zdkt3d(ji,jj+1,kp) * ze3wr_jp1 
     421                     zbv = 0.25_wp * e1e2v(ji,jj) * e3v(ji,jj,jk,Kmm) 
     422                     zbv_jp1 = 0.25_wp * e1e2v(ji,jj+1) * e3v(ji,jj+1,jk,Kmm) 
     423                     ! ln_botmix_triad is .F. mask zah for bottom half cells 
     424                     zah = pahv(ji,jj,jk) * vmask(ji,jj,jk+kp)         ! pahv(ji,jj+jp,jk)  ???? 
     425                     zah_jp1 = pahv(ji,jj+1,jk) * vmask(ji,jj+1,jk+kp) 
     426                     zah_slp = zah * triadj(ji,jj,jk,1,kp) 
     427                     zah_slp1 = zah * triadj(ji,jj+1,jk,0,kp) 
     428                     zah_slp_jp1 = zah_jp1 * triadj(ji,jj+1,jk,1,kp) 
     429                     IF( ln_ldfeiv )   THEN 
     430                        zaei_slp = aeiv(ji,jj,jk) * triadj_g(ji,jj,jk,1,kp) 
     431                        zaei_slp_jp1 = aeiv(ji,jj+1,jk) * triadj_g(ji,jj+1,jk,1,kp) 
     432                        zaei_slp1 = aeiv(ji,jj,jk) * triadj_g(ji,jj+1,jk,0,kp) 
     433                     ENDIF 
     434                     ! round brackets added to fix the order of floating point operations 
     435                     ! needed to ensure halo 1 - halo 2 compatibility 
     436                     zftv(ji,jj  ,jk   ) =  zftv(ji,jj  ,jk   )                                                              & 
     437                                         &    - ( ( zah * zdyt + ( zah_slp - zaei_slp ) * zdzt ) * zbv * ze2vr               & 
     438                                         &      + ( zah * zdyt + zah_slp1 * zdzt_jp1 - zaei_slp1 * zdzt_jp1 ) * zbv * ze2vr  & 
     439                                         &      )                                                                            ! bracket for halo 1 - halo 2 compatibility 
     440                     ztfw(ji,jj+1,jk+kp) =  ztfw(ji,jj+1,jk+kp)                                                              & 
     441                                         &    - ( ( zah_slp_jp1 + zaei_slp_jp1) * zdyt_jp1 * zbv_jp1 * ze3wr_jp1             & 
     442                                         &      + ( zah_slp1 + zaei_slp1) * zdyt * zbv * ze3wr_jp1                           & 
     443                                         &      )                                                                            ! bracket for halo 1 - halo 2 compatibility 
     444                  END_2D 
    375445               END DO 
    376446            ENDIF 
    377447            !                             !==  horizontal divergence and add to the general trend  ==! 
    378             DO_2D( 0, 0, 0, 0 ) 
    379                pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn)    & 
    380                   &                       + zsign * (  zftu(ji-1,jj  ,jk) - zftu(ji,jj,jk)       & 
    381                   &                                           + zftv(ji,jj-1,jk) - zftv(ji,jj,jk)   )   & 
    382                   &                                        / (  e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm)  ) 
     448            DO_2D( iij-1, iij-1, iij-1, iij-1 ) 
     449               ! round brackets added to fix the order of floating point operations 
     450               ! needed to ensure halo 1 - halo 2 compatibility 
     451               pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn)                                                & 
     452                  &                       + zsign * ( ( zftu(ji-1,jj  ,jk) - zftu(ji,jj,jk)             & 
     453                  &                                   )                                                 & ! bracket for halo 1 - halo 2 compatibility 
     454                  &                                 + ( zftv(ji,jj-1,jk) - zftv(ji,jj,jk)               & 
     455                  &                                   )                                                 & ! bracket for halo 1 - halo 2 compatibility 
     456                  &                                 ) / (  e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm)  ) 
    383457            END_2D 
    384458            ! 
    … …  
    387461         !                                !==  add the vertical 33 flux  ==! 
    388462         IF( ln_traldf_lap ) THEN               ! laplacian case: eddy coef = ah_wslp2 - akz 
    389             DO_3D( 0, 0, 1, 0, 2, jpkm1 ) 
     463            DO_3D( iij-1, iij-1, iij-1, iij-1, 2, jpkm1 ) 
    390464               ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk)   & 
    391465                  &                            * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) )             & 
    … …  
    395469            SELECT CASE( kpass ) 
    396470            CASE(  1  )                            ! 1st pass : eddy coef = ah_wslp2 
    397                DO_3D( 0, 0, 1, 0, 2, jpkm1 ) 
     471               DO_3D( iij-1, iij-1, iij-1, iij-1, 2, jpkm1 ) 
    398472                  ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk)             & 
    399473                     &                            * ah_wslp2(ji,jj,jk) * ( pt(ji,jj,jk-1,jn) - pt(ji,jj,jk,jn) ) 
    400474               END_3D 
    401475            CASE(  2  )                            ! 2nd pass : eddy flux = ah_wslp2 and akz applied on pt  and pt2 gradients, resp. 
    402                DO_3D( 0, 0, 1, 0, 2, jpkm1 ) 
     476               DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    403477                  ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk)                      & 
    404478                     &                            * (  ah_wslp2(ji,jj,jk) * ( pt (ji,jj,jk-1,jn) - pt (ji,jj,jk,jn) )   & 
    … …  
    408482         ENDIF 
    409483         ! 
    410          DO_3D( 0, 0, 0, 0, 1, jpkm1 )      !==  Divergence of vertical fluxes added to pta  ==! 
     484         DO_3D( iij-1, iij-1, iij-1, iij-1, 1, jpkm1 )      !==  Divergence of vertical fluxes added to pta  ==! 
    411485            pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn)    & 
    412486            &                                  + zsign * (  ztfw(ji,jj,jk+1) - ztfw(ji,jj,jk)  )   & 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/TRA/tramle.F90

    r14789 r14852  
    8787      INTEGER                     , INTENT(in   ) ::   Kmm        ! ocean time level index 
    8888      CHARACTER(len=3)            , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator) 
    89       REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(inout) ::   pu         ! in : 3 ocean transport components 
    90       REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(inout) ::   pv         ! out: same 3  transport components 
    91       REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(inout) ::   pw         !   increased by the MLE induced transport 
     89      ! TEMP: [tiling] Can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct 
     90      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu         ! in : 3 ocean transport components 
     91      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pv         ! out: same 3  transport components 
     92      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pw         !   increased by the MLE induced transport 
    9293      ! 
    9394      INTEGER  ::   ji, jj, jk          ! dummy loop indices 
    … …  
    9697      REAL(wp) ::   zcvw, zmvw          !   -      - 
    9798      INTEGER , DIMENSION(A2D(nn_hls))     :: inml_mle 
    98       REAL(wp), DIMENSION(A2D(nn_hls))     :: zpsim_u, zpsim_v, zmld, zbm, zhu, zhv, zn2, zLf_MH 
     99      REAL(wp), DIMENSION(A2D(nn_hls))     :: zpsim_u, zpsim_v, zmld, zbm, zhu, zhv, zn2, zLf_NH, zLf_MH 
    99100      REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zpsi_uw, zpsi_vw 
    100       ! TEMP: [tiling] These changes not necessary if using XIOS (subdomain support) 
    101       REAL(wp), DIMENSION(:,:),   ALLOCATABLE, SAVE :: zLf_NH 
    102       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: zpsiu_mle, zpsiv_mle 
    103101      !!---------------------------------------------------------------------- 
    104102      ! 
    … …  
    110108         SELECT CASE( nn_mld_uv )                         ! MLD at u- & v-pts 
    111109         CASE ( 0 )                                               != min of the 2 neighbour MLDs 
    112             DO_2D( 1, 0, 1, 0 ) 
     110            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    113111               zhu(ji,jj) = MIN( hmle(ji+1,jj), hmle(ji,jj) ) 
    114112               zhv(ji,jj) = MIN( hmle(ji,jj+1), hmle(ji,jj) ) 
    115113            END_2D 
    116114         CASE ( 1 )                                               != average of the 2 neighbour MLDs 
    117             DO_2D( 1, 0, 1, 0 ) 
     115            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    118116               zhu(ji,jj) = MAX( hmle(ji+1,jj), hmle(ji,jj) ) 
    119117               zhv(ji,jj) = MAX( hmle(ji,jj+1), hmle(ji,jj) ) 
    120118            END_2D 
    121119         CASE ( 2 )                                               != max of the 2 neighbour MLDs 
    122             DO_2D( 1, 0, 1, 0 ) 
     120            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    123121               zhu(ji,jj) = MAX( hmle(ji+1,jj), hmle(ji,jj) ) 
    124122               zhv(ji,jj) = MAX( hmle(ji,jj+1), hmle(ji,jj) ) 
    … …  
    126124         END SELECT 
    127125         IF( nn_mle == 0 ) THEN           ! Fox-Kemper et al. 2010 formulation 
    128             DO_2D( 1, 0, 1, 0 ) 
     126            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    129127               zpsim_u(ji,jj) = rn_ce * zhu(ji,jj) * zhu(ji,jj)  * e2u(ji,jj)                                            & 
    130128                    &           * dbdx_mle(ji,jj) * MIN( 111.e3_wp , e1u(ji,jj) )   & 
    … …  
    137135            ! 
    138136         ELSEIF( nn_mle == 1 ) THEN       ! New formulation (Lf = 5km fo/ff with fo=Coriolis parameter at latitude rn_lat) 
    139             DO_2D( 1, 0, 1, 0 ) 
     137            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    140138               zpsim_u(ji,jj) = rc_f *   zhu(ji,jj)   * zhu(ji,jj)   * e2u(ji,jj)               & 
    141139                    &                  * dbdx_mle(ji,jj) * MIN( 111.e3_wp , e1u(ji,jj) ) 
    … …  
    149147         !                                      !==  MLD used for MLE  ==! 
    150148         !                                                ! compute from the 10m density to deal with the diurnal cycle 
    151          DO_2D( 1, 1, 1, 1 ) 
     149         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    152150            inml_mle(ji,jj) = mbkt(ji,jj) + 1                    ! init. to number of ocean w-level (T-level + 1) 
    153151         END_2D 
    154152         IF ( nla10 > 0 ) THEN                            ! avoid case where first level is thicker than 10m 
    155            DO_3DS( 1, 1, 1, 1, jpkm1, nlb10, -1 )        ! from the bottom to nlb10 (10m) 
     153           DO_3DS( nn_hls, nn_hls, nn_hls, nn_hls, jpkm1, nlb10, -1 )        ! from the bottom to nlb10 (10m) 
    156154              IF( rhop(ji,jj,jk) > rhop(ji,jj,nla10) + rn_rho_c_mle )   inml_mle(ji,jj) = jk      ! Mixed layer 
    157155           END_3D 
    … …  
    163161         zbm (:,:) = 0._wp 
    164162         zn2 (:,:) = 0._wp 
    165          DO_3D( 1, 1, 1, 1, 1, ikmax )                    ! MLD and mean buoyancy and N2 over the mixed layer 
     163         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, ikmax )                    ! MLD and mean buoyancy and N2 over the mixed layer 
    166164            zc = e3t(ji,jj,jk,Kmm) * REAL( MIN( MAX( 0, inml_mle(ji,jj)-jk ) , 1  )  )    ! zc being 0 outside the ML t-points 
    167165            zmld(ji,jj) = zmld(ji,jj) + zc 
    … …  
    172170         SELECT CASE( nn_mld_uv )                         ! MLD at u- & v-pts 
    173171         CASE ( 0 )                                               != min of the 2 neighbour MLDs 
    174             DO_2D( 1, 0, 1, 0 ) 
     172            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    175173               zhu(ji,jj) = MIN( zmld(ji+1,jj), zmld(ji,jj) ) 
    176174               zhv(ji,jj) = MIN( zmld(ji,jj+1), zmld(ji,jj) ) 
    177175            END_2D 
    178176         CASE ( 1 )                                               != average of the 2 neighbour MLDs 
    179             DO_2D( 1, 0, 1, 0 ) 
     177            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    180178               zhu(ji,jj) = ( zmld(ji+1,jj) + zmld(ji,jj) ) * 0.5_wp 
    181179               zhv(ji,jj) = ( zmld(ji,jj+1) + zmld(ji,jj) ) * 0.5_wp 
    182180            END_2D 
    183181         CASE ( 2 )                                               != max of the 2 neighbour MLDs 
    184             DO_2D( 1, 0, 1, 0 ) 
     182            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    185183               zhu(ji,jj) = MAX( zmld(ji+1,jj), zmld(ji,jj) ) 
    186184               zhv(ji,jj) = MAX( zmld(ji,jj+1), zmld(ji,jj) ) 
    … …  
    188186         END SELECT 
    189187         !                                                ! convert density into buoyancy 
    190          DO_2D( 1, 1, 1, 1 ) 
     188         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    191189            zbm(ji,jj) = + grav * zbm(ji,jj) / MAX( e3t(ji,jj,1,Kmm), zmld(ji,jj) ) 
    192190         END_2D 
    … …  
    201199         ! 
    202200         IF( nn_mle == 0 ) THEN           ! Fox-Kemper et al. 2010 formulation 
    203             DO_2D( 1, 0, 1, 0 ) 
     201            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    204202               zpsim_u(ji,jj) = rn_ce * zhu(ji,jj) * zhu(ji,jj)  * e2_e1u(ji,jj)                                            & 
    205203                    &           * ( zbm(ji+1,jj) - zbm(ji,jj) ) * MIN( 111.e3_wp , e1u(ji,jj) )   & 
    … …  
    212210            ! 
    213211         ELSEIF( nn_mle == 1 ) THEN       ! New formulation (Lf = 5km fo/ff with fo=Coriolis parameter at latitude rn_lat) 
    214             DO_2D( 1, 0, 1, 0 ) 
     212            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    215213               zpsim_u(ji,jj) = rc_f *   zhu(ji,jj)   * zhu(ji,jj)   * e2_e1u(ji,jj)               & 
    216214                    &                  * ( zbm(ji+1,jj) - zbm(ji,jj) ) * MIN( 111.e3_wp , e1u(ji,jj) ) 
    … …  
    222220         ! 
    223221         IF( nn_conv == 1 ) THEN              ! No MLE in case of convection 
    224             DO_2D( 1, 0, 1, 0 ) 
     222            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    225223               IF( MIN( zn2(ji,jj) , zn2(ji+1,jj) ) < 0._wp )   zpsim_u(ji,jj) = 0._wp 
    226224               IF( MIN( zn2(ji,jj) , zn2(ji,jj+1) ) < 0._wp )   zpsim_v(ji,jj) = 0._wp 
    … …  
    230228      ENDIF  ! end of ln_osm_mle conditional 
    231229    !                                      !==  structure function value at uw- and vw-points  ==! 
    232     DO_2D( 1, 0, 1, 0 ) 
     230    DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    233231       zhu(ji,jj) = 1._wp / MAX(zhu(ji,jj), rsmall)                   ! hu --> 1/hu 
    234232       zhv(ji,jj) = 1._wp / MAX(zhv(ji,jj), rsmall)  
    … …  
    238236    zpsi_vw(:,:,:) = 0._wp 
    239237    ! 
    240       DO_3D( 1, 0, 1, 0, 2, ikmax )                ! start from 2 : surface value = 0 
     238      DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 2, ikmax )                ! start from 2 : surface value = 0 
     239       
    241240         zcuw = 1._wp - ( gdepw(ji+1,jj,jk,Kmm) + gdepw(ji,jj,jk,Kmm) ) * zhu(ji,jj) 
    242241         zcvw = 1._wp - ( gdepw(ji,jj+1,jk,Kmm) + gdepw(ji,jj,jk,Kmm) ) * zhv(ji,jj) 
    … …  
    252251      !                                      !==  transport increased by the MLE induced transport ==! 
    253252      DO jk = 1, ikmax 
    254          DO_2D( 1, 0, 1, 0 )                      ! CAUTION pu,pv must be defined at row/column i=1 / j=1 
     253         DO_2D_OVR( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    255254            pu(ji,jj,jk) = pu(ji,jj,jk) + ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji,jj,jk+1) ) 
    256255            pv(ji,jj,jk) = pv(ji,jj,jk) + ( zpsi_vw(ji,jj,jk) - zpsi_vw(ji,jj,jk+1) ) 
    257256         END_2D 
    258          DO_2D( 0, 0, 0, 0 ) 
     257         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    259258            pw(ji,jj,jk) = pw(ji,jj,jk) - ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji-1,jj,jk)   & 
    260259               &                          + zpsi_vw(ji,jj,jk) - zpsi_vw(ji,jj-1,jk) ) * wmask(ji,jj,1) 
    … …  
    262261      END DO 
    263262 
    264       ! TEMP: [tiling] These changes not necessary if using XIOS (subdomain support) 
    265263      IF( cdtype == 'TRA') THEN              !==  outputs  ==! 
    266          IF( ntile == 0 .OR. ntile == 1 ) THEN                             ! Do only on the first tile 
    267             ALLOCATE( zLf_NH(jpi,jpj), zpsiu_mle(jpi,jpj,jpk), zpsiv_mle(jpi,jpj,jpk) ) 
    268             zpsiu_mle(:,:,:) = 0._wp ; zpsiv_mle(:,:,:) = 0._wp 
    269          ENDIF 
    270264         ! 
    271265         IF (ln_osm_mle.and.ln_zdfosm) THEN 
    … …  
    279273         ENDIF 
    280274         ! 
     275         CALL iom_put( "Lf_NHpf" , zLf_NH  )    ! Lf = N H / f 
     276         ! 
    281277         ! divide by cross distance to give streamfunction with dimensions m^2/s 
    282278         DO_3D( 0, 0, 0, 0, 1, ikmax+1 ) 
    283             zpsiu_mle(ji,jj,jk) = zpsi_uw(ji,jj,jk) * r1_e2u(ji,jj) 
    284             zpsiv_mle(ji,jj,jk) = zpsi_vw(ji,jj,jk) * r1_e1v(ji,jj) 
     279            zpsi_uw(ji,jj,jk) = zpsi_uw(ji,jj,jk) * r1_e2u(ji,jj) 
     280            zpsi_vw(ji,jj,jk) = zpsi_vw(ji,jj,jk) * r1_e1v(ji,jj) 
    285281         END_3D 
    286  
    287          IF( ntile == 0 .OR. ntile == nijtile ) THEN                       ! Do only on the last tile 
    288             CALL iom_put( "Lf_NHpf" , zLf_NH  )    ! Lf = N H / f 
    289             CALL iom_put( "psiu_mle", zpsiu_mle )    ! i-mle streamfunction 
    290             CALL iom_put( "psiv_mle", zpsiv_mle )    ! j-mle streamfunction 
    291             DEALLOCATE( zLf_NH, zpsiu_mle, zpsiv_mle ) 
    292          ENDIF 
     282         CALL iom_put( "psiu_mle", zpsi_uw )    ! i-mle streamfunction 
     283         CALL iom_put( "psiv_mle", zpsi_vw )    ! j-mle streamfunction 
    293284      ENDIF 
    294285      ! 
    … …  
    375366         r1_ft(:,:) = 1._wp / SQRT(  ff_t(:,:) * ff_t(:,:) + z1_t2  ) 
    376367         ! 
     368         ! Specifically, dbdx_mle, dbdy_mle and mld_prof need to be defined for nn_hls = 2 
     369         IF( nn_hls == 2 .AND. ln_osm_mle .AND. ln_zdfosm ) THEN 
     370            CALL ctl_stop('nn_hls = 2 cannot be used with ln_mle = ln_osm_mle = ln_zdfosm = T (zdfosm not updated for nn_hls = 2)') 
     371         ENDIF 
    377372      ENDIF 
    378373      ! 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/TRA/tranpc.F90

    r14789 r14852  
    1717   USE oce            ! ocean dynamics and active tracers 
    1818   USE dom_oce        ! ocean space and time domain 
    19    ! TEMP: [tiling] This change not necessary after extra haloes development (lbc_lnk removed) 
    20    USE domtile 
    2119   USE phycst         ! physical constants 
    2220   USE zdf_oce        ! ocean vertical physics 
    … …  
    8179      LOGICAL, PARAMETER :: l_LB_debug = .FALSE. ! set to true if you want to follow what is 
    8280      INTEGER :: ilc1, jlc1, klc1, nncpu         ! actually happening in a water column at point "ilc1, jlc1" 
    83       INTEGER :: isi, isj, iei, iej 
    8481      LOGICAL :: lp_monitor_point = .FALSE.      ! in CPU domain "nncpu" 
    8582      !!---------------------------------------------------------------------- 
    … …  
    105102         CALL bn2    ( pts(:,:,:,:,Kaa), zab, zn2, Kmm )    ! after Brunt-Vaisala  (given on W-points) 
    106103         ! 
    107          IF( ntile == 0 .OR. ntile == 1 ) nnpcc = 0         ! Do only on the first tile 
    108          ! 
    109          IF( ntsi == Nis0 ) THEN ; isi = nn_hls ; ELSE ; isi = 0 ; ENDIF    ! Avoid double-counting when using tiling 
    110          IF( ntsj == Njs0 ) THEN ; isj = nn_hls ; ELSE ; isj = 0 ; ENDIF 
    111          IF( ntei == Nie0 ) THEN ; iei = nn_hls ; ELSE ; iei = 0 ; ENDIF 
    112          IF( ntej == Nje0 ) THEN ; iej = nn_hls ; ELSE ; iej = 0 ; ENDIF 
    113          ! 
    114          DO_2D( isi, iei, isj, iej )                        ! interior column only 
     104         IF( .NOT. l_istiled .OR. ntile == 1 ) nnpcc = 0         ! Do only on the first tile 
     105         ! 
     106         DO_2D_OVR( 0, 0, 0, 0 )                        ! interior column only 
    115107            ! 
    116108            IF( tmask(ji,jj,2) == 1 ) THEN      ! At least 2 ocean points 
    … …  
    319311         ENDIF 
    320312         ! 
    321          IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only for the full domain 
     313         IF( .NOT. l_istiled .OR. ntile == nijtile )  THEN                ! Do only for the full domain 
    322314            IF( lwp .AND. l_LB_debug ) THEN 
    323315               WRITE(numout,*) 'Exiting tra_npc , kt = ',kt,', => numb. of statically instable water-columns: ', nnpcc 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/TRA/traqsr.F90

    r14789 r14852  
    108108      ! 
    109109      INTEGER  ::   ji, jj, jk               ! dummy loop indices 
    110       INTEGER  ::   irgb, isi, iei, isj, iej ! local integers 
     110      INTEGER  ::   irgb                    ! local integers 
    111111      REAL(wp) ::   zchl, zcoef, z1_2        ! local scalars 
    112112      REAL(wp) ::   zc0 , zc1 , zc2 , zc3    !    -         - 
    … …  
    121121      IF( ln_timing )   CALL timing_start('tra_qsr') 
    122122      ! 
    123       IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     123      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
    124124         IF( kt == nit000 ) THEN 
    125125            IF(lwp) WRITE(numout,*) 
    … …  
    137137      !                         !  before qsr induced heat content  ! 
    138138      !                         !-----------------------------------! 
    139       IF( ntsi == Nis0 ) THEN ; isi = nn_hls ; ELSE ; isi = 0 ; ENDIF    ! Avoid double-counting when using tiling 
    140       IF( ntsj == Njs0 ) THEN ; isj = nn_hls ; ELSE ; isj = 0 ; ENDIF 
    141       IF( ntei == Nie0 ) THEN ; iei = nn_hls ; ELSE ; iei = 0 ; ENDIF 
    142       IF( ntej == Nje0 ) THEN ; iej = nn_hls ; ELSE ; iej = 0 ; ENDIF 
    143  
    144139      IF( kt == nit000 ) THEN          !==  1st time step  ==! 
    145140         IF( ln_rstart .AND. .NOT.l_1st_euler ) THEN    ! read in restart 
    146141            z1_2 = 0.5_wp 
    147             IF( ntile == 0 .OR. ntile == 1 )  THEN                        ! Do only on the first tile 
     142            IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                        ! Do only on the first tile 
    148143               IF(lwp) WRITE(numout,*) '          nit000-1 qsr tracer content forcing field read in the restart file' 
    149144               CALL iom_get( numror, jpdom_auto, 'qsr_hc_b', qsr_hc_b )   ! before heat content trend due to Qsr flux 
    … …  
    151146         ELSE                                           ! No restart or Euler forward at 1st time step 
    152147            z1_2 = 1._wp 
    153             DO_3D( isi, iei, isj, iej, 1, jpk ) 
     148            DO_3D_OVR( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 
    154149               qsr_hc_b(ji,jj,jk) = 0._wp 
    155150            END_3D 
    … …  
    157152      ELSE                             !==  Swap of qsr heat content  ==! 
    158153         z1_2 = 0.5_wp 
    159          DO_3D( isi, iei, isj, iej, 1, jpk ) 
     154         DO_3D_OVR( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 
    160155            qsr_hc_b(ji,jj,jk) = qsr_hc(ji,jj,jk) 
    161156         END_3D 
    … …  
    168163      CASE( np_BIO )                   !==  bio-model fluxes  ==! 
    169164         ! 
    170          DO_3D( isi, iei, isj, iej, 1, nksr ) 
     165         DO_3D_OVR( nn_hls, nn_hls, nn_hls, nn_hls, 1, nksr ) 
    171166            qsr_hc(ji,jj,jk) = r1_rho0_rcp * ( etot3(ji,jj,jk) - etot3(ji,jj,jk+1) ) 
    172167         END_3D 
    … …  
    179174         ! 
    180175         IF( nqsr == np_RGBc ) THEN          !*  Variable Chlorophyll 
    181             IF( ntile == 0 .OR. ntile == 1 )  THEN                                         ! Do only for the full domain 
    182                IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 )            ! Use full domain 
     176            IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                                         ! Do only for the full domain 
     177               IF( ln_tile ) CALL dom_tile_stop( ldhold=.TRUE. )             ! Use full domain 
    183178               CALL fld_read( kt, 1, sf_chl )         ! Read Chl data and provides it at the current time step 
    184                IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 1 )            ! Revert to tile domain 
     179               IF( ln_tile ) CALL dom_tile_start( ldhold=.TRUE. )            ! Revert to tile domain 
    185180            ENDIF 
    186181            ! 
    … …  
    190185            ! most expensive calculations) 
    191186            ! 
    192             DO_2D( isi, iei, isj, iej ) 
     187            DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls ) 
    193188                       ! zlogc = log(zchl) 
    194189               zlogc = LOG ( MIN( 10. , MAX( 0.03, sf_chl(1)%fnow(ji,jj,1) ) ) ) 
    … …  
    209204 
    210205! 
    211             DO_3D( isi, iei, isj, iej, 1, nksr + 1 ) 
     206            DO_3D_OVR( nn_hls, nn_hls, nn_hls, nn_hls, 1, nksr + 1 ) 
    212207               ! zchl    = ALOG( ze0(ji,jj) ) 
    213208               zlogc = ze0(ji,jj) 
    … …  
    239234         ! 
    240235         zcoef  = ( 1. - rn_abs ) / 3._wp    !* surface equi-partition in R-G-B 
    241          DO_2D( isi, iei, isj, iej ) 
     236         DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls ) 
    242237            ze0(ji,jj) = rn_abs * qsr(ji,jj) 
    243238            ze1(ji,jj) = zcoef  * qsr(ji,jj) 
    … …  
    250245         ! 
    251246         !                                    !* interior equi-partition in R-G-B depending on vertical profile of Chl 
    252          DO_3D( isi, iei, isj, iej, 2, nksr + 1 ) 
     247         DO_3D_OVR( nn_hls, nn_hls, nn_hls, nn_hls, 2, nksr + 1 ) 
    253248            ze3t = e3t(ji,jj,jk-1,Kmm) 
    254249            irgb = NINT( ztmp3d(ji,jj,jk) ) 
    … …  
    264259         END_3D 
    265260         ! 
    266          DO_3D( isi, iei, isj, iej, 1, nksr )          !* now qsr induced heat content 
     261         DO_3D_OVR( nn_hls, nn_hls, nn_hls, nn_hls, 1, nksr )          !* now qsr induced heat content 
    267262            qsr_hc(ji,jj,jk) = r1_rho0_rcp * ( ztmp3d(ji,jj,jk) - ztmp3d(ji,jj,jk+1) ) 
    268263         END_3D 
    … …  
    274269         zz0 =        rn_abs   * r1_rho0_rcp      ! surface equi-partition in 2-bands 
    275270         zz1 = ( 1. - rn_abs ) * r1_rho0_rcp 
    276          DO_3D( isi, iei, isj, iej, 1, nksr )          !* now qsr induced heat content 
     271         DO_3D_OVR( nn_hls, nn_hls, nn_hls, nn_hls, 1, nksr )          !* now qsr induced heat content 
    277272            zc0 = zz0 * EXP( -gdepw(ji,jj,jk  ,Kmm)*xsi0r ) + zz1 * EXP( -gdepw(ji,jj,jk  ,Kmm)*xsi1r ) 
    278273            zc1 = zz0 * EXP( -gdepw(ji,jj,jk+1,Kmm)*xsi0r ) + zz1 * EXP( -gdepw(ji,jj,jk+1,Kmm)*xsi1r ) 
    … …  
    292287      ! 
    293288      ! sea-ice: store the 1st ocean level attenuation coefficient 
    294       DO_2D( isi, iei, isj, iej ) 
     289      DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls ) 
    295290         IF( qsr(ji,jj) /= 0._wp ) THEN   ;   fraqsr_1lev(ji,jj) = qsr_hc(ji,jj,1) / ( r1_rho0_rcp * qsr(ji,jj) ) 
    296291         ELSE                             ;   fraqsr_1lev(ji,jj) = 1._wp 
    … …  
    298293      END_2D 
    299294      ! 
    300       ! TEMP: [tiling] This change not necessary and working array can use A2D(nn_hls) if using XIOS (subdomain support) 
    301       IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only for the full domain 
    302          IF( iom_use('qsr3d') ) THEN      ! output the shortwave Radiation distribution 
    303             ALLOCATE( zetot(jpi,jpj,jpk) ) 
    304             zetot(:,:,nksr+1:jpk) = 0._wp     ! below ~400m set to zero 
    305             DO jk = nksr, 1, -1 
    306                zetot(:,:,jk) = zetot(:,:,jk+1) + qsr_hc(:,:,jk) * rho0_rcp 
    307             END DO 
    308             CALL iom_put( 'qsr3d', zetot )   ! 3D distribution of shortwave Radiation 
    309             DEALLOCATE( zetot ) 
    310          ENDIF 
    311       ENDIF 
    312       ! 
    313       IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only on the last tile 
     295      IF( iom_use('qsr3d') ) THEN      ! output the shortwave Radiation distribution 
     296         ALLOCATE( zetot(A2D(nn_hls),jpk) ) 
     297         zetot(:,:,nksr+1:jpk) = 0._wp     ! below ~400m set to zero 
     298         DO_3DS(0, 0, 0, 0, nksr, 1, -1) 
     299            zetot(ji,jj,jk) = zetot(ji,jj,jk+1) + qsr_hc(ji,jj,jk) * rho0_rcp 
     300         END_3D 
     301         CALL iom_put( 'qsr3d', zetot )   ! 3D distribution of shortwave Radiation 
     302         DEALLOCATE( zetot ) 
     303      ENDIF 
     304      ! 
     305      IF( .NOT. l_istiled .OR. ntile == nijtile )  THEN                ! Do only on the last tile 
    314306         IF( lrst_oce ) THEN     ! write in the ocean restart file 
    315307            CALL iom_rstput( kt, nitrst, numrow, 'qsr_hc_b'   , qsr_hc      ) 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/TRA/trasbc.F90

    r14789 r14852  
    7777      ! 
    7878      INTEGER  ::   ji, jj, jk, jn               ! dummy loop indices 
    79       INTEGER  ::   ikt, ikb, isi, iei, isj, iej ! local integers 
     79      INTEGER  ::   ikt, ikb                    ! local integers 
    8080      REAL(wp) ::   zfact, z1_e3t, zdep, ztim    ! local scalar 
    8181      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::  ztrdt, ztrds 
    … …  
    8484      IF( ln_timing )   CALL timing_start('tra_sbc') 
    8585      ! 
    86       IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     86      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
    8787         IF( kt == nit000 ) THEN 
    8888            IF(lwp) WRITE(numout,*) 
    … …  
    9898      ENDIF 
    9999      ! 
    100       IF( ntsi == Nis0 ) THEN ; isi = nn_hls ; ELSE ; isi = 0 ; ENDIF    ! Avoid double-counting when using tiling 
    101       IF( ntsj == Njs0 ) THEN ; isj = nn_hls ; ELSE ; isj = 0 ; ENDIF 
    102       IF( ntei == Nie0 ) THEN ; iei = nn_hls ; ELSE ; iei = 0 ; ENDIF 
    103       IF( ntej == Nje0 ) THEN ; iej = nn_hls ; ELSE ; iej = 0 ; ENDIF 
    104  
    105100!!gm  This should be moved into sbcmod.F90 module ? (especially now that ln_traqsr is read in namsbc namelist) 
    106101      IF( .NOT.ln_traqsr ) THEN     ! no solar radiation penetration 
    107          DO_2D( isi, iei, isj, iej ) 
     102         DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls ) 
    108103            qns(ji,jj) = qns(ji,jj) + qsr(ji,jj)      ! total heat flux in qns 
    109104            qsr(ji,jj) = 0._wp                        ! qsr set to zero 
    … …  
    118113         IF( ln_rstart .AND. .NOT.l_1st_euler ) THEN      ! Restart: read in restart file 
    119114            zfact = 0.5_wp 
    120             IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     115            IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
    121116               IF(lwp) WRITE(numout,*) '          nit000-1 sbc tracer content field read in the restart file' 
    122117               sbc_tsc(:,:,:) = 0._wp 
    … …  
    126121         ELSE                                             ! No restart or restart not found: Euler forward time stepping 
    127122            zfact = 1._wp 
    128             DO_2D( isi, iei, isj, iej ) 
     123            DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls ) 
    129124               sbc_tsc(ji,jj,:) = 0._wp 
    130125               sbc_tsc_b(ji,jj,:) = 0._wp 
    … …  
    133128      ELSE                                !* other time-steps: swap of forcing fields 
    134129         zfact = 0.5_wp 
    135          DO_2D( isi, iei, isj, iej ) 
     130         DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls ) 
    136131            sbc_tsc_b(ji,jj,:) = sbc_tsc(ji,jj,:) 
    137132         END_2D 
    138133      ENDIF 
    139134      !                             !==  Now sbc tracer content fields  ==! 
    140       DO_2D( isi, iei, isj, iej ) 
     135      DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls ) 
    141136         sbc_tsc(ji,jj,jp_tem) = r1_rho0_rcp * qns(ji,jj)   ! non solar heat flux 
    142137         sbc_tsc(ji,jj,jp_sal) = r1_rho0     * sfx(ji,jj)   ! salt flux due to freezing/melting 
    143138      END_2D 
    144139      IF( ln_linssh ) THEN                !* linear free surface 
    145          DO_2D( isi, iei, isj, iej )                    !==>> add concentration/dilution effect due to constant volume cell 
     140         DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls )                    !==>> add concentration/dilution effect due to constant volume cell 
    146141            sbc_tsc(ji,jj,jp_tem) = sbc_tsc(ji,jj,jp_tem) + r1_rho0 * emp(ji,jj) * pts(ji,jj,1,jp_tem,Kmm) 
    147142            sbc_tsc(ji,jj,jp_sal) = sbc_tsc(ji,jj,jp_sal) + r1_rho0 * emp(ji,jj) * pts(ji,jj,1,jp_sal,Kmm) 
    148143         END_2D                                 !==>> output c./d. term 
    149          IF( ntile == 0 .OR. ntile == nijtile )  THEN             ! Do only on the last tile 
    150             IF( iom_use('emp_x_sst') )   CALL iom_put( "emp_x_sst", emp (:,:) * pts(:,:,1,jp_tem,Kmm) ) 
    151             IF( iom_use('emp_x_sss') )   CALL iom_put( "emp_x_sss", emp (:,:) * pts(:,:,1,jp_sal,Kmm) ) 
    152          ENDIF 
     144         IF( iom_use('emp_x_sst') )   CALL iom_put( "emp_x_sst", emp (:,:) * pts(:,:,1,jp_tem,Kmm) ) 
     145         IF( iom_use('emp_x_sss') )   CALL iom_put( "emp_x_sss", emp (:,:) * pts(:,:,1,jp_sal,Kmm) ) 
    153146      ENDIF 
    154147      ! 
    … …  
    160153      END DO 
    161154      ! 
    162       IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only on the last tile 
     155      IF( .NOT. l_istiled .OR. ntile == nijtile )  THEN                ! Do only on the last tile 
    163156         IF( lrst_oce ) THEN           !==  write sbc_tsc in the ocean restart file  ==! 
    164157            CALL iom_rstput( kt, nitrst, numrow, 'sbc_hc_b', sbc_tsc(:,:,jp_tem) ) 
    … …  
    186179      ENDIF 
    187180 
    188       IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only on the last tile 
    189          IF( iom_use('rnf_x_sst') )   CALL iom_put( "rnf_x_sst", rnf*pts(:,:,1,jp_tem,Kmm) )   ! runoff term on sst 
    190          IF( iom_use('rnf_x_sss') )   CALL iom_put( "rnf_x_sss", rnf*pts(:,:,1,jp_sal,Kmm) )   ! runoff term on sss 
    191       ENDIF 
     181      IF( iom_use('rnf_x_sst') )   CALL iom_put( "rnf_x_sst", rnf*pts(:,:,1,jp_tem,Kmm) )   ! runoff term on sst 
     182      IF( iom_use('rnf_x_sss') )   CALL iom_put( "rnf_x_sss", rnf*pts(:,:,1,jp_sal,Kmm) )   ! runoff term on sss 
    192183 
    193184#if defined key_asminc 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/TRA/trazdf.F90

    r14789 r14852  
    6464      ! 
    6565      IF( kt == nit000 )  THEN 
    66          IF( ntile == 0 .OR. ntile == 1 )  THEN                   ! Do only on the first tile 
     66         IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                   ! Do only on the first tile 
    6767            IF(lwp)WRITE(numout,*) 
    6868            IF(lwp)WRITE(numout,*) 'tra_zdf : implicit vertical mixing on T & S' 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/TRA/zpshde.F90

    r14789 r14852  
    4747      INTEGER                     , INTENT(in   )           ::  Kmm         ! ocean time level index 
    4848      INTEGER                     , INTENT(in   )           ::  kjpt        ! number of tracers 
    49       REAL(wp), DIMENSION(:,:,:,:), INTENT(inout)           ::  pta         ! 4D tracers fields 
     49      REAL(wp), DIMENSION(:,:,:,:), INTENT(in   )           ::  pta         ! 4D tracers fields 
    5050      REAL(wp), DIMENSION(:,:,:)  , INTENT(  out)           ::  pgtu, pgtv  ! hor. grad. of ptra at u- & v-pts 
    51       REAL(wp), DIMENSION(:,:,:)  , INTENT(inout), OPTIONAL ::  prd         ! 3D density anomaly fields 
     51      REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ), OPTIONAL ::  prd         ! 3D density anomaly fields 
    5252      REAL(wp), DIMENSION(:,:)    , INTENT(  out), OPTIONAL ::  pgru, pgrv  ! hor. grad of prd at u- & v-pts (bottom) 
    5353      ! 
    … …  
    111111      INTEGER                                , INTENT(in   )           ::  kjpt        ! number of tracers 
    112112      INTEGER                                , INTENT(in   )           ::  ktta, ktgt, ktrd, ktgr 
    113       REAL(wp), DIMENSION(A2D_T(ktta),JPK,KJPT), INTENT(inout)           ::  pta         ! 4D tracers fields 
     113      REAL(wp), DIMENSION(A2D_T(ktta),JPK,KJPT), INTENT(in   )           ::  pta         ! 4D tracers fields 
    114114      REAL(wp), DIMENSION(A2D_T(ktgt)    ,KJPT), INTENT(  out)           ::  pgtu, pgtv  ! hor. grad. of ptra at u- & v-pts 
    115       REAL(wp), DIMENSION(A2D_T(ktrd),JPK     ), INTENT(inout), OPTIONAL ::  prd         ! 3D density anomaly fields 
     115      REAL(wp), DIMENSION(A2D_T(ktrd),JPK     ), INTENT(in   ), OPTIONAL ::  prd         ! 3D density anomaly fields 
    116116      REAL(wp), DIMENSION(A2D_T(ktgr)         ), INTENT(  out), OPTIONAL ::  pgru, pgrv  ! hor. grad of prd at u- & v-pts (bottom) 
    117117      ! 
    … …  
    124124      ! 
    125125      IF( ln_timing )   CALL timing_start( 'zps_hde') 
    126       IF (nn_hls.EQ.2) THEN 
    127          CALL lbc_lnk( 'zpshde', pta, 'T', 1.0_wp) 
    128          IF(PRESENT(prd)) CALL lbc_lnk( 'zpshde', prd, 'T', 1.0_wp) 
    129       END IF 
    130126      ! 
    131127      pgtu(:,:,:) = 0._wp   ;   zti (:,:,:) = 0._wp   ;   zhi (:,:) = 0._wp 
    … …  
    134130      DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==! 
    135131         ! 
    136          DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )              ! Gradient of density at the last level 
     132         DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )              ! Gradient of density at the last level 
    137133            iku = mbku(ji,jj)   ;   ikum1 = MAX( iku - 1 , 1 )    ! last and before last ocean level at u- & v-points 
    138134            ikv = mbkv(ji,jj)   ;   ikvm1 = MAX( ikv - 1 , 1 )    ! if level first is a p-step, ik.m1=1 
    … …  
    173169      END DO 
    174170      ! 
    175       IF (nn_hls.EQ.1) CALL lbc_lnk( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp , pgtv(:,:,:), 'V', -1.0_wp )   ! Lateral boundary cond. 
     171      IF (nn_hls==1) CALL lbc_lnk( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp , pgtv(:,:,:), 'V', -1.0_wp )   ! Lateral boundary cond. 
    176172      ! 
    177173      IF( PRESENT( prd ) ) THEN    !==  horizontal derivative of density anomalies (rd)  ==!    (optional part) 
    … …  
    206202            ENDIF 
    207203         END_2D 
    208          IF (nn_hls.EQ.1) CALL lbc_lnk( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp )   ! Lateral boundary conditions 
     204         IF (nn_hls==1) CALL lbc_lnk( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp )   ! Lateral boundary conditions 
    209205         ! 
    210206      END IF 
    … …  
    221217      INTEGER                     , INTENT(in   )           ::  Kmm          ! ocean time level index 
    222218      INTEGER                     , INTENT(in   )           ::  kjpt         ! number of tracers 
    223       REAL(wp), DIMENSION(:,:,:,:), INTENT(inout)           ::  pta          ! 4D tracers fields 
     219      REAL(wp), DIMENSION(:,:,:,:), INTENT(in   )           ::  pta          ! 4D tracers fields 
    224220      REAL(wp), DIMENSION(:,:,:)  , INTENT(  out)           ::  pgtu, pgtv   ! hor. grad. of ptra at u- & v-pts 
    225221      REAL(wp), DIMENSION(:,:,:)  , INTENT(  out)           ::  pgtui, pgtvi ! hor. grad. of stra at u- & v-pts (ISF) 
    226       REAL(wp), DIMENSION(:,:,:)  , INTENT(inout), OPTIONAL ::  prd          ! 3D density anomaly fields 
     222      REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ), OPTIONAL ::  prd          ! 3D density anomaly fields 
    227223      REAL(wp), DIMENSION(:,:)    , INTENT(  out), OPTIONAL ::  pgru, pgrv   ! hor. grad of prd at u- & v-pts (bottom) 
    228224      REAL(wp), DIMENSION(:,:)    , INTENT(  out), OPTIONAL ::  pgrui, pgrvi ! hor. grad of prd at u- & v-pts (top) 
    … …  
    291287      INTEGER                                , INTENT(in   )           ::  kjpt         ! number of tracers 
    292288      INTEGER                                , INTENT(in   )           ::  ktta, ktgt, ktgti, ktrd, ktgr, ktgri 
    293       REAL(wp), DIMENSION(A2D_T(ktta),JPK,KJPT), INTENT(inout)           ::  pta          ! 4D tracers fields 
     289      REAL(wp), DIMENSION(A2D_T(ktta),JPK,KJPT), INTENT(in   )           ::  pta          ! 4D tracers fields 
    294290      REAL(wp), DIMENSION(A2D_T(ktgt)    ,KJPT), INTENT(  out)           ::  pgtu, pgtv   ! hor. grad. of ptra at u- & v-pts 
    295291      REAL(wp), DIMENSION(A2D_T(ktgti)   ,KJPT), INTENT(  out)           ::  pgtui, pgtvi ! hor. grad. of stra at u- & v-pts (ISF) 
    296       REAL(wp), DIMENSION(A2D_T(ktrd),JPK     ), INTENT(inout), OPTIONAL ::  prd          ! 3D density anomaly fields 
     292      REAL(wp), DIMENSION(A2D_T(ktrd),JPK     ), INTENT(in   ), OPTIONAL ::  prd          ! 3D density anomaly fields 
    297293      REAL(wp), DIMENSION(A2D_T(ktgr)         ), INTENT(  out), OPTIONAL ::  pgru, pgrv   ! hor. grad of prd at u- & v-pts (bottom) 
    298294      REAL(wp), DIMENSION(A2D_T(ktgri)        ), INTENT(  out), OPTIONAL ::  pgrui, pgrvi ! hor. grad of prd at u- & v-pts (top) 
    … …  
    307303      IF( ln_timing )   CALL timing_start( 'zps_hde_isf') 
    308304      ! 
    309       IF (nn_hls.EQ.2) THEN 
    310          CALL lbc_lnk( 'zpshde', pta, 'T', 1.0_wp) 
    311          IF (PRESENT(prd)) CALL lbc_lnk( 'zpshde', prd, 'T', 1.0_wp) 
    312       END IF 
    313  
    314305      pgtu (:,:,:) = 0._wp   ;   pgtv (:,:,:) =0._wp 
    315306      pgtui(:,:,:) = 0._wp   ;   pgtvi(:,:,:) =0._wp 
    … …  
    319310      DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==! 
    320311         ! 
    321          DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     312         DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    322313 
    323314            iku = mbku(ji,jj); ikum1 = MAX( iku - 1 , 1 )    ! last and before last ocean level at u- & v-points 
    … …  
    359350      END DO 
    360351      ! 
    361       IF (nn_hls.EQ.1) CALL lbc_lnk( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp , pgtv(:,:,:), 'V', -1.0_wp )   ! Lateral boundary cond. 
     352      IF (nn_hls==1) CALL lbc_lnk( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp , pgtv(:,:,:), 'V', -1.0_wp )   ! Lateral boundary cond. 
    362353 
    363354      ! horizontal derivative of density anomalies (rd) 
    … …  
    401392         END_2D 
    402393 
    403          IF (nn_hls.EQ.1) CALL lbc_lnk( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp )   ! Lateral boundary conditions 
     394         IF (nn_hls==1) CALL lbc_lnk( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp )   ! Lateral boundary conditions 
    404395         ! 
    405396      END IF 
    … …  
    408399      ! 
    409400      DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==!            ! 
    410          DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     401         DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    411402            iku = miku(ji,jj); ikup1 = miku(ji,jj) + 1 
    412403            ikv = mikv(ji,jj); ikvp1 = mikv(ji,jj) + 1 
    … …  
    452443         ! 
    453444      END DO 
    454       IF (nn_hls.EQ.1) CALL lbc_lnk( 'zpshde', pgtui(:,:,:), 'U', -1.0_wp , pgtvi(:,:,:), 'V', -1.0_wp )   ! Lateral boundary cond. 
     445      IF (nn_hls==1) CALL lbc_lnk( 'zpshde', pgtui(:,:,:), 'U', -1.0_wp , pgtvi(:,:,:), 'V', -1.0_wp )   ! Lateral boundary cond. 
    455446 
    456447      IF( PRESENT( prd ) ) THEN    !==  horizontal derivative of density anomalies (rd)  ==!    (optional part) 
    … …  
    491482 
    492483         END_2D 
    493          IF (nn_hls.EQ.1) CALL lbc_lnk( 'zpshde', pgrui, 'U', -1.0_wp , pgrvi, 'V', -1.0_wp )   ! Lateral boundary conditions 
     484         IF (nn_hls==1) CALL lbc_lnk( 'zpshde', pgrui, 'U', -1.0_wp , pgrvi, 'V', -1.0_wp )   ! Lateral boundary conditions 
    494485         ! 
    495486      END IF 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/TRD/trdini.F90

    r14789 r14852  
    9393         CALL ctl_warn('Tiling is not yet implemented for the trends diagnostics; ln_tile is forced to FALSE') 
    9494         ln_tile = .FALSE. 
    95          CALL dom_tile( ntsi, ntsj, ntei, ntej ) 
     95         CALL dom_tile_init 
    9696      ENDIF 
    9797 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/USR/usrdef_istate.F90

    r14789 r14852  
    6161      pv  (:,:,:) = 0._wp 
    6262      ! 
    63       DO_3D( 1, 1, 1, 1, 1, jpk )   ! horizontally uniform T & S profiles 
     63      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk )   ! horizontally uniform T & S profiles 
    6464         pts(ji,jj,jk,jp_tem) =  (  (  16. - 12. * TANH( (pdept(ji,jj,jk) - 400) / 700 ) )   & 
    6565              &           * (-TANH( (500. - pdept(ji,jj,jk)) / 150. ) + 1.) / 2.             & 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/ZDF/zdfddm.F90

    r14789 r14852  
    8383      REAL(dp) ::          zavfs    !   -      - 
    8484      REAL(wp) ::   zavdt, zavds    !   -      - 
    85       REAL(wp), DIMENSION(jpi,jpj) ::   zrau, zmsks, zmskf, zmskd1, zmskd2, zmskd3 
     85      REAL(wp), DIMENSION(A2D(nn_hls)) ::   zrau, zmsks, zmskf, zmskd1, zmskd2, zmskd3 
    8686      !!---------------------------------------------------------------------- 
    8787      ! 
    … …  
    9595!!gm                            and many acces in memory 
    9696          
    97          DO_2D( 1, 1, 1, 1 )           !==  R=zrau = (alpha / beta) (dk[t] / dk[s])  ==! 
     97         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )           !==  R=zrau = (alpha / beta) (dk[t] / dk[s])  ==! 
    9898            zrw =   ( gdepw(ji,jj,jk  ,Kmm) - gdept(ji,jj,jk,Kmm) )   & 
    9999!!gm please, use e3w at Kmm below  
    … …  
    111111         END_2D 
    112112 
    113          DO_2D( 1, 1, 1, 1 )           !==  indicators  ==! 
     113         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )           !==  indicators  ==! 
    114114            ! stability indicator: msks=1 if rn2>0; 0 elsewhere 
    115115            IF( rn2(ji,jj,jk) + 1.e-12  <= 0. ) THEN   ;   zmsks(ji,jj) = 0._wp 
    … …  
    135135         END_2D 
    136136         ! mask zmsk in order to have avt and avs masked 
    137          zmsks(:,:) = zmsks(:,:) * wmask(:,:,jk) 
     137         zmsks(:,:) = zmsks(:,:) * wmask(A2D(nn_hls),jk) 
    138138 
    139139 
    … …  
    141141         ! ------------------ 
    142142         ! Constant eddy coefficient: reset to the background value 
    143          DO_2D( 1, 1, 1, 1 ) 
     143         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    144144            zinr = 1._wp / zrau(ji,jj) 
    145145            ! salt fingering 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/ZDF/zdfdrg.F90

    r13558 r14852  
    117117      ! 
    118118      IF( l_log_not_linssh ) THEN     !==  "log layer"  ==!   compute Cd and -Cd*|U| 
    119          DO_2D( 0, 0, 0, 0 ) 
     119         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    120120            imk = k_mk(ji,jj)          ! ocean bottom level at t-points 
    121121            zut = uu(ji,jj,imk,Kmm) + uu(ji-1,jj,imk,Kmm)     ! 2 x velocity at t-point 
    … …  
    129129         END_2D 
    130130      ELSE                                            !==  standard Cd  ==! 
    131          DO_2D( 0, 0, 0, 0 ) 
     131         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    132132            imk = k_mk(ji,jj)    ! ocean bottom level at t-points 
    133133            zut = uu(ji,jj,imk,Kmm) + uu(ji-1,jj,imk,Kmm)     ! 2 x velocity at t-point 
    … …  
    432432            l_log_not_linssh = .FALSE.    !- don't update Cd at each time step 
    433433            ! 
    434             DO_2D( 1, 1, 1, 1 )              ! pCd0 = mask (and boosted) logarithmic drag coef. 
     434            DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )              ! pCd0 = mask (and boosted) logarithmic drag coef. 
    435435               zzz =  0.5_wp * e3t_0(ji,jj,k_mk(ji,jj)) 
    436436               zcd = (  vkarmn / LOG( zzz / rn_z0 )  )**2 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/ZDF/zdfevd.F90

    r13295 r14852  
    6262      ! 
    6363      INTEGER ::   ji, jj, jk   ! dummy loop indices 
    64       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zavt_evd, zavm_evd 
     64      ! NOTE: [tiling] use a SAVE array to store diagnostics, then send after all tiles are finished. This is necessary because p_avt/p_avm are modified on adjacent tiles when using nn_hls > 1. zavt_evd/zavm_evd are then zero on some points when subsequently calculated for these tiles. 
     65      REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   zavt_evd, zavm_evd 
    6566      !!---------------------------------------------------------------------- 
    6667      ! 
    67       IF( kt == nit000 ) THEN 
    68          IF(lwp) WRITE(numout,*) 
    69          IF(lwp) WRITE(numout,*) 'zdf_evd : Enhanced Vertical Diffusion (evd)' 
    70          IF(lwp) WRITE(numout,*) '~~~~~~~ ' 
    71          IF(lwp) WRITE(numout,*) 
     68      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     69         IF( kt == nit000 ) THEN 
     70            IF(lwp) WRITE(numout,*) 
     71            IF(lwp) WRITE(numout,*) 'zdf_evd : Enhanced Vertical Diffusion (evd)' 
     72            IF(lwp) WRITE(numout,*) '~~~~~~~ ' 
     73            IF(lwp) WRITE(numout,*) 
     74         ENDIF 
     75 
     76         ALLOCATE( zavt_evd(jpi,jpj,jpk) ) 
     77         IF( nn_evdm == 1 ) ALLOCATE( zavm_evd(jpi,jpj,jpk) ) 
    7278      ENDIF 
    7379      ! 
    7480      ! 
    75       zavt_evd(:,:,:) = p_avt(:,:,:)         ! set avt prior to evd application 
     81      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 
     82         zavt_evd(ji,jj,jk) = p_avt(ji,jj,jk)         ! set avt prior to evd application 
     83      END_3D 
    7684      ! 
    7785      SELECT CASE ( nn_evdm ) 
    … …  
    7987      CASE ( 1 )           !==  enhance tracer & momentum Kz  ==!   (if rn2<-1.e-12) 
    8088         ! 
    81          zavm_evd(:,:,:) = p_avm(:,:,:)      ! set avm prior to evd application 
     89         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 
     90            zavm_evd(ji,jj,jk) = p_avm(ji,jj,jk)      ! set avm prior to evd application 
     91         END_3D 
    8292         ! 
    8393!! change last digits results 
    … …  
    8797!         END WHERE 
    8898         ! 
    89          DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     99         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
    90100            IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) THEN 
    91101               p_avt(ji,jj,jk) = rn_evd * wmask(ji,jj,jk) 
    … …  
    94104         END_3D 
    95105         ! 
    96          zavm_evd(:,:,:) = p_avm(:,:,:) - zavm_evd(:,:,:)   ! change in avm due to evd 
    97          CALL iom_put( "avm_evd", zavm_evd )                ! output this change 
     106         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 
     107            zavm_evd(ji,jj,jk) = p_avm(ji,jj,jk) - zavm_evd(ji,jj,jk)   ! change in avm due to evd 
     108         END_3D 
     109         IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN                       ! Do only on the last tile 
     110            CALL iom_put( "avm_evd", zavm_evd )                ! output this change 
     111            DEALLOCATE( zavm_evd ) 
     112         ENDIF 
    98113         ! 
    99114      CASE DEFAULT         !==  enhance tracer Kz  ==!   (if rn2<-1.e-12)  
    … …  
    103118!         END WHERE 
    104119 
    105          DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     120         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
    106121            IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 )   & 
    107122               p_avt(ji,jj,jk) = rn_evd * wmask(ji,jj,jk) 
    … …  
    110125      END SELECT  
    111126      ! 
    112       zavt_evd(:,:,:) = p_avt(:,:,:) - zavt_evd(:,:,:)   ! change in avt due to evd 
    113       CALL iom_put( "avt_evd", zavt_evd )              ! output this change 
     127      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 
     128         zavt_evd(ji,jj,jk) = p_avt(ji,jj,jk) - zavt_evd(ji,jj,jk)   ! change in avt due to evd 
     129      END_3D 
     130      IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN                       ! Do only on the last tile 
     131         CALL iom_put( "avt_evd", zavt_evd )              ! output this change 
     132         DEALLOCATE( zavt_evd ) 
     133      ENDIF 
    114134      IF( l_trdtra ) CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_evd, zavt_evd ) 
    115135      ! 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/ZDF/zdfgls.F90

    r14789 r14852  
    137137      USE zdf_oce , ONLY : en, avtb, avmb   ! ocean vertical physics 
    138138      !! 
    139       INTEGER                   , INTENT(in   ) ::   kt             ! ocean time step 
    140       INTEGER                   , INTENT(in   ) ::   Kbb, Kmm       ! ocean time level indices 
    141       REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   p_sh2          ! shear production term 
    142       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   p_avm, p_avt   !  momentum and tracer Kz (w-points) 
     139      INTEGER                             , INTENT(in   ) ::   kt             ! ocean time step 
     140      INTEGER                             , INTENT(in   ) ::   Kbb, Kmm       ! ocean time level indices 
     141      REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(in   ) ::   p_sh2          ! shear production term 
     142      REAL(wp), DIMENSION(:,:,:)          , INTENT(inout) ::   p_avm, p_avt   !  momentum and tracer Kz (w-points) 
    143143      ! 
    144144      INTEGER  ::   ji, jj, jk    ! dummy loop arguments 
    … …  
    151151      REAL(wp) ::   gh, gm, shr, dif, zsqen, zavt, zavm !   -      - 
    152152      REAL(wp) ::   zmsku, zmskv                        !   -      - 
    153       REAL(wp), DIMENSION(jpi,jpj)     ::   zdep 
    154       REAL(wp), DIMENSION(jpi,jpj)     ::   zkar 
    155       REAL(wp), DIMENSION(jpi,jpj)     ::   zflxs       ! Turbulence fluxed induced by internal waves 
    156       REAL(wp), DIMENSION(jpi,jpj)     ::   zhsro       ! Surface roughness (surface waves) 
    157       REAL(wp), DIMENSION(jpi,jpj)     ::   zice_fra    ! Tapering of wave breaking under sea ice 
    158       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   eb          ! tke at time before 
    159       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   hmxl_b      ! mixing length at time before 
    160       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   eps         ! dissipation rate 
    161       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwall_psi   ! Wall function use in the wb case (ln_sigpsi) 
    162       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   psi         ! psi at time now 
    163       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zd_lw, zd_up, zdiag   ! lower, upper  and diagonal of the matrix 
    164       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zstt, zstm  ! stability function on tracer and momentum 
     153      REAL(wp), DIMENSION(A2D(nn_hls))     ::   zdep 
     154      REAL(wp), DIMENSION(A2D(nn_hls))     ::   zkar 
     155      REAL(wp), DIMENSION(A2D(nn_hls))     ::   zflxs                 ! Turbulence fluxed induced by internal waves 
     156      REAL(wp), DIMENSION(A2D(nn_hls))     ::   zhsro                 ! Surface roughness (surface waves) 
     157      REAL(wp), DIMENSION(A2D(nn_hls))     ::   zice_fra              ! Tapering of wave breaking under sea ice 
     158      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   eb                    ! tke at time before 
     159      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   hmxl_b                ! mixing length at time before 
     160      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   eps                   ! dissipation rate 
     161      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zwall_psi             ! Wall function use in the wb case (ln_sigpsi) 
     162      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   psi                   ! psi at time now 
     163      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zd_lw, zd_up, zdiag   ! lower, upper  and diagonal of the matrix 
     164      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zstt, zstm            ! stability function on tracer and momentum 
    165165      !!-------------------------------------------------------------------- 
    166166      ! 
    167167      ! Preliminary computing 
    168  
    169       ustar2_surf(:,:) = 0._wp   ;         psi(:,:,:) = 0._wp 
    170       ustar2_top (:,:) = 0._wp   ;   zwall_psi(:,:,:) = 0._wp 
    171       ustar2_bot (:,:) = 0._wp 
     168      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     169         ustar2_surf(ji,jj) = 0._wp   ;   ustar2_top(ji,jj) = 0._wp   ;   ustar2_bot(ji,jj) = 0._wp 
     170      END_2D 
     171      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 
     172         psi(ji,jj,jk) = 0._wp   ;   zwall_psi(ji,jj,jk) = 0._wp 
     173      END_3D 
    172174 
    173175      SELECT CASE ( nn_z0_ice ) 
    174176      CASE( 0 )   ;   zice_fra(:,:) = 0._wp 
    175       CASE( 1 )   ;   zice_fra(:,:) =        TANH( fr_i(:,:) * 10._wp ) 
    176       CASE( 2 )   ;   zice_fra(:,:) =              fr_i(:,:) 
    177       CASE( 3 )   ;   zice_fra(:,:) = MIN( 4._wp * fr_i(:,:) , 1._wp ) 
     177      CASE( 1 )   ;   zice_fra(:,:) =        TANH( fr_i(A2D(nn_hls)) * 10._wp ) 
     178      CASE( 2 )   ;   zice_fra(:,:) =              fr_i(A2D(nn_hls)) 
     179      CASE( 3 )   ;   zice_fra(:,:) = MIN( 4._wp * fr_i(A2D(nn_hls)) , 1._wp ) 
    178180      END SELECT 
    179181 
    180182      ! Compute surface, top and bottom friction at T-points 
    181       DO_2D( 0, 0, 0, 0 )          !==  surface ocean friction 
     183      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )          !==  surface ocean friction 
    182184         ustar2_surf(ji,jj) = r1_rho0 * taum(ji,jj) * tmask(ji,jj,1)   ! surface friction 
    183185      END_2D 
    … …  
    186188      ! 
    187189      IF( .NOT.ln_drg_OFF ) THEN     !== top/bottom friction   (explicit before friction) 
    188          DO_2D( 0, 0, 0, 0 )         ! bottom friction (explicit before friction) 
     190         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )          ! bottom friction (explicit before friction) 
    189191            zmsku = 0.5_wp * ( 2._wp - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) ) 
    190192            zmskv = 0.5_wp * ( 2._wp - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) )     ! (CAUTION: CdU<0) 
    … …  
    193195         END_2D 
    194196         IF( ln_isfcav ) THEN 
    195             DO_2D( 0, 0, 0, 0 )      ! top friction 
     197            DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )      ! top friction 
    196198               zmsku = 0.5_wp * ( 2. - umask(ji-1,jj,mikt(ji,jj)) * umask(ji,jj,mikt(ji,jj)) ) 
    197199               zmskv = 0.5_wp * ( 2. - vmask(ji,jj-1,mikt(ji,jj)) * vmask(ji,jj,mikt(ji,jj)) )     ! (CAUTION: CdU<0) 
    … …  
    206208         zhsro(:,:) = rn_hsro 
    207209      CASE ( 1 )             ! Standard Charnock formula 
    208          zhsro(:,:) = MAX( rsbc_zs1 * ustar2_surf(:,:) , rn_hsro ) 
     210         zhsro(:,:) = MAX( rsbc_zs1 * ustar2_surf(A2D(nn_hls)) , rn_hsro ) 
    209211      CASE ( 2 )             ! Roughness formulae according to Rascle et al., Ocean Modelling (2008) 
    210212!!gm faster coding : the 2 comment lines should be used 
    211213!!gm         zcof = 2._wp * 0.6_wp / 28._wp 
    212214!!gm         zdep(:,:)  = 30._wp * TANH(  zcof/ SQRT( MAX(ustar2_surf(:,:),rsmall) )  )       ! Wave age (eq. 10) 
    213          zdep (:,:) = 30.*TANH( 2.*0.3/(28.*SQRT(MAX(ustar2_surf(:,:),rsmall))) )         ! Wave age (eq. 10) 
    214          zhsro(:,:) = MAX(rsbc_zs2 * ustar2_surf(:,:) * zdep(:,:)**1.5, rn_hsro)          ! zhsro = rn_frac_hs * Hsw (eq. 11) 
     215         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     216            zcof = 30.*TANH( 2.*0.3/(28.*SQRT(MAX(ustar2_surf(ji,jj),rsmall))) )          ! Wave age (eq. 10) 
     217            zhsro(ji,jj) = MAX(rsbc_zs2 * ustar2_surf(ji,jj) * zcof**1.5, rn_hsro)        ! zhsro = rn_frac_hs * Hsw (eq. 11) 
     218         END_2D 
    215219      CASE ( 3 )             ! Roughness given by the wave model (coupled or read in file) 
    216          zhsro(:,:) = MAX(rn_frac_hs * hsw(:,:), rn_hsro)   ! (rn_frac_hs=1.6 see Eq. (5) of Rascle et al. 2008 ) 
     220         zhsro(:,:) = MAX(rn_frac_hs * hsw(A2D(nn_hls)), rn_hsro)   ! (rn_frac_hs=1.6 see Eq. (5) of Rascle et al. 2008 ) 
    217221      END SELECT 
    218222      ! 
    219223      ! adapt roughness where there is sea ice 
    220       zhsro(:,:) = ( (1._wp-zice_fra(:,:)) * zhsro(:,:) + zice_fra(:,:) * rn_hsri )*tmask(:,:,1)  + (1._wp - tmask(:,:,1))*rn_hsro 
    221       ! 
    222       DO_3D( 0, 0, 0, 0, 2, jpkm1 )  !==  Compute dissipation rate  ==! 
     224      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     225         zhsro(ji,jj) = ( (1._wp-zice_fra(ji,jj)) * zhsro(ji,jj) + zice_fra(ji,jj) * rn_hsri )*tmask(ji,jj,1)  + & 
     226            &           (1._wp - tmask(ji,jj,1))*rn_hsro 
     227      END_2D 
     228      ! 
     229      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )  !==  Compute dissipation rate  ==! 
    223230         eps(ji,jj,jk)  = rc03 * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / hmxl_n(ji,jj,jk) 
    224231      END_3D 
    225232 
    226233      ! Save tke at before time step 
    227       eb    (:,:,:) = en    (:,:,:) 
    228       hmxl_b(:,:,:) = hmxl_n(:,:,:) 
     234      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 
     235         eb    (ji,jj,jk) = en    (ji,jj,jk) 
     236         hmxl_b(ji,jj,jk) = hmxl_n(ji,jj,jk) 
     237      END_3D 
    229238 
    230239      IF( nn_clos == 0 ) THEN    ! Mellor-Yamada 
    231          DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     240         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    232241            zup   = hmxl_n(ji,jj,jk) * gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) 
    233242            zdown = vkarmn * gdepw(ji,jj,jk,Kmm) * ( -gdepw(ji,jj,jk,Kmm) + gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) ) 
    … …  
    250259      ! Warning : after this step, en : right hand side of the matrix 
    251260 
    252       DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     261      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    253262         ! 
    254263         buoy = - p_avt(ji,jj,jk) * rn2(ji,jj,jk)     ! stratif. destruction 
    … …  
    303312      ! 
    304313      CASE ( 0 )             ! Dirichlet boundary condition (set e at k=1 & 2) 
    305       ! First level 
    306       en   (:,:,1) = MAX(  rn_emin , rc02r * ustar2_surf(:,:) * (1._wp + (1._wp-zice_fra(:,:))*rsbc_tke1)**r2_3  ) 
    307       zd_lw(:,:,1) = en(:,:,1) 
    308       zd_up(:,:,1) = 0._wp 
    309       zdiag(:,:,1) = 1._wp 
    310       ! 
    311       ! One level below 
    312       en   (:,:,2) =  MAX(  rc02r * ustar2_surf(:,:) * (  1._wp + (1._wp-zice_fra(:,:))*rsbc_tke1 * ((zhsro(:,:)+gdepw(:,:,2,Kmm)) & 
    313          &                 / zhsro(:,:) )**(1.5_wp*ra_sf)  )**(2._wp/3._wp) , rn_emin   ) 
    314       zd_lw(:,:,2) = 0._wp 
    315       zd_up(:,:,2) = 0._wp 
    316       zdiag(:,:,2) = 1._wp 
    317       ! 
    318       ! 
     314         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     315            ! First level 
     316            en   (ji,jj,1) = MAX(  rn_emin , rc02r * ustar2_surf(ji,jj) * (1._wp + (1._wp-zice_fra(ji,jj))*rsbc_tke1)**r2_3  ) 
     317            zd_lw(ji,jj,1) = en(ji,jj,1) 
     318            zd_up(ji,jj,1) = 0._wp 
     319            zdiag(ji,jj,1) = 1._wp 
     320            ! 
     321            ! One level below 
     322            en   (ji,jj,2) =  MAX( rn_emin , rc02r * ustar2_surf(ji,jj) * (1._wp + (1._wp-zice_fra(ji,jj))*rsbc_tke1          & 
     323               &                             * ((zhsro(ji,jj)+gdepw(ji,jj,2,Kmm)) / zhsro(ji,jj) )**(1.5_wp*ra_sf)  )**r2_3 ) 
     324            zd_lw(ji,jj,2) = 0._wp 
     325            zd_up(ji,jj,2) = 0._wp 
     326            zdiag(ji,jj,2) = 1._wp 
     327         END_2D 
     328         ! 
     329         ! 
    319330      CASE ( 1 )             ! Neumann boundary condition (set d(e)/dz) 
    320       ! 
    321       ! Dirichlet conditions at k=1 
    322       en   (:,:,1) = MAX(  rc02r * ustar2_surf(:,:) * (1._wp + (1._wp-zice_fra(:,:))*rsbc_tke1)**r2_3 , rn_emin  ) 
    323       zd_lw(:,:,1) = en(:,:,1) 
    324       zd_up(:,:,1) = 0._wp 
    325       zdiag(:,:,1) = 1._wp 
    326       ! 
    327       ! at k=2, set de/dz=Fw 
    328       !cbr 
    329       DO_2D( 0, 0, 0, 0 )   ! zdiag zd_lw not defined/used on the halo 
    330          zdiag(ji,jj,2) = zdiag(ji,jj,2) +  zd_lw(ji,jj,2) ! Remove zd_lw from zdiag 
    331          zd_lw(ji,jj,2) = 0._wp 
    332       END_2D 
    333       zkar (:,:)   = (rl_sf + (vkarmn-rl_sf)*(1.-EXP(-rtrans*gdept(:,:,1,Kmm)/zhsro(:,:)) )) 
    334       zflxs(:,:)   = rsbc_tke2 * (1._wp-zice_fra(:,:)) * ustar2_surf(:,:)**1.5_wp * zkar(:,:) & 
    335           &                    * (  ( zhsro(:,:)+gdept(:,:,1,Kmm) ) / zhsro(:,:)  )**(1.5_wp*ra_sf) 
     331         ! 
     332         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     333            ! Dirichlet conditions at k=1 
     334            en   (ji,jj,1) = MAX(  rn_emin , rc02r * ustar2_surf(ji,jj) * (1._wp + (1._wp-zice_fra(ji,jj))*rsbc_tke1)**r2_3  ) 
     335            zd_lw(ji,jj,1) = en(ji,jj,1) 
     336            zd_up(ji,jj,1) = 0._wp 
     337            zdiag(ji,jj,1) = 1._wp 
     338            ! 
     339            ! at k=2, set de/dz=Fw 
     340            !cbr 
     341            ! zdiag zd_lw not defined/used on the halo 
     342            zdiag(ji,jj,2) = zdiag(ji,jj,2) +  zd_lw(ji,jj,2) ! Remove zd_lw from zdiag 
     343            zd_lw(ji,jj,2) = 0._wp 
     344            ! 
     345            zkar (ji,jj)   = (rl_sf + (vkarmn-rl_sf)*(1.-EXP(-rtrans*gdept(ji,jj,1,Kmm)/zhsro(ji,jj)) )) 
     346            zflxs(ji,jj)   = rsbc_tke2 * (1._wp-zice_fra(ji,jj)) * ustar2_surf(ji,jj)**1.5_wp * zkar(ji,jj) & 
     347                &                    * (  ( zhsro(ji,jj)+gdept(ji,jj,1,Kmm) ) / zhsro(ji,jj)  )**(1.5_wp*ra_sf) 
    336348!!gm why not   :                        * ( 1._wp + gdept(:,:,1,Kmm) / zhsro(:,:) )**(1.5_wp*ra_sf) 
    337       en(:,:,2) = en(:,:,2) + zflxs(:,:) / e3w(:,:,2,Kmm) 
    338       ! 
    339       ! 
     349            en(ji,jj,2) = en(ji,jj,2) + zflxs(ji,jj) / e3w(ji,jj,2,Kmm) 
     350         END_2D 
     351         ! 
     352         ! 
    340353      END SELECT 
    341354 
    … …  
    348361         !                      ! en(ibot) = u*^2 / Co2 and hmxl_n(ibot) = rn_lmin 
    349362         !                      ! Balance between the production and the dissipation terms 
    350          DO_2D( 0, 0, 0, 0 ) 
     363         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    351364!!gm This means that bottom and ocean w-level above have a specified "en" value.   Sure ???? 
    352365!!   With thick deep ocean level thickness, this may be quite large, no ??? 
    … …  
    365378         END_2D 
    366379         ! 
     380         ! NOTE: ctl_stop with ln_isfcav when using GLS 
    367381         IF( ln_isfcav) THEN     ! top boundary   (ocean cavity) 
    368             DO_2D( 0, 0, 0, 0 ) 
     382            DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    369383               itop   = mikt(ji,jj)       ! k   top w-point 
    370384               itopp1 = mikt(ji,jj) + 1   ! k+1 1st w-point below the top one 
    … …  
    384398      CASE ( 1 )             ! Neumman boundary condition 
    385399         ! 
    386          DO_2D( 0, 0, 0, 0 ) 
     400         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    387401            ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point 
    388402            ibotm1 = mbkt(ji,jj)          ! k-1 bottom level of w-point but >=1 
    … …  
    398412            en   (ji,jj,ibot) = z_en 
    399413         END_2D 
     414         ! NOTE: ctl_stop with ln_isfcav when using GLS 
    400415         IF( ln_isfcav) THEN     ! top boundary   (ocean cavity) 
    401             DO_2D( 0, 0, 0, 0 ) 
     416            DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    402417               itop   = mikt(ji,jj)       ! k   top w-point 
    403418               itopp1 = mikt(ji,jj) + 1   ! k+1 1st w-point below the top one 
    … …  
    420435      ! ---------------------------------------------------------- 
    421436      ! 
    422       DO_3D( 0, 0, 0, 0, 2, jpkm1 )                ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 
     437      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )                ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 
    423438         zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1) 
    424439      END_3D 
    425       DO_3D( 0, 0, 0, 0, 2, jpkm1 )                ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 
     440      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )                ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 
    426441         zd_lw(ji,jj,jk) = en(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) * zd_lw(ji,jj,jk-1) 
    427442      END_3D 
    428       DO_3DS( 0, 0, 0, 0, jpkm1, 2, -1 )           ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 
     443      DO_3DS_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpkm1, 2, -1 )           ! Third recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 
    429444         en(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * en(ji,jj,jk+1) ) / zdiag(ji,jj,jk) 
    430445      END_3D 
    431446      !                                            ! set the minimum value of tke 
    432       en(:,:,:) = MAX( en(:,:,:), rn_emin ) 
     447      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 
     448         en(ji,jj,jk) = MAX( en(ji,jj,jk), rn_emin ) 
     449      END_3D 
    433450 
    434451      !!----------------------------------------!! 
    … …  
    441458      ! 
    442459      CASE( 0 )               ! k-kl  (Mellor-Yamada) 
    443          DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     460         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    444461            psi(ji,jj,jk)  = eb(ji,jj,jk) * hmxl_b(ji,jj,jk) 
    445462         END_3D 
    446463         ! 
    447464      CASE( 1 )               ! k-eps 
    448          DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     465         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    449466            psi(ji,jj,jk)  = eps(ji,jj,jk) 
    450467         END_3D 
    451468         ! 
    452469      CASE( 2 )               ! k-w 
    453          DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     470         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    454471            psi(ji,jj,jk)  = SQRT( eb(ji,jj,jk) ) / ( rc0 * hmxl_b(ji,jj,jk) ) 
    455472         END_3D 
    456473         ! 
    457474      CASE( 3 )               ! generic 
    458          DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     475         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    459476            psi(ji,jj,jk)  = rc02 * eb(ji,jj,jk) * hmxl_b(ji,jj,jk)**rnn 
    460477         END_3D 
    … …  
    469486      ! Warning : after this step, en : right hand side of the matrix 
    470487 
    471       DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     488      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    472489         ! 
    473490         ! psi / k 
    … …  
    516533      CASE ( 0 )             ! Dirichlet boundary conditions 
    517534         ! 
    518          ! Surface value 
    519          zdep    (:,:)   = zhsro(:,:) * rl_sf ! Cosmetic 
    520          psi     (:,:,1) = rc0**rpp * en(:,:,1)**rmm * zdep(:,:)**rnn * tmask(:,:,1) 
    521          zd_lw(:,:,1) = psi(:,:,1) 
    522          zd_up(:,:,1) = 0._wp 
    523          zdiag(:,:,1) = 1._wp 
    524          ! 
    525          ! One level below 
    526          zkar    (:,:)   = (rl_sf + (vkarmn-rl_sf)*(1._wp-EXP(-rtrans*gdepw(:,:,2,Kmm)/zhsro(:,:) ))) 
    527          zdep    (:,:)   = (zhsro(:,:) + gdepw(:,:,2,Kmm)) * zkar(:,:) 
    528          psi     (:,:,2) = rc0**rpp * en(:,:,2)**rmm * zdep(:,:)**rnn * tmask(:,:,1) 
    529          zd_lw(:,:,2) = 0._wp 
    530          zd_up(:,:,2) = 0._wp 
    531          zdiag(:,:,2) = 1._wp 
     535         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     536            ! Surface value 
     537            zdep    (ji,jj)   = zhsro(ji,jj) * rl_sf ! Cosmetic 
     538            psi     (ji,jj,1) = rc0**rpp * en(ji,jj,1)**rmm * zdep(ji,jj)**rnn * tmask(ji,jj,1) 
     539            zd_lw(ji,jj,1) = psi(ji,jj,1) 
     540            zd_up(ji,jj,1) = 0._wp 
     541            zdiag(ji,jj,1) = 1._wp 
     542            ! 
     543            ! One level below 
     544            zkar    (ji,jj)   = (rl_sf + (vkarmn-rl_sf)*(1._wp-EXP(-rtrans*gdepw(ji,jj,2,Kmm)/zhsro(ji,jj) ))) 
     545            zdep    (ji,jj)   = (zhsro(ji,jj) + gdepw(ji,jj,2,Kmm)) * zkar(ji,jj) 
     546            psi     (ji,jj,2) = rc0**rpp * en(ji,jj,2)**rmm * zdep(ji,jj)**rnn * tmask(ji,jj,1) 
     547            zd_lw(ji,jj,2) = 0._wp 
     548            zd_up(ji,jj,2) = 0._wp 
     549            zdiag(ji,jj,2) = 1._wp 
     550         END_2D 
    532551         ! 
    533552      CASE ( 1 )             ! Neumann boundary condition on d(psi)/dz 
    534553         ! 
    535          ! Surface value: Dirichlet 
    536          zdep    (:,:)   = zhsro(:,:) * rl_sf 
    537          psi     (:,:,1) = rc0**rpp * en(:,:,1)**rmm * zdep(:,:)**rnn * tmask(:,:,1) 
    538          zd_lw(:,:,1) = psi(:,:,1) 
    539          zd_up(:,:,1) = 0._wp 
    540          zdiag(:,:,1) = 1._wp 
    541          ! 
    542          ! Neumann condition at k=2 
    543          DO_2D( 0, 0, 0, 0 )   ! zdiag zd_lw not defined/used on the halo 
     554         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     555            ! Surface value: Dirichlet 
     556            zdep    (ji,jj)   = zhsro(ji,jj) * rl_sf 
     557            psi     (ji,jj,1) = rc0**rpp * en(ji,jj,1)**rmm * zdep(ji,jj)**rnn * tmask(ji,jj,1) 
     558            zd_lw(ji,jj,1) = psi(ji,jj,1) 
     559            zd_up(ji,jj,1) = 0._wp 
     560            zdiag(ji,jj,1) = 1._wp 
     561            ! 
     562            ! Neumann condition at k=2, zdiag zd_lw not defined/used on the halo 
    544563            zdiag(ji,jj,2) = zdiag(ji,jj,2) +  zd_lw(ji,jj,2) ! Remove zd_lw from zdiag 
    545564            zd_lw(ji,jj,2) = 0._wp 
     565            ! 
     566            ! Set psi vertical flux at the surface: 
     567            zkar (ji,jj)   = rl_sf + (vkarmn-rl_sf)*(1._wp-EXP(-rtrans*gdept(ji,jj,1,Kmm)/zhsro(ji,jj) )) ! Lengh scale slope 
     568            zdep (ji,jj)   = ((zhsro(ji,jj) + gdept(ji,jj,1,Kmm)) / zhsro(ji,jj))**(rmm*ra_sf) 
     569            zflxs(ji,jj)   = (rnn + (1._wp-zice_fra(ji,jj))*rsbc_tke1 * (rnn + rmm*ra_sf) * zdep(ji,jj)) & 
     570               &           *(1._wp + (1._wp-zice_fra(ji,jj))*rsbc_tke1*zdep(ji,jj))**(2._wp*rmm/3._wp-1_wp) 
     571            zdep (ji,jj)   = rsbc_psi1 * (zwall_psi(ji,jj,1)*p_avm(ji,jj,1)+zwall_psi(ji,jj,2)*p_avm(ji,jj,2)) * & 
     572               &           ustar2_surf(ji,jj)**rmm * zkar(ji,jj)**rnn * (zhsro(ji,jj) + gdept(ji,jj,1,Kmm))**(rnn-1.) 
     573            zflxs(ji,jj)   = zdep(ji,jj) * zflxs(ji,jj) 
     574            psi  (ji,jj,2) = psi(ji,jj,2) + zflxs(ji,jj) / e3w(ji,jj,2,Kmm) 
    546575         END_2D 
    547          ! 
    548          ! Set psi vertical flux at the surface: 
    549          zkar (:,:)   = rl_sf + (vkarmn-rl_sf)*(1._wp-EXP(-rtrans*gdept(:,:,1,Kmm)/zhsro(:,:) )) ! Lengh scale slope 
    550          zdep (:,:)   = ((zhsro(:,:) + gdept(:,:,1,Kmm)) / zhsro(:,:))**(rmm*ra_sf) 
    551          zflxs(:,:)   = (rnn + (1._wp-zice_fra(:,:))*rsbc_tke1 * (rnn + rmm*ra_sf) * zdep(:,:)) & 
    552             &           *(1._wp + (1._wp-zice_fra(:,:))*rsbc_tke1*zdep(:,:))**(2._wp*rmm/3._wp-1_wp) 
    553          zdep (:,:)   = rsbc_psi1 * (zwall_psi(:,:,1)*p_avm(:,:,1)+zwall_psi(:,:,2)*p_avm(:,:,2)) * & 
    554             &           ustar2_surf(:,:)**rmm * zkar(:,:)**rnn * (zhsro(:,:) + gdept(:,:,1,Kmm))**(rnn-1.) 
    555          zflxs(:,:)   = zdep(:,:) * zflxs(:,:) 
    556          psi  (:,:,2) = psi(:,:,2) + zflxs(:,:) / e3w(:,:,2,Kmm) 
    557576         ! 
    558577      END SELECT 
    … …  
    569588         !                      ! en(ibot) = u*^2 / Co2 and hmxl_n(ibot) = vkarmn * r_z0_bot 
    570589         !                      ! Balance between the production and the dissipation terms 
    571          DO_2D( 0, 0, 0, 0 ) 
     590         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    572591            ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point 
    573592            ibotm1 = mbkt(ji,jj)          ! k-1 bottom level of w-point but >=1 
    … …  
    588607      CASE ( 1 )             ! Neumman boundary condition 
    589608         ! 
    590          DO_2D( 0, 0, 0, 0 ) 
     609         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    591610            ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point 
    592611            ibotm1 = mbkt(ji,jj)          ! k-1 bottom level of w-point but >=1 
    … …  
    616635      ! ---------------- 
    617636      ! 
    618       DO_3D( 0, 0, 0, 0, 2, jpkm1 )                ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 
     637      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )                ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 
    619638         zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1) 
    620639      END_3D 
    621       DO_3D( 0, 0, 0, 0, 2, jpkm1 )                ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 
     640      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )                ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 
    622641         zd_lw(ji,jj,jk) = psi(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) * zd_lw(ji,jj,jk-1) 
    623642      END_3D 
    624       DO_3DS( 0, 0, 0, 0, jpkm1, 2, -1 )           ! Third recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 
     643      DO_3DS( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpkm1, 2, -1 )           ! Third recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 
    625644         psi(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * psi(ji,jj,jk+1) ) / zdiag(ji,jj,jk) 
    626645      END_3D 
    … …  
    632651      ! 
    633652      CASE( 0 )               ! k-kl  (Mellor-Yamada) 
    634          DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     653         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
    635654            eps(ji,jj,jk) = rc03 * en(ji,jj,jk) * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / MAX( psi(ji,jj,jk), rn_epsmin) 
    636655         END_3D 
    637656         ! 
    638657      CASE( 1 )               ! k-eps 
    639          DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     658         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
    640659            eps(ji,jj,jk) = psi(ji,jj,jk) 
    641660         END_3D 
    642661         ! 
    643662      CASE( 2 )               ! k-w 
    644          DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     663         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
    645664            eps(ji,jj,jk) = rc04 * en(ji,jj,jk) * psi(ji,jj,jk) 
    646665         END_3D 
    … …  
    650669         zex1  =      ( 1.5_wp + rmm/rnn ) 
    651670         zex2  = -1._wp / rnn 
    652          DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     671         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
    653672            eps(ji,jj,jk) = zcoef * en(ji,jj,jk)**zex1 * psi(ji,jj,jk)**zex2 
    654673         END_3D 
    … …  
    658677      ! Limit dissipation rate under stable stratification 
    659678      ! -------------------------------------------------- 
    660       DO_3D( 0, 0, 0, 0, 1, jpkm1 )   ! Note that this set boundary conditions on hmxl_n at the same time 
     679      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )   ! Note that this set boundary conditions on hmxl_n at the same time 
    661680         ! limitation 
    662681         eps   (ji,jj,jk)  = MAX( eps(ji,jj,jk), rn_epsmin ) 
    663682         hmxl_n(ji,jj,jk)  = rc03 * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / eps(ji,jj,jk) 
    664          ! Galperin criterium (NOTE : Not required if the proper value of C3 in stable cases is calculated) 
    665          zrn2 = MAX( rn2(ji,jj,jk), rsmall ) 
    666          IF( ln_length_lim )   hmxl_n(ji,jj,jk) = MIN(  rn_clim_galp * SQRT( 2._wp * en(ji,jj,jk) / zrn2 ), hmxl_n(ji,jj,jk) ) 
    667       END_3D 
     683      END_3D 
     684      IF( ln_length_lim ) THEN        ! Galperin criterium (NOTE : Not required if the proper value of C3 in stable cases is calculated) 
     685         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
     686            zrn2 = MAX( rn2(ji,jj,jk), rsmall ) 
     687            hmxl_n(ji,jj,jk) = MIN(  rn_clim_galp * SQRT( 2._wp * en(ji,jj,jk) / zrn2 ), hmxl_n(ji,jj,jk) ) 
     688         END_3D 
     689      ENDIF 
    668690 
    669691      ! 
    … …  
    674696      ! 
    675697      CASE ( 0 , 1 )             ! Galperin or Kantha-Clayson stability functions 
    676          DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     698         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    677699            ! zcof =  l²/q² 
    678700            zcof = hmxl_b(ji,jj,jk) * hmxl_b(ji,jj,jk) / ( 2._wp*eb(ji,jj,jk) ) 
    … …  
    691713         ! 
    692714      CASE ( 2, 3 )               ! Canuto stability functions 
    693          DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     715         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    694716            ! zcof =  l²/q² 
    695717            zcof = hmxl_b(ji,jj,jk)*hmxl_b(ji,jj,jk) / ( 2._wp * eb(ji,jj,jk) ) 
    … …  
    723745      ! default value, in case jpk > mbkt(ji,jj)+1. Not needed but avoid a bug when looking for undefined values (-fpe0) 
    724746      zstm(:,:,jpk) = 0. 
    725       DO_2D( 0, 0, 0, 0 )             ! update bottom with good values 
     747      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )             ! update bottom with good values 
    726748         zstm(ji,jj,mbkt(ji,jj)+1) = zstm(ji,jj,mbkt(ji,jj)) 
    727749      END_2D 
    728750 
    729       zstt(:,:,  1) = wmask(:,:,  1)  ! default value not needed but avoid a bug when looking for undefined values (-fpe0) 
    730       zstt(:,:,jpk) = wmask(:,:,jpk)  ! default value not needed but avoid a bug when looking for undefined values (-fpe0) 
     751      zstt(:,:,  1) = wmask(A2D(nn_hls),  1)  ! default value not needed but avoid a bug when looking for undefined values (-fpe0) 
     752      zstt(:,:,jpk) = wmask(A2D(nn_hls),jpk)  ! default value not needed but avoid a bug when looking for undefined values (-fpe0) 
    731753 
    732754!!gm should be done for ISF (top boundary cond.) 
    … …  
    738760      !     later overwritten by surface/bottom boundaries conditions, so we don't really care of p_avm(:,:1) and p_avm(:,:jpk) 
    739761      !     for zd_lw and zd_up but they have to be defined to avoid a bug when looking for undefined values (-fpe0) 
    740       DO_3D( 0, 0, 0, 0, 1, jpk ) 
     762      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 
    741763         zsqen = SQRT( 2._wp * en(ji,jj,jk) ) * hmxl_n(ji,jj,jk) 
    742764         zavt  = zsqen * zstt(ji,jj,jk) 
    … …  
    745767         p_avm(ji,jj,jk) = MAX( zavm, avmb(jk) )                   ! Note that avm is not masked at the surface and the bottom 
    746768      END_3D 
    747       p_avt(:,:,1) = 0._wp 
     769      p_avt(A2D(nn_hls),1) = 0._wp 
    748770      ! 
    749771      IF(sn_cfctl%l_prtctl) THEN 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/ZDF/zdfiwm.F90

    r13497 r14852  
    125125      ! 
    126126      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    127       REAL(wp) ::   zztmp, ztmp1, ztmp2        ! scalar workspace 
    128       REAL(wp), DIMENSION(jpi,jpj)     ::   zfact       ! Used for vertical structure 
    129       REAL(wp), DIMENSION(jpi,jpj)     ::   zhdep       ! Ocean depth 
    130       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwkb        ! WKB-stretched height above bottom 
    131       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zweight     ! Weight for high mode vertical distribution 
    132       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   znu_t       ! Molecular kinematic viscosity (T grid) 
    133       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   znu_w       ! Molecular kinematic viscosity (W grid) 
    134       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zReb        ! Turbulence intensity parameter 
    135       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zemx_iwm    ! local energy density available for mixing (W/kg) 
    136       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zav_ratio   ! S/T diffusivity ratio (only for ln_tsdiff=T) 
    137       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zav_wave    ! Internal wave-induced diffusivity 
     127      REAL(wp), SAVE :: zztmp 
     128      REAL(wp)       :: ztmp1, ztmp2        ! scalar workspace 
     129      REAL(wp), DIMENSION(A2D(nn_hls))     ::   zfact       ! Used for vertical structure 
     130      REAL(wp), DIMENSION(A2D(nn_hls))     ::   zhdep       ! Ocean depth 
     131      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zwkb        ! WKB-stretched height above bottom 
     132      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zweight     ! Weight for high mode vertical distribution 
     133      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   znu_t       ! Molecular kinematic viscosity (T grid) 
     134      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   znu_w       ! Molecular kinematic viscosity (W grid) 
     135      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zReb        ! Turbulence intensity parameter 
     136      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zemx_iwm    ! local energy density available for mixing (W/kg) 
     137      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zav_ratio   ! S/T diffusivity ratio (only for ln_tsdiff=T) 
     138      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zav_wave    ! Internal wave-induced diffusivity 
    138139      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   z3d  ! 3D workspace used for iom_put  
    139140      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   z2d  ! 2D     -      -    -     - 
    … …  
    143144      ! Set to zero the 1st and last vertical levels of appropriate variables 
    144145      IF( iom_use("emix_iwm") ) THEN 
    145          DO_2D( 0, 0, 0, 0 ) 
     146         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    146147            zemx_iwm (ji,jj,1) = 0._wp   ;   zemx_iwm (ji,jj,jpk) = 0._wp 
    147148         END_2D 
    148149      ENDIF 
    149150      IF( iom_use("av_ratio") ) THEN 
    150          DO_2D( 0, 0, 0, 0 ) 
     151         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    151152            zav_ratio(ji,jj,1) = 0._wp   ;   zav_ratio(ji,jj,jpk) = 0._wp 
    152153         END_2D 
    153154      ENDIF 
    154155      IF( iom_use("av_wave") .OR. sn_cfctl%l_prtctl ) THEN 
    155          DO_2D( 0, 0, 0, 0 ) 
     156         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    156157            zav_wave (ji,jj,1) = 0._wp   ;   zav_wave (ji,jj,jpk) = 0._wp 
    157158         END_2D 
    … …  
    164165      !                       !* Critical slope mixing: distribute energy over the time-varying ocean depth, 
    165166      !                                                 using an exponential decay from the seafloor. 
    166       DO_2D( 0, 0, 0, 0 )             ! part independent of the level 
     167      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )             ! part independent of the level 
    167168         zhdep(ji,jj) = gdepw_0(ji,jj,mbkt(ji,jj)+1)       ! depth of the ocean 
    168169         zfact(ji,jj) = rho0 * (  1._wp - EXP( -zhdep(ji,jj) / hcri_iwm(ji,jj) )  ) 
    … …  
    170171      END_2D 
    171172!!gm gde3w ==>>>  check for ssh taken into account.... seem OK gde3w_n=gdept(:,:,:,Kmm) - ssh(:,:,Kmm) 
    172       DO_3D( 0, 0, 0, 0, 2, jpkm1 )   ! complete with the level-dependent part 
     173      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )   ! complete with the level-dependent part 
    173174         IF ( zfact(ji,jj) == 0._wp .OR. wmask(ji,jj,jk) == 0._wp ) THEN   ! optimization 
    174175            zemx_iwm(ji,jj,jk) = 0._wp 
    … …  
    190191      CASE ( 1 )               ! Dissipation scales as N (recommended) 
    191192         ! 
    192          DO_2D( 0, 0, 0, 0 ) 
     193         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    193194            zfact(ji,jj) = 0._wp 
    194195         END_2D 
    195          DO_3D( 0, 0, 0, 0, 2, jpkm1 )       ! part independent of the level 
     196         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )       ! part independent of the level 
    196197            zfact(ji,jj) = zfact(ji,jj) + e3w(ji,jj,jk,Kmm) * SQRT(  MAX( 0._wp, rn2(ji,jj,jk) )  ) * wmask(ji,jj,jk) 
    197198         END_3D 
    198199         ! 
    199          DO_2D( 0, 0, 0, 0 ) 
     200         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    200201            IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = epyc_iwm(ji,jj) / ( rho0 * zfact(ji,jj) ) 
    201202         END_2D 
    202203         ! 
    203          DO_3D( 0, 0, 0, 0, 2, jpkm1 )       ! complete with the level-dependent part 
     204         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )       ! complete with the level-dependent part 
    204205            zemx_iwm(ji,jj,jk) = zemx_iwm(ji,jj,jk) + zfact(ji,jj) * SQRT(  MAX( 0._wp, rn2(ji,jj,jk) )  ) * wmask(ji,jj,jk) 
    205206         END_3D 
    … …  
    207208      CASE ( 2 )               ! Dissipation scales as N^2 
    208209         ! 
    209          DO_2D( 0, 0, 0, 0 ) 
     210         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    210211            zfact(ji,jj) = 0._wp 
    211212         END_2D 
    212          DO_3D( 0, 0, 0, 0, 2, jpkm1 )       ! part independent of the level 
     213         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )       ! part independent of the level 
    213214            zfact(ji,jj) = zfact(ji,jj) + e3w(ji,jj,jk,Kmm) * MAX( 0._wp, rn2(ji,jj,jk) ) * wmask(ji,jj,jk) 
    214215         END_3D 
    215216         ! 
    216          DO_2D( 0, 0, 0, 0 ) 
     217         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    217218            IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = epyc_iwm(ji,jj) / ( rho0 * zfact(ji,jj) ) 
    218219         END_2D 
    219220         ! 
    220          DO_3D( 0, 0, 0, 0, 2, jpkm1 )       ! complete with the level-dependent part 
     221         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    221222            zemx_iwm(ji,jj,jk) = zemx_iwm(ji,jj,jk) + zfact(ji,jj) * MAX( 0._wp, rn2(ji,jj,jk) ) * wmask(ji,jj,jk) 
    222223         END_3D 
    … …  
    227228      !                        !* ocean depth as proportional to rn2 * exp(-z_wkb/rn_hbot) 
    228229      ! 
    229       DO_2D( 0, 0, 0, 0 ) 
     230      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    230231         zwkb(ji,jj,1) = 0._wp 
    231232      END_2D 
    232       DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     233      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    233234         zwkb(ji,jj,jk) = zwkb(ji,jj,jk-1) + e3w(ji,jj,jk,Kmm) * SQRT(  MAX( 0._wp, rn2(ji,jj,jk) )  ) * wmask(ji,jj,jk) 
    234235      END_3D 
    235       DO_2D( 0, 0, 0, 0 ) 
     236      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    236237         zfact(ji,jj) = zwkb(ji,jj,jpkm1) 
    237238      END_2D 
    238239      ! 
    239       DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     240      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    240241         IF( zfact(ji,jj) /= 0 )   zwkb(ji,jj,jk) = zhdep(ji,jj) * ( zfact(ji,jj) - zwkb(ji,jj,jk) )   & 
    241242            &                                     * wmask(ji,jj,jk) / zfact(ji,jj) 
    242243      END_3D 
    243       DO_2D( 0, 0, 0, 0 ) 
     244      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    244245         zwkb (ji,jj,1) = zhdep(ji,jj) * wmask(ji,jj,1) 
    245246      END_2D 
    246247      ! 
    247       DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     248      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    248249         IF ( rn2(ji,jj,jk) <= 0._wp .OR. wmask(ji,jj,jk) == 0._wp ) THEN   ! optimization: EXP coast a lot 
    249250            zweight(ji,jj,jk) = 0._wp 
    … …  
    254255      END_3D 
    255256      ! 
    256       DO_2D( 0, 0, 0, 0 ) 
     257      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    257258         zfact(ji,jj) = 0._wp 
    258259      END_2D 
    259       DO_3D( 0, 0, 0, 0, 2, jpkm1 )       ! part independent of the level 
     260      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )       ! part independent of the level 
    260261         zfact(ji,jj) = zfact(ji,jj) + zweight(ji,jj,jk) 
    261262      END_3D 
    262263      ! 
    263       DO_2D( 0, 0, 0, 0 ) 
     264      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    264265         IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = ebot_iwm(ji,jj) / ( rho0 * zfact(ji,jj) ) 
    265266      END_2D 
    266267      ! 
    267       DO_3D( 0, 0, 0, 0, 2, jpkm1 )       ! complete with the level-dependent part 
     268      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )       ! complete with the level-dependent part 
    268269         zemx_iwm(ji,jj,jk) = zemx_iwm(ji,jj,jk) + zweight(ji,jj,jk) * zfact(ji,jj) * wmask(ji,jj,jk)   & 
    269270            &                                                        / ( gde3w(ji,jj,jk) - gde3w(ji,jj,jk-1) ) 
    … …  
    273274!!gm  this is to be replaced by just a constant value znu=1.e-6 m2/s 
    274275      ! Calculate molecular kinematic viscosity 
    275       DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     276      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
    276277         znu_t(ji,jj,jk) = 1.e-4_wp * (  17.91_wp - 0.53810_wp * ts(ji,jj,jk,jp_tem,Kmm)   & 
    277278            &                                     + 0.00694_wp * ts(ji,jj,jk,jp_tem,Kmm) * ts(ji,jj,jk,jp_tem,Kmm)  & 
    278279            &                                     + 0.02305_wp * ts(ji,jj,jk,jp_sal,Kmm)  ) * tmask(ji,jj,jk) * r1_rho0 
    279280      END_3D 
    280       DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     281      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    281282         znu_w(ji,jj,jk) = 0.5_wp * ( znu_t(ji,jj,jk-1) + znu_t(ji,jj,jk) ) * wmask(ji,jj,jk) 
    282283      END_3D 
    … …  
    284285      ! 
    285286      ! Calculate turbulence intensity parameter Reb 
    286       DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     287      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    287288         zReb(ji,jj,jk) = zemx_iwm(ji,jj,jk) / MAX( 1.e-20_wp, znu_w(ji,jj,jk) * rn2(ji,jj,jk) ) 
    288289      END_3D 
    289290      ! 
    290291      ! Define internal wave-induced diffusivity 
    291       DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     292      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    292293         zav_wave(ji,jj,jk) = znu_w(ji,jj,jk) * zReb(ji,jj,jk) * r1_6   ! This corresponds to a constant mixing efficiency of 1/6 
    293294      END_3D 
    294295      ! 
    295296      IF( ln_mevar ) THEN                ! Variable mixing efficiency case : modify zav_wave in the 
    296          DO_3D( 0, 0, 0, 0, 2, jpkm1 )   ! energetic (Reb > 480) and buoyancy-controlled (Reb <10.224 ) regimes 
     297         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )   ! energetic (Reb > 480) and buoyancy-controlled (Reb <10.224 ) regimes 
    297298            IF( zReb(ji,jj,jk) > 480.00_wp ) THEN 
    298299               zav_wave(ji,jj,jk) = 3.6515_wp * znu_w(ji,jj,jk) * SQRT( zReb(ji,jj,jk) ) 
    … …  
    303304      ENDIF 
    304305      ! 
    305       DO_3D( 0, 0, 0, 0, 2, jpkm1 )      ! Bound diffusivity by molecular value and 100 cm2/s 
     306      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )      ! Bound diffusivity by molecular value and 100 cm2/s 
    306307         zav_wave(ji,jj,jk) = MIN(  MAX( 1.4e-7_wp, zav_wave(ji,jj,jk) ), 1.e-2_wp  ) * wmask(ji,jj,jk) 
    307308      END_3D 
    308309      ! 
    309310      IF( kt == nit000 ) THEN        !* Control print at first time-step: diagnose the energy consumed by zav_wave 
    310          zztmp = 0._wp 
     311         IF( .NOT. l_istiled .OR. ntile == 1 ) zztmp = 0._wp                    ! Do only on the first tile 
    311312!!gm used of glosum 3D.... 
    312313         DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    … …  
    314315               &          * MAX( 0._wp, rn2(ji,jj,jk) ) * zav_wave(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj) 
    315316         END_3D 
    316          CALL mpp_sum( 'zdfiwm', zztmp ) 
    317          zztmp = rho0 * zztmp ! Global integral of rauo * Kz * N^2 = power contributing to mixing  
    318          ! 
    319          IF(lwp) THEN 
    320             WRITE(numout,*) 
    321             WRITE(numout,*) 'zdf_iwm : Internal wave-driven mixing (iwm)' 
    322             WRITE(numout,*) '~~~~~~~ ' 
    323             WRITE(numout,*) 
    324             WRITE(numout,*) '      Total power consumption by av_wave =  ', zztmp * 1.e-12_wp, 'TW' 
     317 
     318         IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN                       ! Do only on the last tile 
     319            CALL mpp_sum( 'zdfiwm', zztmp ) 
     320            zztmp = rho0 * zztmp ! Global integral of rauo * Kz * N^2 = power contributing to mixing 
     321            ! 
     322            IF(lwp) THEN 
     323               WRITE(numout,*) 
     324               WRITE(numout,*) 'zdf_iwm : Internal wave-driven mixing (iwm)' 
     325               WRITE(numout,*) '~~~~~~~ ' 
     326               WRITE(numout,*) 
     327               WRITE(numout,*) '      Total power consumption by av_wave =  ', zztmp * 1.e-12_wp, 'TW' 
     328            ENDIF 
    325329         ENDIF 
    326330      ENDIF 
    … …  
    332336      IF( ln_tsdiff ) THEN                !* Option for differential mixing of salinity and temperature 
    333337         ztmp1 = 0.505_wp + 0.495_wp * TANH( 0.92_wp * ( LOG10( 1.e-20_wp ) - 0.60_wp ) ) 
    334          DO_3D( 0, 0, 0, 0, 2, jpkm1 )       ! Calculate S/T diffusivity ratio as a function of Reb 
     338         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )       ! Calculate S/T diffusivity ratio as a function of Reb 
    335339            ztmp2 = zReb(ji,jj,jk) * 5._wp * r1_6 
    336340            IF ( ztmp2 > 1.e-20_wp .AND. wmask(ji,jj,jk) == 1._wp ) THEN 
    … …  
    341345         END_3D 
    342346         CALL iom_put( "av_ratio", zav_ratio ) 
    343          DO_3D( 0, 0, 0, 0, 2, jpkm1 )    !* update momentum & tracer diffusivity with wave-driven mixing 
     347         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )    !* update momentum & tracer diffusivity with wave-driven mixing 
    344348            p_avs(ji,jj,jk) = p_avs(ji,jj,jk) + zav_wave(ji,jj,jk) * zav_ratio(ji,jj,jk) 
    345349            p_avt(ji,jj,jk) = p_avt(ji,jj,jk) + zav_wave(ji,jj,jk) 
    … …  
    348352         ! 
    349353      ELSE                                !* update momentum & tracer diffusivity with wave-driven mixing 
    350          DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     354         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    351355            p_avs(ji,jj,jk) = p_avs(ji,jj,jk) + zav_wave(ji,jj,jk) 
    352356            p_avt(ji,jj,jk) = p_avt(ji,jj,jk) + zav_wave(ji,jj,jk) 
    … …  
    361365                                          !  vertical integral of rho0 * Kz * N^2 , energy density (zemx_iwm) 
    362366      IF( iom_use("bflx_iwm") .OR. iom_use("pcmap_iwm") ) THEN 
    363          ALLOCATE( z2d(jpi,jpj) , z3d(jpi,jpj,jpk) ) 
     367         ALLOCATE( z2d(A2D(nn_hls)) , z3d(A2D(nn_hls),jpk) ) 
     368         z2d(:,:) = 0._wp ; z3d(:,:,:) = 0._wp 
     369 
    364370         ! Initialisation for iom_put 
    365371         DO_2D( 0, 0, 0, 0 ) 
    366372            z3d(ji,jj,1) = 0._wp   ;   z3d(ji,jj,jpk) = 0._wp 
    367373         END_2D 
    368          z3d(           1:nn_hls,:,:) = 0._wp   ;   z3d(:,           1:nn_hls,:) = 0._wp 
    369          z3d(jpi-nn_hls+1:jpi   ,:,:) = 0._wp   ;   z3d(:,jpj-nn_hls+1:   jpj,:) = 0._wp 
    370          z2d(           1:nn_hls,:  ) = 0._wp   ;   z2d(:,           1:nn_hls  ) = 0._wp 
    371          z2d(jpi-nn_hls+1:jpi   ,:  ) = 0._wp   ;   z2d(:,jpj-nn_hls+1:   jpj  ) = 0._wp 
    372374 
    373375         DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/ZDF/zdfmfc.F90

    r14789 r14852  
    9696      INTEGER                                  , INTENT(in)    :: Kmm, Krhs ! time level indices 
    9797      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts       ! active tracers and RHS of tracer equation 
    98       REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   ztsp         ! T/S of the plume 
    99       REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   ztse         ! T/S at W point 
    100       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zrwp          ! 
    101       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zrwp2         ! 
    102       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zapp          ! 
    103       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zedmf         ! 
    104       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zepsT, zepsW  ! 
    105       ! 
    106       REAL(wp), DIMENSION(jpi,jpj) :: zustar, zustar2   ! 
    107       REAL(wp), DIMENSION(jpi,jpj) :: zuws, zvws, zsws, zfnet          ! 
    108       REAL(wp), DIMENSION(jpi,jpj) :: zfbuo, zrautbm1, zrautb, zraupl 
    109       REAL(wp), DIMENSION(jpi,jpj) :: zwpsurf            ! 
    110       REAL(wp), DIMENSION(jpi,jpj) :: zop0 , zsp0 ! 
    111       REAL(wp), DIMENSION(jpi,jpj) :: zrwp_0, zrwp2_0  ! 
    112       REAL(wp), DIMENSION(jpi,jpj) :: zapp0           ! 
    113       REAL(wp), DIMENSION(jpi,jpj) :: zphp, zph, zphpm1, zphm1, zNHydro 
    114       REAL(wp), DIMENSION(jpi,jpj) :: zhcmo          ! 
    115       ! 
    116       REAL(wp), DIMENSION(jpi,jpj,jpk)   ::   zn2    ! N^2 
    117       REAL(wp), DIMENSION(jpi,jpj,2  ) ::   zab, zabm1, zabp ! alpha and beta 
     98      REAL(wp), DIMENSION(A2D(nn_hls),jpk,2) ::   ztsp         ! T/S of the plume 
     99      REAL(wp), DIMENSION(A2D(nn_hls),jpk,2) ::   ztse         ! T/S at W point 
     100      REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zrwp          ! 
     101      REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zrwp2         ! 
     102      REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zapp          ! 
     103      REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zedmf         ! 
     104      REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zepsT, zepsW  ! 
     105      ! 
     106      REAL(wp), DIMENSION(A2D(nn_hls)) :: zustar, zustar2   ! 
     107      REAL(wp), DIMENSION(A2D(nn_hls)) :: zuws, zvws, zsws, zfnet          ! 
     108      REAL(wp), DIMENSION(A2D(nn_hls)) :: zfbuo, zrautbm1, zrautb, zraupl 
     109      REAL(wp), DIMENSION(A2D(nn_hls)) :: zwpsurf            ! 
     110      REAL(wp), DIMENSION(A2D(nn_hls)) :: zop0 , zsp0 ! 
     111      REAL(wp), DIMENSION(A2D(nn_hls)) :: zrwp_0, zrwp2_0  ! 
     112      REAL(wp), DIMENSION(A2D(nn_hls)) :: zapp0           ! 
     113      REAL(wp), DIMENSION(A2D(nn_hls)) :: zphp, zph, zphpm1, zphm1, zNHydro 
     114      REAL(wp), DIMENSION(A2D(nn_hls)) :: zhcmo          ! 
     115      ! 
     116      REAL(wp), DIMENSION(A2D(nn_hls),jpk)   ::   zn2    ! N^2 
     117      REAL(wp), DIMENSION(A2D(nn_hls),2  ) ::   zab, zabm1, zabp ! alpha and beta 
    118118      
    119119      REAL(wp), PARAMETER :: zepsilon = 1.e-30                 ! local small value 
    … …  
    136136      zcd          = 1._wp 
    137137 
    138       !------------------------------------------------------------------ 
    139       ! Surface boundary condition 
    140       !------------------------------------------------------------------ 
    141       ! surface Stress 
    142       !-------------------- 
    143       zuws(:,:) = utau(:,:) * r1_rho0  
    144       zvws(:,:) = vtau(:,:) * r1_rho0  
    145       zustar2(:,:) = SQRT(zuws(:,:)*zuws(:,:)+zvws(:,:)*zvws(:,:)) 
    146       zustar(:,:)  = SQRT(zustar2(:,:)) 
    147  
    148       ! Heat Flux 
    149       !-------------------- 
    150       zfnet(:,:) = qns(:,:) + qsr(:,:) 
    151       zfnet(:,:) = zfnet(:,:) / (rho0 * rcp) 
    152  
    153       ! Water Flux 
    154       !--------------------- 
    155       zsws(:,:) = emp(:,:) 
    156  
    157       !------------------------------------------- 
    158       ! Initialisation of prognostic variables 
    159       !------------------------------------------- 
    160       zrwp (:,:,:) =  0._wp ; zrwp2(:,:,:) =  0._wp ; zedmf(:,:,:) =  0._wp 
    161       zph  (:,:)   =  0._wp ; zphm1(:,:)   =  0._wp ; zphpm1(:,:)  =  0._wp 
    162       ztsp(:,:,:,:)=  0._wp 
    163  
    164       ! Tracers inside plume (ztsp) and environment (ztse) 
    165       ztsp(:,:,1,jp_tem) = pts(:,:,1,jp_tem,Kmm) * tmask(:,:,1) 
    166       ztsp(:,:,1,jp_sal) = pts(:,:,1,jp_sal,Kmm) * tmask(:,:,1) 
    167       ztse(:,:,1,jp_tem) = pts(:,:,1,jp_tem,Kmm) * tmask(:,:,1) 
    168       ztse(:,:,1,jp_sal) = pts(:,:,1,jp_sal,Kmm) * tmask(:,:,1) 
     138      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     139         !------------------------------------------------------------------ 
     140         ! Surface boundary condition 
     141         !------------------------------------------------------------------ 
     142         ! surface Stress 
     143         !-------------------- 
     144         zuws(ji,jj) = utau(ji,jj) * r1_rho0 
     145         zvws(ji,jj) = vtau(ji,jj) * r1_rho0 
     146         zustar2(ji,jj) = SQRT(zuws(ji,jj)*zuws(ji,jj)+zvws(ji,jj)*zvws(ji,jj)) 
     147         zustar(ji,jj)  = SQRT(zustar2(ji,jj)) 
     148 
     149         ! Heat Flux 
     150         !-------------------- 
     151         zfnet(ji,jj) = qns(ji,jj) + qsr(ji,jj) 
     152         zfnet(ji,jj) = zfnet(ji,jj) / (rho0 * rcp) 
     153 
     154         ! Water Flux 
     155         !--------------------- 
     156         zsws(ji,jj) = emp(ji,jj) 
     157 
     158         !------------------------------------------- 
     159         ! Initialisation of prognostic variables 
     160         !------------------------------------------- 
     161         zrwp (ji,jj,:) =  0._wp ; zrwp2(ji,jj,:) =  0._wp ; zedmf(ji,jj,:) =  0._wp 
     162         zph  (ji,jj)   =  0._wp ; zphm1(ji,jj)   =  0._wp ; zphpm1(ji,jj)  =  0._wp 
     163         ztsp(ji,jj,:,:)=  0._wp 
     164 
     165         ! Tracers inside plume (ztsp) and environment (ztse) 
     166         ztsp(ji,jj,1,jp_tem) = pts(ji,jj,1,jp_tem,Kmm) * tmask(ji,jj,1) 
     167         ztsp(ji,jj,1,jp_sal) = pts(ji,jj,1,jp_sal,Kmm) * tmask(ji,jj,1) 
     168         ztse(ji,jj,1,jp_tem) = pts(ji,jj,1,jp_tem,Kmm) * tmask(ji,jj,1) 
     169         ztse(ji,jj,1,jp_sal) = pts(ji,jj,1,jp_sal,Kmm) * tmask(ji,jj,1) 
     170      END_2D 
    169171 
    170172      CALL eos( ztse(:,:,1,:) ,  zrautb(:,:) ) 
    … …  
    174176      ! Boundary Condition of Mass Flux (plume velo.; convective area, entrain/detrain) 
    175177      !------------------------------------------- 
    176       zhcmo(:,:) = e3t(:,:,1,Kmm) 
     178      zhcmo(:,:) = e3t(A1Di(nn_hls),A1Dj(nn_hls),1,Kmm) 
    177179      zfbuo(:,:)   = 0._wp 
    178180      WHERE ( ABS(zrautb(:,:)) > 1.e-20 ) zfbuo(:,:)   =   & 
    179          &      grav * ( 2.e-4_wp *zfnet(:,:) - 7.6E-4_wp*pts(:,:,1,jp_sal,Kmm)*zsws(:,:)/zrautb(:,:)) * zhcmo(:,:) 
     181         &      grav * ( 2.e-4_wp *zfnet(:,:)              & 
     182         &      - 7.6E-4_wp*pts(A2D(nn_hls),1,jp_sal,Kmm)  & 
     183         &      * zsws(:,:)/zrautb(:,:)) * zhcmo(:,:) 
    180184 
    181185      zedmf(:,:,1) = -0.065_wp*(ABS(zfbuo(:,:)))**(1._wp/3._wp)*SIGN(1.,zfbuo(:,:)) 
    … …  
    211215         CALL eos( ztsp(:,:,jk-1,:    ) ,  zraupl(:,:)   ) 
    212216 
    213          zphm1(:,:)  = zphm1(:,:)  + grav * zrautbm1(:,:) * e3t(:,:,jk-1, Kmm) 
    214          zphpm1(:,:) = zphpm1(:,:) + grav * zraupl(:,:)   * e3t(:,:,jk-1, Kmm) 
    215          zph(:,:)    = zphm1(:,:)  + grav * zrautb(:,:)   * e3t(:,:,jk  , Kmm) 
    216          zph(:,:)    = MAX( zph(:,:), zepsilon) 
     217         DO_2D( 0, 0, 0, 0 ) 
     218            zphm1(ji,jj)  = zphm1(ji,jj)  + grav * zrautbm1(ji,jj) * e3t(ji,jj,jk-1, Kmm) 
     219            zphpm1(ji,jj) = zphpm1(ji,jj) + grav * zraupl(ji,jj)   * e3t(ji,jj,jk-1, Kmm) 
     220            zph(ji,jj)    = zphm1(ji,jj)  + grav * zrautb(ji,jj)   * e3t(ji,jj,jk  , Kmm) 
     221            zph(ji,jj)    = MAX( zph(ji,jj), zepsilon) 
     222         END_2D 
    217223 
    218224         WHERE(zrautbm1 .NE. 0.) zfbuo(:,:)  =  grav * (zraupl(:,:) - zrautbm1(:,:)) / zrautbm1(:,:) 
    … …  
    322328 
    323329      ! Compute Mass Flux on T-point 
    324       DO jk=1,jpk-1 
    325          edmfm(:,:,jk) = (zedmf(:,:,jk+1)  + zedmf(:,:,jk) )*0.5_wp 
    326       END DO 
    327       edmfm(:,:,jpk) = zedmf(:,:,jpk)  
     330      DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     331         edmfm(ji,jj,jk) = (zedmf(ji,jj,jk+1)  + zedmf(ji,jj,jk) )*0.5_wp 
     332      END_3D 
     333      DO_2D( 0, 0, 0, 0 ) 
     334         edmfm(ji,jj,jpk) = zedmf(ji,jj,jpk) 
     335      END_2D 
    328336 
    329337      ! Save variable (on T point) 
    … …  
    338346      !  Computation of a tridiagonal matrix and right hand side terms of the linear system 
    339347      !================================================================================= 
    340       edmfa(:,:,:)     = 0._wp 
    341       edmfb(:,:,:)     = 0._wp 
    342       edmfc(:,:,:)     = 0._wp 
    343       edmftra(:,:,:,:) = 0._wp 
     348      DO_3D( 0, 0, 0, 0, 1, jpk ) 
     349         edmfa(ji,jj,jk)     = 0._wp 
     350         edmfb(ji,jj,jk)     = 0._wp 
     351         edmfc(ji,jj,jk)     = 0._wp 
     352         edmftra(ji,jj,jk,:) = 0._wp 
     353      END_3D 
    344354 
    345355      !--------------------------------------------------------------- 
    346356      ! Diagonal terms  
    347357      !--------------------------------------------------------------- 
    348       DO jk=1,jpk-1 
    349          edmfa(:,:,jk) =  0._wp 
    350          edmfb(:,:,jk) = -edmfm(:,:,jk  ) / e3w(:,:,jk+1,Kmm) 
    351          edmfc(:,:,jk) =  edmfm(:,:,jk+1) / e3w(:,:,jk+1,Kmm) 
    352       END DO 
    353       edmfa(:,:,jpk)   = -edmfm(:,:,jpk-1) / e3w(:,:,jpk,Kmm) 
    354       edmfb(:,:,jpk)   =  edmfm(:,:,jpk  ) / e3w(:,:,jpk,Kmm) 
    355       edmfc(:,:,jpk)   =  0._wp 
     358      DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     359         edmfa(ji,jj,jk) =  0._wp 
     360         edmfb(ji,jj,jk) = -edmfm(ji,jj,jk  ) / e3w(ji,jj,jk+1,Kmm) 
     361         edmfc(ji,jj,jk) =  edmfm(ji,jj,jk+1) / e3w(ji,jj,jk+1,Kmm) 
     362      END_3D 
     363      DO_2D( 0, 0, 0, 0 ) 
     364         edmfa(ji,jj,jpk)   = -edmfm(ji,jj,jpk-1) / e3w(ji,jj,jpk,Kmm) 
     365         edmfb(ji,jj,jpk)   =  edmfm(ji,jj,jpk  ) / e3w(ji,jj,jpk,Kmm) 
     366         edmfc(ji,jj,jpk)   =  0._wp 
     367      END_2D 
    356368 
    357369      !--------------------------------------------------------------- 
    358370      ! right hand side term for Temperature 
    359371      !--------------------------------------------------------------- 
    360       DO jk=1,jpk-1 
    361         edmftra(:,:,jk,1) = - edmfm(:,:,jk  ) * ztsp(:,:,jk  ,jp_tem) / e3w(:,:,jk+1,Kmm) & 
    362                           & + edmfm(:,:,jk+1) * ztsp(:,:,jk+1,jp_tem) / e3w(:,:,jk+1,Kmm) 
    363       END DO 
    364       edmftra(:,:,jpk,1) = - edmfm(:,:,jpk-1) * ztsp(:,:,jpk-1,jp_tem) / e3w(:,:,jpk,Kmm) & 
    365                          & + edmfm(:,:,jpk  ) * ztsp(:,:,jpk  ,jp_tem) / e3w(:,:,jpk,Kmm) 
    366                          
     372      DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     373        edmftra(ji,jj,jk,1) = - edmfm(ji,jj,jk  ) * ztsp(ji,jj,jk  ,jp_tem) / e3w(ji,jj,jk+1,Kmm) & 
     374                            & + edmfm(ji,jj,jk+1) * ztsp(ji,jj,jk+1,jp_tem) / e3w(ji,jj,jk+1,Kmm) 
     375      END_3D 
     376      DO_2D( 0, 0, 0, 0 ) 
     377         edmftra(ji,jj,jpk,1) = - edmfm(ji,jj,jpk-1) * ztsp(ji,jj,jpk-1,jp_tem) / e3w(ji,jj,jpk,Kmm) & 
     378                              & + edmfm(ji,jj,jpk  ) * ztsp(ji,jj,jpk  ,jp_tem) / e3w(ji,jj,jpk,Kmm) 
     379      END_2D 
     380 
    367381      !--------------------------------------------------------------- 
    368382      ! Right hand side term for Salinity 
    369383      !--------------------------------------------------------------- 
    370       DO jk=1,jpk-1 
    371          edmftra(:,:,jk,2) =  - edmfm(:,:,jk  ) * ztsp(:,:,jk  ,jp_sal) / e3w(:,:,jk+1,Kmm) & 
    372                            &  + edmfm(:,:,jk+1) * ztsp(:,:,jk+1,jp_sal) / e3w(:,:,jk+1,Kmm) 
    373       END DO 
    374       edmftra(:,:,jpk,2) = - edmfm(:,:,jpk-1) * ztsp(:,:,jpk-1,jp_sal) / e3w(:,:,jpk,Kmm) & 
    375                          & + edmfm(:,:,jpk  ) * ztsp(:,:,jpk  ,jp_sal) / e3w(:,:,jpk,Kmm) 
    376       ! 
    377       ! 
    378       CALL lbc_lnk( 'zdfmfc', edmfm,'T',1., edmfa,'T',1., edmfb,'T',1., edmfc,'T',1., edmftra(:,:,:,jp_tem),'T',1., edmftra(:,:,:,jp_sal),'T',1.) 
     384      DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     385         edmftra(ji,jj,jk,2) =  - edmfm(ji,jj,jk  ) * ztsp(ji,jj,jk  ,jp_sal) / e3w(ji,jj,jk+1,Kmm) & 
     386                             &  + edmfm(ji,jj,jk+1) * ztsp(ji,jj,jk+1,jp_sal) / e3w(ji,jj,jk+1,Kmm) 
     387      END_3D 
     388      DO_2D( 0, 0, 0, 0 ) 
     389         edmftra(ji,jj,jpk,2) = - edmfm(ji,jj,jpk-1) * ztsp(ji,jj,jpk-1,jp_sal) / e3w(ji,jj,jpk,Kmm) & 
     390                              & + edmfm(ji,jj,jpk  ) * ztsp(ji,jj,jpk  ,jp_sal) / e3w(ji,jj,jpk,Kmm) 
     391      END_2D 
    379392      ! 
    380393   END SUBROUTINE tra_mfc 
    … …  
    383396   SUBROUTINE diag_mfc( zdiagi, zdiagd, zdiags, p2dt, Kaa ) 
    384397 
    385       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::  zdiagi, zdiagd, zdiags  ! inout: tridaig. terms  
    386       REAL(wp)                        , INTENT(in   ) ::   p2dt                   ! tracer time-step 
    387       INTEGER                         , INTENT(in   ) ::   Kaa                    ! ocean time level indices 
     398      REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(inout) ::  zdiagi, zdiagd, zdiags  ! inout: tridaig. terms 
     399      REAL(wp)                            , INTENT(in   ) ::   p2dt                   ! tracer time-step 
     400      INTEGER                             , INTENT(in   ) ::   Kaa                    ! ocean time level indices 
    388401 
    389402      INTEGER  ::   ji, jj, jk  ! dummy  loop arguments    

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/ZDF/zdfmxl.F90

    r13497 r14852  
    2626   PRIVATE 
    2727 
    28    PUBLIC   zdf_mxl   ! called by zdfphy.F90 
     28   PUBLIC   zdf_mxl, zdf_mxl_turb   ! called by zdfphy.F90 
    2929 
    3030   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   nmln    !: number of level in the mixed layer (used by LDF, ZDF, TRD, TOP) 
    … …  
    4141   !!---------------------------------------------------------------------- 
    4242   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    43    !! $Id$  
     43   !! $Id$ 
    4444   !! Software governed by the CeCILL license (see ./LICENSE) 
    4545   !!---------------------------------------------------------------------- 
    … …  
    6565      !!                  ***  ROUTINE zdfmxl  *** 
    6666      !!                    
    67       !! ** Purpose :   Compute the turbocline depth and the mixed layer depth 
    68       !!              with density criteria. 
     67      !! ** Purpose :   Compute the mixed layer depth with density criteria. 
    6968      !! 
    7069      !! ** Method  :   The mixed layer depth is the shallowest W depth with  
    7170      !!      the density of the corresponding T point (just bellow) bellow a 
    7271      !!      given value defined locally as rho(10m) + rho_c 
    73       !!               The turbocline depth is the depth at which the vertical 
    74       !!      eddy diffusivity coefficient (resulting from the vertical physics 
    75       !!      alone, not the isopycnal part, see trazdf.F) fall below a given 
    76       !!      value defined locally (avt_c here taken equal to 5 cm/s2 by default) 
    7772      !! 
    78       !! ** Action  :   nmln, hmld, hmlp, hmlpt 
     73      !! ** Action  :   nmln, hmlp, hmlpt 
    7974      !!---------------------------------------------------------------------- 
    8075      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    … …  
    8277      ! 
    8378      INTEGER  ::   ji, jj, jk      ! dummy loop indices 
    84       INTEGER  ::   iikn, iiki, ikt ! local integer 
     79      INTEGER  ::   iik, ikt        ! local integer 
    8580      REAL(wp) ::   zN2_c           ! local scalar 
    86       INTEGER, DIMENSION(jpi,jpj) ::   imld   ! 2D workspace 
    8781      !!---------------------------------------------------------------------- 
    8882      ! 
    89       IF( kt == nit000 ) THEN 
    90          IF(lwp) WRITE(numout,*) 
    91          IF(lwp) WRITE(numout,*) 'zdf_mxl : mixed layer depth' 
    92          IF(lwp) WRITE(numout,*) '~~~~~~~ ' 
    93          !                             ! allocate zdfmxl arrays 
    94          IF( zdf_mxl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_mxl : unable to allocate arrays' ) 
     83      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     84         IF( kt == nit000 ) THEN 
     85            IF(lwp) WRITE(numout,*) 
     86            IF(lwp) WRITE(numout,*) 'zdf_mxl : mixed layer depth' 
     87            IF(lwp) WRITE(numout,*) '~~~~~~~ ' 
     88            !                             ! allocate zdfmxl arrays 
     89            IF( zdf_mxl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_mxl : unable to allocate arrays' ) 
     90         ENDIF 
    9591      ENDIF 
    9692      ! 
    9793      ! w-level of the mixing and mixed layers 
    98       nmln(:,:)  = nlb10                  ! Initialization to the number of w ocean point 
    99       hmlp(:,:)  = 0._wp                  ! here hmlp used as a dummy variable, integrating vertically N^2 
     94      DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls ) 
     95         nmln(ji,jj)  = nlb10                  ! Initialization to the number of w ocean point 
     96         hmlp(ji,jj)  = 0._wp                  ! here hmlp used as a dummy variable, integrating vertically N^2 
     97      END_2D 
    10098      zN2_c = grav * rho_c * r1_rho0      ! convert density criteria into N^2 criteria 
    101       DO_3D( 1, 1, 1, 1, nlb10, jpkm1 )   ! Mixed layer level: w-level 
     99      DO_3D_OVR( nn_hls, nn_hls, nn_hls, nn_hls, nlb10, jpkm1 )   ! Mixed layer level: w-level 
    102100         ikt = mbkt(ji,jj) 
    103101         hmlp(ji,jj) =   & 
    … …  
    105103         IF( hmlp(ji,jj) < zN2_c )   nmln(ji,jj) = MIN( jk , ikt ) + 1   ! Mixed layer level 
    106104      END_3D 
    107       ! 
    108       ! w-level of the turbocline and mixing layer (iom_use) 
    109       imld(:,:) = mbkt(:,:) + 1                ! Initialization to the number of w ocean point 
    110       DO_3DS( 1, 1, 1, 1, jpkm1, nlb10, -1 )   ! from the bottom to nlb10 
    111          IF( avt (ji,jj,jk) < avt_c * wmask(ji,jj,jk) )   imld(ji,jj) = jk      ! Turbocline  
    112       END_3D 
    113       ! depth of the mixing and mixed layers 
    114       DO_2D( 1, 1, 1, 1 ) 
    115          iiki = imld(ji,jj) 
    116          iikn = nmln(ji,jj) 
    117          hmld (ji,jj) = gdepw(ji,jj,iiki  ,Kmm) * ssmask(ji,jj)    ! Turbocline depth  
    118          hmlp (ji,jj) = gdepw(ji,jj,iikn  ,Kmm) * ssmask(ji,jj)    ! Mixed layer depth 
    119          hmlpt(ji,jj) = gdept(ji,jj,iikn-1,Kmm) * ssmask(ji,jj)    ! depth of the last T-point inside the mixed layer 
     105      ! depth of the mixed layer 
     106      DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls ) 
     107         iik = nmln(ji,jj) 
     108         hmlp (ji,jj) = gdepw(ji,jj,iik  ,Kmm) * ssmask(ji,jj)    ! Mixed layer depth 
     109         hmlpt(ji,jj) = gdept(ji,jj,iik-1,Kmm) * ssmask(ji,jj)    ! depth of the last T-point inside the mixed layer 
    120110      END_2D 
    121111      ! 
    122       IF( .NOT.l_offline ) THEN 
    123          IF( iom_use("mldr10_1") ) THEN 
    124             IF( ln_isfcav ) THEN  ;  CALL iom_put( "mldr10_1", hmlp - risfdep)   ! mixed layer thickness 
    125             ELSE                  ;  CALL iom_put( "mldr10_1", hmlp )            ! mixed layer depth 
    126             END IF 
     112      IF( .NOT.l_offline .AND. iom_use("mldr10_1") ) THEN 
     113         IF( ln_isfcav ) THEN  ;  CALL iom_put( "mldr10_1", hmlp - risfdep)   ! mixed layer thickness 
     114         ELSE                  ;  CALL iom_put( "mldr10_1", hmlp )            ! mixed layer depth 
    127115         END IF 
    128          IF( iom_use("mldkz5") ) THEN 
    129             IF( ln_isfcav ) THEN  ;  CALL iom_put( "mldkz5"  , hmld - risfdep )   ! turbocline thickness 
    130             ELSE                  ;  CALL iom_put( "mldkz5"  , hmld )             ! turbocline depth 
    131             END IF 
    132          ENDIF 
    133116      ENDIF 
    134117      ! 
    … …  
    137120   END SUBROUTINE zdf_mxl 
    138121 
     122 
     123   SUBROUTINE zdf_mxl_turb( kt, Kmm ) 
     124      !!---------------------------------------------------------------------- 
     125      !!                  ***  ROUTINE zdf_mxl_turb  *** 
     126      !! 
     127      !! ** Purpose :   Compute the turbocline depth. 
     128      !! 
     129      !! ** Method  :   The turbocline depth is the depth at which the vertical 
     130      !!      eddy diffusivity coefficient (resulting from the vertical physics 
     131      !!      alone, not the isopycnal part, see trazdf.F) fall below a given 
     132      !!      value defined locally (avt_c here taken equal to 5 cm/s2 by default) 
     133      !! 
     134      !! ** Action  :   hmld 
     135      !!---------------------------------------------------------------------- 
     136      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     137      INTEGER, INTENT(in) ::   Kmm  ! ocean time level index 
     138      ! 
     139      INTEGER  ::   ji, jj, jk      ! dummy loop indices 
     140      INTEGER  ::   iik             ! local integer 
     141      INTEGER, DIMENSION(A2D(nn_hls)) ::   imld   ! 2D workspace 
     142      !!---------------------------------------------------------------------- 
     143      ! 
     144      ! w-level of the turbocline and mixing layer (iom_use) 
     145      imld(:,:) = mbkt(A2D(nn_hls)) + 1                ! Initialization to the number of w ocean point 
     146      DO_3DS( 1, 1, 1, 1, jpkm1, nlb10, -1 )   ! from the bottom to nlb10 
     147         IF( avt (ji,jj,jk) < avt_c * wmask(ji,jj,jk) )   imld(ji,jj) = jk      ! Turbocline 
     148      END_3D 
     149      ! depth of the mixing layer 
     150      DO_2D_OVR( 1, 1, 1, 1 ) 
     151         iik = imld(ji,jj) 
     152         hmld (ji,jj) = gdepw(ji,jj,iik  ,Kmm) * ssmask(ji,jj)    ! Turbocline depth 
     153      END_2D 
     154      ! 
     155      IF( .NOT.l_offline .AND. iom_use("mldkz5") ) THEN 
     156         IF( ln_isfcav ) THEN  ;  CALL iom_put( "mldkz5"  , hmld - risfdep )   ! turbocline thickness 
     157         ELSE                  ;  CALL iom_put( "mldkz5"  , hmld )             ! turbocline depth 
     158         END IF 
     159      ENDIF 
     160      ! 
     161   END SUBROUTINE zdf_mxl_turb 
    139162   !!====================================================================== 
    140163END MODULE zdfmxl 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/ZDF/zdfphy.F90

    r14789 r14852  
    1212   !!---------------------------------------------------------------------- 
    1313   USE oce            ! ocean dynamics and tracers variables 
     14   ! TEMP: [tiling] This change not necessary after finalisation of zdf_osm (not yet tiled) 
     15   USE domtile 
    1416   USE zdf_oce        ! vertical physics: shared variables 
    1517   USE zdfdrg         ! vertical physics: top/bottom drag coef. 
    … …  
    5456   INTEGER, PARAMETER ::   np_OSM = 5   ! OSMOSIS-OBL closure scheme for Kz 
    5557 
    56    LOGICAL ::   l_zdfsh2   ! shear production term flag (=F for CST, =T otherwise (i.e. TKE, GLS, RIC)) 
    57  
     58   LOGICAL, PUBLIC ::   l_zdfsh2   ! shear production term flag (=F for CST, =T otherwise (i.e. TKE, GLS, RIC)) 
     59 
     60   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   avm_k_n !: "Now" avm_k used for calculation of zsh2 with tiling 
     61 
     62   !! * Substitutions 
     63#  include "do_loop_substitute.h90" 
    5864   !!---------------------------------------------------------------------- 
    5965   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    180186      IF( lk_top    .AND. ln_zdfnpc )   CALL ctl_stop( 'zdf_phy_init: npc scheme is not working with key_top' ) 
    181187      IF( lk_top    .AND. ln_zdfosm )   CALL ctl_warn( 'zdf_phy_init: osmosis gives no non-local fluxes for TOP tracers yet' ) 
     188      ! TEMP: [tiling] This change not necessary after finalisation of zdf_osm (not yet tiled) 
     189      IF( ln_tile   .AND. ln_zdfosm )   CALL ctl_warn( 'zdf_phy_init: osmosis does not yet work with tiling' ) 
    182190      IF( lk_top    .AND. ln_zdfmfc )   CALL ctl_stop( 'zdf_phy_init: Mass Flux scheme is not working with key_top' ) 
    183191      IF(lwp) THEN 
    … …  
    210218      ENDIF 
    211219      !                                ! shear production term flag 
    212       IF( ln_zdfcst ) THEN   ;   l_zdfsh2 = .FALSE. 
    213       ELSE                   ;   l_zdfsh2 = .TRUE. 
    214       ENDIF 
     220      IF( ln_zdfcst .OR. ln_zdfosm ) THEN   ;   l_zdfsh2 = .FALSE. 
     221      ELSE                                  ;   l_zdfsh2 = .TRUE. 
     222      ENDIF 
     223      IF( ln_tile .AND. l_zdfsh2 ) ALLOCATE( avm_k_n(jpi,jpj,jpk) ) 
    215224      !                          !== Mass Flux Convectiive algorithm  ==! 
    216225      IF( ln_zdfmfc )   CALL zdf_mfc_init       ! Convection computed with eddy diffusivity mass flux 
    … …  
    246255      ! 
    247256      INTEGER ::   ji, jj, jk   ! dummy loop indice 
    248       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zsh2   ! shear production 
     257      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zsh2   ! shear production 
     258      ! TEMP: [tiling] This change not necessary after finalisation of zdf_osm (not yet tiled) 
     259      LOGICAL :: lskip 
    249260      !! --------------------------------------------------------------------- 
    250261      ! 
    251262      IF( ln_timing )   CALL timing_start('zdf_phy') 
     263 
     264      ! TEMP: [tiling] These changes not necessary after finalisation of zdf_osm (not yet tiled) 
     265      lskip = .FALSE. 
     266 
     267      IF( ln_tile .AND. nzdf_phy == np_OSM )  THEN 
     268         IF( ntile == 1 ) THEN 
     269            CALL dom_tile_stop( ldhold=.TRUE. ) 
     270         ELSE 
     271            lskip = .TRUE. 
     272         ENDIF 
     273      ENDIF 
    252274      ! 
    253275      IF( l_zdfdrg ) THEN     !==  update top/bottom drag  ==!   (non-linear cases) 
    … …  
    267289      IF ( ln_drgice_imp) THEN 
    268290         IF ( ln_isfcav ) THEN 
    269             rCdU_top(:,:) = rCdU_top(:,:) + ssmask(:,:) * tmask(:,:,1) * rCdU_ice(:,:) 
     291            DO_2D_OVR( 1, 1, 1, 1 ) 
     292               rCdU_top(ji,jj) = rCdU_top(ji,jj) + ssmask(ji,jj) * tmask(ji,jj,1) * rCdU_ice(ji,jj) 
     293            END_2D 
    270294         ELSE 
    271             rCdU_top(:,:) = rCdU_ice(:,:) 
     295            DO_2D_OVR( 1, 1, 1, 1 ) 
     296               rCdU_top(ji,jj) = rCdU_ice(ji,jj) 
     297            END_2D 
    272298         ENDIF 
    273299      ENDIF 
    274300#endif 
    275301      ! 
    276       !                       !==  Kz from chosen turbulent closure  ==!   (avm_k, avt_k) 
    277       ! 
    278       IF( l_zdfsh2 )   &         !* shear production at w-points (energy conserving form) 
    279          CALL zdf_sh2( Kbb, Kmm, avm_k,   &     ! <<== in 
    280             &                     zsh2    )     ! ==>> out : shear production 
    281       ! 
    282       SELECT CASE ( nzdf_phy )                  !* Vertical eddy viscosity and diffusivity coefficients at w-points 
    283       CASE( np_RIC )   ;   CALL zdf_ric( kt,      Kmm, zsh2, avm_k, avt_k )    ! Richardson number dependent Kz 
    284       CASE( np_TKE )   ;   CALL zdf_tke( kt, Kbb, Kmm, zsh2, avm_k, avt_k )    ! TKE closure scheme for Kz 
    285       CASE( np_GLS )   ;   CALL zdf_gls( kt, Kbb, Kmm, zsh2, avm_k, avt_k )    ! GLS closure scheme for Kz 
    286       CASE( np_OSM )   ;   CALL zdf_osm( kt, Kbb, Kmm, Krhs, avm_k, avt_k )    ! OSMOSIS closure scheme for Kz 
    287 !     CASE( np_CST )                                  ! Constant Kz (reset avt, avm to the background value) 
    288 !         ! avt_k and avm_k set one for all at initialisation phase 
     302      CALL zdf_mxl( kt, Kmm )                        !* mixed layer depth, and level 
     303 
     304      ! TEMP: [tiling] These changes not necessary after finalisation of zdf_osm (not yet tiled) 
     305      IF( .NOT. lskip ) THEN 
     306         !                       !==  Kz from chosen turbulent closure  ==!   (avm_k, avt_k) 
     307         ! 
     308         ! NOTE: [tiling] the closure schemes (zdf_tke etc) will update avm_k. With tiling, the calculation of zsh2 on adjacent tiles then uses both updated (next timestep) and non-updated (current timestep) values of avm_k. To preserve results, we save a read-only copy of the "now" avm_k to use in the calculation of zsh2. 
     309         IF( l_zdfsh2 ) THEN        !* shear production at w-points (energy conserving form) 
     310            IF( ln_tile ) THEN 
     311               IF( ntile == 1 ) avm_k_n(:,:,:) = avm_k(:,:,:)     ! Preserve "now" avm_k for calculation of zsh2 
     312               CALL zdf_sh2( Kbb, Kmm, avm_k_n, &     ! <<== in 
     313                  &                     zsh2    )     ! ==>> out : shear production 
     314            ELSE 
     315               CALL zdf_sh2( Kbb, Kmm, avm_k,   &     ! <<== in 
     316                  &                     zsh2    )     ! ==>> out : shear production 
     317            ENDIF 
     318         ENDIF 
     319         ! 
     320         SELECT CASE ( nzdf_phy )                  !* Vertical eddy viscosity and diffusivity coefficients at w-points 
     321         CASE( np_RIC )   ;   CALL zdf_ric( kt,      Kmm, zsh2, avm_k, avt_k )    ! Richardson number dependent Kz 
     322         CASE( np_TKE )   ;   CALL zdf_tke( kt, Kbb, Kmm, zsh2, avm_k, avt_k )    ! TKE closure scheme for Kz 
     323         CASE( np_GLS )   ;   CALL zdf_gls( kt, Kbb, Kmm, zsh2, avm_k, avt_k )    ! GLS closure scheme for Kz 
     324         CASE( np_OSM )   ;   CALL zdf_osm( kt, Kbb, Kmm, Krhs, avm_k, avt_k )    ! OSMOSIS closure scheme for Kz 
     325   !     CASE( np_CST )                                  ! Constant Kz (reset avt, avm to the background value) 
     326   !         ! avt_k and avm_k set one for all at initialisation phase 
    289327!!gm         avt(2:jpim1,2:jpjm1,1:jpkm1) = rn_avt0 * wmask(2:jpim1,2:jpjm1,1:jpkm1) 
    290328!!gm         avm(2:jpim1,2:jpjm1,1:jpkm1) = rn_avm0 * wmask(2:jpim1,2:jpjm1,1:jpkm1) 
    291       END SELECT 
     329         END SELECT 
     330 
     331         IF( ln_tile .AND. .NOT. l_istiled ) CALL dom_tile_start( ldhold=.TRUE. ) 
     332      ENDIF 
    292333      ! 
    293334      !                          !==  ocean Kz  ==!   (avt, avs, avm) 
    294335      ! 
    295336      !                                         !* start from turbulent closure values 
    296       avt(:,:,2:jpkm1) = avt_k(:,:,2:jpkm1) 
    297       avm(:,:,2:jpkm1) = avm_k(:,:,2:jpkm1) 
     337      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
     338         avt(ji,jj,jk) = avt_k(ji,jj,jk) 
     339         avm(ji,jj,jk) = avm_k(ji,jj,jk) 
     340      END_3D 
    298341      ! 
    299342      IF( ln_rnf_mouth ) THEN                   !* increase diffusivity at rivers mouths 
    300          DO jk = 2, nkrnf 
    301             avt(:,:,jk) = avt(:,:,jk) + 2._wp * rn_avt_rnf * rnfmsk(:,:) * wmask(:,:,jk) 
    302          END DO 
     343         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, nkrnf ) 
     344            avt(ji,jj,jk) = avt(ji,jj,jk) + 2._wp * rn_avt_rnf * rnfmsk(ji,jj) * wmask(ji,jj,jk) 
     345         END_3D 
    303346      ENDIF 
    304347      ! 
    … …  
    309352                        CALL zdf_ddm( kt, Kmm,  avm, avt, avs ) 
    310353      ELSE                                            ! same mixing on all tracers 
    311          avs(2:jpim1,2:jpjm1,1:jpkm1) = avt(2:jpim1,2:jpjm1,1:jpkm1) 
     354         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
     355            avs(ji,jj,jk) = avt(ji,jj,jk) 
     356         END_3D 
    312357      ENDIF 
    313358      ! 
    … …  
    318363#if defined key_agrif 
    319364      ! interpolation parent grid => child grid for avm_k ( ex : at west border: update column 1 and 2) 
    320       IF( l_zdfsh2 )   CALL Agrif_avm 
     365      IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN                       ! Do only on the last tile 
     366         IF( l_zdfsh2 )   CALL Agrif_avm 
     367      ENDIF 
    321368#endif 
    322369 
    323370      !                                         !* Lateral boundary conditions (sign unchanged) 
    324       IF( l_zdfsh2 ) THEN 
    325          CALL lbc_lnk( 'zdfphy', avm_k, 'W', 1.0_wp , avt_k, 'W', 1.0_wp,   & 
    326             &                    avm  , 'W', 1.0_wp , avt  , 'W', 1.0_wp , avs , 'W', 1.0_wp ) 
    327       ELSE 
    328          CALL lbc_lnk( 'zdfphy', avm  , 'W', 1.0_wp , avt  , 'W', 1.0_wp , avs , 'W', 1.0_wp ) 
    329       ENDIF 
    330       ! 
    331       IF( l_zdfdrg ) THEN     ! drag  have been updated (non-linear cases) 
    332          IF( ln_isfcav ) THEN   ;  CALL lbc_lnk( 'zdfphy', rCdU_top, 'T', 1.0_wp , rCdU_bot, 'T', 1.0_wp )   ! top & bot drag 
    333          ELSE                   ;  CALL lbc_lnk( 'zdfphy', rCdU_bot, 'T', 1.0_wp )                       ! bottom drag only 
    334          ENDIF 
    335       ENDIF 
    336       ! 
    337       CALL zdf_mxl( kt, Kmm )                        !* mixed layer depth, and level 
    338       ! 
    339       IF( lrst_oce ) THEN                       !* write TKE, GLS or RIC fields in the restart file 
    340          IF( ln_zdftke )   CALL tke_rst( kt, 'WRITE' ) 
    341          IF( ln_zdfgls )   CALL gls_rst( kt, 'WRITE' ) 
    342          IF( ln_zdfric )   CALL ric_rst( kt, 'WRITE' ) 
    343          ! NB. OSMOSIS restart (osm_rst) will be called in step.F90 after ww has been updated 
     371      IF(nn_hls==1) THEN 
     372         IF( l_zdfsh2 ) THEN 
     373            CALL lbc_lnk( 'zdfphy', avm_k, 'W', 1.0_wp , avt_k, 'W', 1.0_wp,   & 
     374                  &                 avm  , 'W', 1.0_wp , avt  , 'W', 1.0_wp , avs , 'W', 1.0_wp ) 
     375         ELSE 
     376            CALL lbc_lnk( 'zdfphy', avm  , 'W', 1.0_wp , avt  , 'W', 1.0_wp , avs , 'W', 1.0_wp ) 
     377         ENDIF 
     378         ! 
     379         IF( l_zdfdrg ) THEN     ! drag  have been updated (non-linear cases) 
     380            IF( ln_isfcav ) THEN   ;  CALL lbc_lnk( 'zdfphy', rCdU_top, 'T', 1.0_wp , rCdU_bot, 'T', 1.0_wp )   ! top & bot drag 
     381            ELSE                   ;  CALL lbc_lnk( 'zdfphy', rCdU_bot, 'T', 1.0_wp )                           ! bottom drag only 
     382            ENDIF 
     383         ENDIF 
     384      ENDIF 
     385      ! 
     386      CALL zdf_mxl_turb( kt, Kmm )                   !* turbocline depth 
     387      ! 
     388      IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN                       ! Do only on the last tile 
     389         IF( lrst_oce ) THEN                       !* write TKE, GLS or RIC fields in the restart file 
     390            IF( ln_zdftke )   CALL tke_rst( kt, 'WRITE' ) 
     391            IF( ln_zdfgls )   CALL gls_rst( kt, 'WRITE' ) 
     392            IF( ln_zdfric )   CALL ric_rst( kt, 'WRITE' ) 
     393            ! NB. OSMOSIS restart (osm_rst) will be called in step.F90 after ww has been updated 
     394         ENDIF 
    344395      ENDIF 
    345396      ! 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/ZDF/zdfric.F90

    r14789 r14852  
    145145      !!              PFJ Lermusiaux 2001. 
    146146      !!---------------------------------------------------------------------- 
    147       INTEGER                   , INTENT(in   ) ::   kt             ! ocean time-step 
    148       INTEGER                   , INTENT(in   ) ::   Kmm            ! ocean time level index 
    149       REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   p_sh2          ! shear production term 
    150       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   p_avm, p_avt   ! momentum and tracer Kz (w-points) 
     147      INTEGER                             , INTENT(in   ) ::   kt             ! ocean time-step 
     148      INTEGER                             , INTENT(in   ) ::   Kmm            ! ocean time level index 
     149      REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(in   ) ::   p_sh2          ! shear production term 
     150      REAL(wp), DIMENSION(:,:,:)          , INTENT(inout) ::   p_avm, p_avt   ! momentum and tracer Kz (w-points) 
    151151      !! 
    152152      INTEGER  ::   ji, jj, jk                  ! dummy loop indices 
    153153      REAL(wp) ::   zcfRi, zav, zustar, zhek    ! local scalars 
    154       REAL(wp), DIMENSION(jpi,jpj) ::   zh_ekm  ! 2D workspace 
     154      REAL(wp), DIMENSION(A2D(nn_hls)) ::   zh_ekm  ! 2D workspace 
    155155      !!---------------------------------------------------------------------- 
    156156      ! 
    157157      !                       !==  avm and avt = F(Richardson number)  ==! 
    158       DO_3D( 1, 0, 1, 0, 2, jpkm1 )       ! coefficient = F(richardson number) (avm-weighted Ri) 
     158      DO_3D_OVR( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 2, jpkm1 )       ! coefficient = F(richardson number) (avm-weighted Ri) 
    159159         zcfRi = 1._wp / (  1._wp + rn_alp * MAX(  0._wp , avm(ji,jj,jk) * rn2(ji,jj,jk) / ( p_sh2(ji,jj,jk) + 1.e-20 ) )  ) 
    160160         zav   = rn_avmri * zcfRi**nn_ric 
    … …  
    169169      IF( ln_mldw ) THEN      !==  set a minimum value in the Ekman layer  ==! 
    170170         ! 
    171          DO_2D( 0, 0, 0, 0 )             !* Ekman depth 
     171         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )  
    172172            zustar = SQRT( taum(ji,jj) * r1_rho0 ) 
    173173            zhek   = rn_ekmfc * zustar / ( ABS( ff_t(ji,jj) ) + rsmall )   ! Ekman depth 
    174174            zh_ekm(ji,jj) = MAX(  rn_mldmin , MIN( zhek , rn_mldmax )  )   ! set allowed range 
    175175         END_2D 
    176          DO_3D( 0, 0, 0, 0, 2, jpkm1 )   !* minimum mixing coeff. within the Ekman layer 
     176         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )   !* minimum mixing coeff. within the Ekman layer 
    177177            IF( gdept(ji,jj,jk,Kmm) < zh_ekm(ji,jj) ) THEN 
    178178               p_avm(ji,jj,jk) = MAX(  p_avm(ji,jj,jk), rn_wvmix  ) * wmask(ji,jj,jk) 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/ZDF/zdfsh2.F90

    r14789 r14852  
    5555      !! References :   Bruchard, OM 2002 
    5656      !! --------------------------------------------------------------------- 
    57       INTEGER                    , INTENT(in   ) ::   Kbb, Kmm             ! ocean time level indices 
    58       REAL(wp), DIMENSION(:,:,:) , INTENT(in   ) ::   p_avm                ! vertical eddy viscosity (w-points) 
    59       REAL(wp), DIMENSION(:,:,:) , INTENT(  out) ::   p_sh2                ! shear production of TKE (w-points) 
     57      INTEGER                              , INTENT(in   ) ::   Kbb, Kmm             ! ocean time level indices 
     58      REAL(wp), DIMENSION(:,:,:)           , INTENT(in   ) ::   p_avm                ! vertical eddy viscosity (w-points) 
     59      REAL(wp), DIMENSION(A2D(nn_hls),jpk) , INTENT(  out) ::   p_sh2                ! shear production of TKE (w-points) 
    6060      ! 
    6161      INTEGER  ::   ji, jj, jk   ! dummy loop arguments 
    62       REAL(wp), DIMENSION(jpi,jpj) ::   zsh2u, zsh2v   ! 2D workspace 
     62      REAL(wp), DIMENSION(A2D(nn_hls)) ::   zsh2u, zsh2v   ! 2D workspace 
    6363      !!-------------------------------------------------------------------- 
    6464      ! 
    6565      DO jk = 2, jpkm1                 !* Shear production at uw- and vw-points (energy conserving form) 
    6666         IF ( cpl_sdrftx .AND. ln_stshear )  THEN       ! Surface Stokes Drift available  ===>>>  shear + stokes drift contibution 
    67             DO_2D( 1, 0, 1, 0 ) 
     67            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    6868               zsh2u(ji,jj) = ( p_avm(ji+1,jj,jk) + p_avm(ji,jj,jk) )        & 
    6969                  &         * ( uu (ji,jj,jk-1,Kmm) -   uu (ji,jj,jk,Kmm)    & 
    … …  
    7878            END_2D 
    7979         ELSE 
    80             DO_2D( 1, 0, 1, 0 )     !* 2 x shear production at uw- and vw-points (energy conserving form) 
     80            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )     !* 2 x shear production at uw- and vw-points (energy conserving form) 
    8181               zsh2u(ji,jj) = ( p_avm(ji+1,jj,jk) + p_avm(ji,jj,jk) ) & 
    8282                  &         * (   uu(ji,jj,jk-1,Kmm) -   uu(ji,jj,jk,Kmm) ) & 
    … …  
    9191            END_2D 
    9292         ENDIF 
    93          DO_2D( 0, 0, 0, 0 )     !* shear production at w-point ! coast mask: =2 at the coast ; =1 otherwise (NB: wmask useless as zsh2 are masked) 
     93         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )     !* shear production at w-point ! coast mask: =2 at the coast ; =1 otherwise (NB: wmask useless as zsh2 are masked) 
    9494            p_sh2(ji,jj,jk) = 0.25 * (   ( zsh2u(ji-1,jj) + zsh2u(ji,jj) ) * ( 2. - umask(ji-1,jj,jk) * umask(ji,jj,jk) )   & 
    9595               &                       + ( zsh2v(ji,jj-1) + zsh2v(ji,jj) ) * ( 2. - vmask(ji,jj-1,jk) * vmask(ji,jj,jk) )   ) 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/ZDF/zdfswm.F90

    r13295 r14852  
    6363      ! 
    6464      zcoef = 1._wp * 0.353553_wp 
    65       DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     65      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    6666         zqb = zcoef * hsw(ji,jj) * tsd2d(ji,jj) * EXP( -3. * wnum(ji,jj) * gdepw(ji,jj,jk,Kmm) ) * wmask(ji,jj,jk) 
    6767         ! 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/ZDF/zdftke.F90

    r14789 r14852  
    168168      !!              Bruchard OM 2002 
    169169      !!---------------------------------------------------------------------- 
    170       INTEGER                   , INTENT(in   ) ::   kt             ! ocean time step 
    171       INTEGER                   , INTENT(in   ) ::   Kbb, Kmm       ! ocean time level indices 
    172       REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   p_sh2          ! shear production term 
    173       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   p_avm, p_avt   !  momentum and tracer Kz (w-points) 
     170      INTEGER                             , INTENT(in   ) ::   kt             ! ocean time step 
     171      INTEGER                             , INTENT(in   ) ::   Kbb, Kmm       ! ocean time level indices 
     172      REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(in   ) ::   p_sh2          ! shear production term 
     173      REAL(wp), DIMENSION(:,:,:)          , INTENT(inout) ::   p_avm, p_avt   !  momentum and tracer Kz (w-points) 
    174174      !!---------------------------------------------------------------------- 
    175175      ! 
    … …  
    201201      USE zdf_oce , ONLY : en   ! ocean vertical physics 
    202202      !! 
    203       INTEGER                    , INTENT(in   ) ::   Kbb, Kmm       ! ocean time level indices 
    204       REAL(wp), DIMENSION(:,:,:) , INTENT(in   ) ::   p_sh2          ! shear production term 
    205       REAL(wp), DIMENSION(:,:,:) , INTENT(in   ) ::   p_avm, p_avt   ! vertical eddy viscosity & diffusivity (w-points) 
     203      INTEGER                              , INTENT(in   ) ::   Kbb, Kmm       ! ocean time level indices 
     204      REAL(wp), DIMENSION(A2D(nn_hls),jpk) , INTENT(in   ) ::   p_sh2          ! shear production term 
     205      REAL(wp), DIMENSION(:,:,:)           , INTENT(in   ) ::   p_avm, p_avt   ! vertical eddy viscosity & diffusivity (w-points) 
    206206      ! 
    207207      INTEGER ::   ji, jj, jk                  ! dummy loop arguments 
    … …  
    216216      REAL(wp) ::   zzd_up, zzd_lw             !   -      - 
    217217      REAL(wp) ::   ztaui, ztauj, z1_norm 
    218       INTEGER , DIMENSION(jpi,jpj)     ::   imlc 
    219       REAL(wp), DIMENSION(jpi,jpj)     ::   zice_fra, zhlc, zus3, zWlc2 
    220       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zpelc, zdiag, zd_up, zd_lw 
     218      INTEGER , DIMENSION(A2D(nn_hls))     ::   imlc 
     219      REAL(wp), DIMENSION(A2D(nn_hls))     ::   zice_fra, zhlc, zus3, zWlc2 
     220      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zpelc, zdiag, zd_up, zd_lw 
    221221      !!-------------------------------------------------------------------- 
    222222      ! 
    … …  
    232232      SELECT CASE ( nn_eice ) 
    233233      CASE( 0 )   ;   zice_fra(:,:) = 0._wp 
    234       CASE( 1 )   ;   zice_fra(:,:) =        TANH( fr_i(:,:) * 10._wp ) 
    235       CASE( 2 )   ;   zice_fra(:,:) =              fr_i(:,:) 
    236       CASE( 3 )   ;   zice_fra(:,:) = MIN( 4._wp * fr_i(:,:) , 1._wp ) 
     234      CASE( 1 )   ;   zice_fra(:,:) =        TANH( fr_i(A2D(nn_hls)) * 10._wp ) 
     235      CASE( 2 )   ;   zice_fra(:,:) =              fr_i(A2D(nn_hls)) 
     236      CASE( 3 )   ;   zice_fra(:,:) = MIN( 4._wp * fr_i(A2D(nn_hls)) , 1._wp ) 
    237237      END SELECT 
    238238      ! 
    … …  
    241241      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    242242      ! 
    243       DO_2D( 0, 0, 0, 0 ) 
     243      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    244244         en(ji,jj,1) = MAX( rn_emin0, zbbrau * taum(ji,jj) ) 
    245245         zdiag(ji,jj,1) = 1._wp/en(ji,jj,1) 
    … …  
    258258      IF( .NOT.ln_drg_OFF ) THEN    !== friction used as top/bottom boundary condition on TKE 
    259259         ! 
    260          DO_2D( 0, 0, 0, 0 )        ! bottom friction 
     260         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )        ! bottom friction 
    261261            zmsku = ( 2. - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) ) 
    262262            zmskv = ( 2. - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) ) 
    … …  
    267267         END_2D 
    268268         IF( ln_isfcav ) THEN 
    269             DO_2D( 0, 0, 0, 0 )     ! top friction 
     269            DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )     ! top friction 
    270270               zmsku = ( 2. - umask(ji-1,jj,mikt(ji,jj)) * umask(ji,jj,mikt(ji,jj)) ) 
    271271               zmskv = ( 2. - vmask(ji,jj-1,mikt(ji,jj)) * vmask(ji,jj,mikt(ji,jj)) ) 
    … …  
    294294!!gm  ! PS: currently we don't have neither the 2 stress components at t-point !nor the angle between u* and u_s 
    295295!!gm  ! so we will overestimate the LC velocity....   !!gm I will do the work if !LC have an effect ! 
    296             DO_2D( 0, 0, 0, 0 ) 
     296            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    297297!!XC                  zWlc2(ji,jj) = 0.5_wp * SQRT( taum(ji,jj) * r1_rho0 * ( ut0sd(ji,jj)**2 +vt0sd(ji,jj)**2 )  ) 
    298298                  zWlc2(ji,jj) = 0.5_wp *  ( ut0sd(ji,jj)**2 +vt0sd(ji,jj)**2 ) 
    … …  
    301301!  Projection of Stokes drift in the wind stress direction 
    302302! 
    303             DO_2D( 0, 0, 0, 0 ) 
     303            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    304304                  ztaui   = 0.5_wp * ( utau(ji,jj) + utau(ji-1,jj) ) 
    305305                  ztauj   = 0.5_wp * ( vtau(ji,jj) + vtau(ji,jj-1) ) 
    … …  
    307307                  zWlc2(ji,jj) = 0.5_wp * z1_norm * ( MAX( ut0sd(ji,jj)*ztaui + vt0sd(ji,jj)*ztauj, 0._wp ) )**2 
    308308            END_2D 
    309          CALL lbc_lnk      ( 'zdftke', zWlc2, 'T', 1. ) 
    310 ! 
    311309         ELSE                          ! Surface Stokes drift deduced from surface stress 
    312310            !                                ! Wlc = u_s   with u_s = 0.016*U_10m, the surface stokes drift  (Axell 2002, Eq.44) 
    … …  
    315313            !                                ! 1/2 Wlc^2 = 0.5 * 0.016 * 0.016 |tau| /( rho_air Cdrag ) 
    316314            zcof = 0.5 * 0.016 * 0.016 / ( zrhoa * zcdrag )      ! to convert stress in 10m wind using a constant drag 
    317             DO_2D( 1, 1, 1, 1 ) 
     315            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    318316               zWlc2(ji,jj) = zcof * taum(ji,jj) 
    319317            END_2D 
    … …  
    323321         !                       !* Depth of the LC circulation  (Axell 2002, Eq.47) 
    324322         !                             !- LHS of Eq.47 
    325          zpelc(:,:,1) =  MAX( rn2b(:,:,1), 0._wp ) * gdepw(:,:,1,Kmm) * e3w(:,:,1,Kmm) 
    326          DO jk = 2, jpk 
    327             zpelc(:,:,jk)  = zpelc(:,:,jk-1) +   & 
    328                &        MAX( rn2b(:,:,jk), 0._wp ) * gdepw(:,:,jk,Kmm) * e3w(:,:,jk,Kmm) 
    329          END DO 
     323         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     324            zpelc(ji,jj,1) =  MAX( rn2b(ji,jj,1), 0._wp ) * gdepw(ji,jj,1,Kmm) * e3w(ji,jj,1,Kmm) 
     325         END_2D 
     326         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpk ) 
     327            zpelc(ji,jj,jk)  = zpelc(ji,jj,jk-1) +   & 
     328               &          MAX( rn2b(ji,jj,jk), 0._wp ) * gdepw(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm) 
     329         END_3D 
    330330         ! 
    331331         !                             !- compare LHS to RHS of Eq.47 
    332          imlc(:,:) = mbkt(:,:) + 1       ! Initialization to the number of w ocean point (=2 over land) 
    333          DO_3DS( 1, 1, 1, 1, jpkm1, 2, -1 ) 
     332         imlc(:,:) = mbkt(A2D(nn_hls)) + 1       ! Initialization to the number of w ocean point (=2 over land) 
     333         DO_3DS( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpkm1, 2, -1 ) 
    334334            IF( zpelc(ji,jj,jk) > zWlc2(ji,jj) )   imlc(ji,jj) = jk 
    335335         END_3D 
    336336         !                               ! finite LC depth 
    337          DO_2D( 1, 1, 1, 1 ) 
     337         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    338338            zhlc(ji,jj) = gdepw(ji,jj,imlc(ji,jj),Kmm) 
    339339         END_2D 
    340340         ! 
    341341         zcof = 0.016 / SQRT( zrhoa * zcdrag ) 
    342          DO_2D( 0, 0, 0, 0 ) 
     342         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    343343            zus = SQRT( 2. * zWlc2(ji,jj) )             ! Stokes drift 
    344344            zus3(ji,jj) = MAX( 0._wp, 1._wp - zice_fra(ji,jj) ) * zus * zus * zus * tmask(ji,jj,1) ! zus > 0. ok 
    345345         END_2D 
    346          DO_3D( 0, 0, 0, 0, 2, jpkm1 )                  !* TKE Langmuir circulation source term added to en 
     346         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )                  !* TKE Langmuir circulation source term added to en 
    347347            IF ( zus3(ji,jj) /= 0._wp ) THEN 
    348348               IF ( gdepw(ji,jj,jk,Kmm) - zhlc(ji,jj) < 0 .AND. wmask(ji,jj,jk) /= 0. ) THEN 
    … …  
    365365      ! 
    366366      IF( nn_pdl == 1 ) THEN          !* Prandtl number = F( Ri ) 
    367          DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     367         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    368368            !                             ! local Richardson number 
    369369            IF (rn2b(ji,jj,jk) <= 0.0_wp) then 
    … …  
    377377      ENDIF 
    378378      ! 
    379       DO_3D( 0, 0, 0, 0, 2, jpkm1 )   !* Matrix and right hand side in en 
     379      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )   !* Matrix and right hand side in en 
    380380         zcof   = zfact1 * tmask(ji,jj,jk) 
    381381         !                                   ! A minimum of 2.e-5 m2/s is imposed on TKE vertical 
    … …  
    406406 
    407407         CASE ( 0 ) ! Dirichlet BC 
    408             DO_2D( 0, 0, 0, 0 )    ! en(1)   = rn_ebb taum / rho0  (min value rn_emin0) 
     408            DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )    ! en(1)   = rn_ebb taum / rho0  (min value rn_emin0) 
    409409               IF ( phioc(ji,jj) < 0 )  phioc(ji,jj) = 0._wp 
    410410               en(ji,jj,1) = MAX( rn_emin0, .5 * ( 15.8 * phioc(ji,jj) / rho0 )**(2./3.) )  * tmask(ji,jj,1) 
    … …  
    413413 
    414414         CASE ( 1 ) ! Neumann BC 
    415             DO_2D( 0, 0, 0, 0 ) 
     415            DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    416416               IF ( phioc(ji,jj) < 0 )  phioc(ji,jj) = 0._wp 
    417417               en(ji,jj,2)    = en(ji,jj,2) + ( rn_Dt * phioc(ji,jj) / rho0 ) /e3w(ji,jj,2,Kmm) 
    … …  
    427427      ! 
    428428      !                          !* Matrix inversion from level 2 (tke prescribed at level 1) 
    429       DO_3D( 0, 0, 0, 0, 2, jpkm1 )                ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 
     429      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )                ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 
    430430         zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1) 
    431431      END_3D 
    … …  
    434434!         zd_lw(ji,jj,2) = en(ji,jj,2) - zd_lw(ji,jj,2) * en(ji,jj,1)    ! Surface boudary conditions on tke 
    435435!      END_2D 
    436       DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     436      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    437437         zd_lw(ji,jj,jk) = en(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) *zd_lw(ji,jj,jk-1) 
    438438      END_3D 
    439       DO_2D( 0, 0, 0, 0 )                          ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 
     439      DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )                          ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 
    440440         en(ji,jj,jpkm1) = zd_lw(ji,jj,jpkm1) / zdiag(ji,jj,jpkm1) 
    441441      END_2D 
    442       DO_3DS( 0, 0, 0, 0, jpk-2, 2, -1 ) 
     442      DO_3DS_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpk-2, 2, -1 ) 
    443443         en(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * en(ji,jj,jk+1) ) / zdiag(ji,jj,jk) 
    444444      END_3D 
    445       DO_3D( 0, 0, 0, 0, 2, jpkm1 )                ! set the minimum value of tke 
     445      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )                ! set the minimum value of tke 
    446446         en(ji,jj,jk) = MAX( en(ji,jj,jk), rn_emin ) * wmask(ji,jj,jk) 
    447447      END_3D 
    … …  
    456456      ! 
    457457      IF( nn_etau == 1 ) THEN           !* penetration below the mixed layer (rn_efr fraction) 
    458          DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     458         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    459459            en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -gdepw(ji,jj,jk,Kmm) / htau(ji,jj) )   & 
    460460               &                                 * MAX( 0._wp, 1._wp - zice_fra(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 
    461461         END_3D 
    462462      ELSEIF( nn_etau == 2 ) THEN       !* act only at the base of the mixed layer (jk=nmln)  (rn_efr fraction) 
    463          DO_2D( 0, 0, 0, 0 ) 
     463         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    464464            jk = nmln(ji,jj) 
    465465            en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -gdepw(ji,jj,jk,Kmm) / htau(ji,jj) )   & 
    … …  
    467467         END_2D 
    468468      ELSEIF( nn_etau == 3 ) THEN       !* penetration belox the mixed layer (HF variability) 
    469          DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     469         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    470470            ztx2 = utau(ji-1,jj  ) + utau(ji,jj) 
    471471            zty2 = vtau(ji  ,jj-1) + vtau(ji,jj) 
    … …  
    524524      REAL(wp) ::   zdku,   zdkv, zsqen       !   -      - 
    525525      REAL(wp) ::   zemxl, zemlm, zemlp, zmaxice       !   -      - 
    526       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zmxlm, zmxld   ! 3D workspace 
     526      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zmxlm, zmxld   ! 3D workspace 
    527527      !!-------------------------------------------------------------------- 
    528528      ! 
    … …  
    548548            zraug = vkarmn * 2.e5_wp / ( rho0 * grav ) 
    549549#if ! defined key_si3 && ! defined key_cice 
    550             DO_2D( 0, 0, 0, 0 )                  ! No sea-ice 
     550            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )                  ! No sea-ice 
    551551               zmxlm(ji,jj,1) =  zraug * taum(ji,jj) * tmask(ji,jj,1) 
    552552            END_2D 
    … …  
    555555            ! 
    556556            CASE( 0 )                      ! No scaling under sea-ice 
    557                DO_2D( 0, 0, 0, 0 ) 
     557               DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    558558                  zmxlm(ji,jj,1) = zraug * taum(ji,jj) * tmask(ji,jj,1) 
    559559               END_2D 
    560560               ! 
    561561            CASE( 1 )                      ! scaling with constant sea-ice thickness 
    562                DO_2D( 0, 0, 0, 0 ) 
     562               DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    563563                  zmxlm(ji,jj,1) =  ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 
    564564                     &                          fr_i(ji,jj)   * rn_mxlice           ) * tmask(ji,jj,1) 
    … …  
    566566               ! 
    567567            CASE( 2 )                      ! scaling with mean sea-ice thickness 
    568                DO_2D( 0, 0, 0, 0 ) 
     568               DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    569569#if defined key_si3 
    570570                  zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 
    … …  
    578578               ! 
    579579            CASE( 3 )                      ! scaling with max sea-ice thickness 
    580                DO_2D( 0, 0, 0, 0 ) 
     580               DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    581581                  zmaxice = MAXVAL( h_i(ji,jj,:) ) 
    582582                  zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 
    … …  
    587587#endif 
    588588            ! 
    589             DO_2D( 0, 0, 0, 0 ) 
     589            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    590590               zmxlm(ji,jj,1) = MAX( rn_mxl0, zmxlm(ji,jj,1) ) 
    591591            END_2D 
    … …  
    596596      ENDIF 
    597597      ! 
    598       DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     598      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    599599         zrn2 = MAX( rn2(ji,jj,jk), rsmall ) 
    600600         zmxlm(ji,jj,jk) = MAX(  rmxl_min,  SQRT( 2._wp * en(ji,jj,jk) / zrn2 )  ) 
    … …  
    611611      ! where wmask = 0 set zmxlm == e3w(:,:,:,Kmm) 
    612612      CASE ( 0 )           ! bounded by the distance to surface and bottom 
    613          DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     613         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    614614            zemxl = MIN( gdepw(ji,jj,jk,Kmm) - gdepw(ji,jj,mikt(ji,jj),Kmm), zmxlm(ji,jj,jk),   & 
    615615            &            gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) - gdepw(ji,jj,jk,Kmm) ) 
    … …  
    622622         ! 
    623623      CASE ( 1 )           ! bounded by the vertical scale factor 
    624          DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     624         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    625625            zemxl = MIN( e3w(ji,jj,jk,Kmm), zmxlm(ji,jj,jk) ) 
    626626            zmxlm(ji,jj,jk) = zemxl 
    … …  
    629629         ! 
    630630      CASE ( 2 )           ! |dk[xml]| bounded by e3t : 
    631          DO_3D( 0, 0, 0, 0, 2, jpkm1 )        ! from the surface to the bottom : 
     631         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )       ! from the surface to the bottom : 
    632632            zmxlm(ji,jj,jk) =   & 
    633633               &    MIN( zmxlm(ji,jj,jk-1) + e3t(ji,jj,jk-1,Kmm), zmxlm(ji,jj,jk) ) 
    634634         END_3D 
    635          DO_3DS( 0, 0, 0, 0, jpkm1, 2, -1 )   ! from the bottom to the surface : 
     635         DO_3DS( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpkm1, 2, -1 )   ! from the bottom to the surface : 
    636636            zemxl = MIN( zmxlm(ji,jj,jk+1) + e3t(ji,jj,jk+1,Kmm), zmxlm(ji,jj,jk) ) 
    637637            zmxlm(ji,jj,jk) = zemxl 
    … …  
    640640         ! 
    641641      CASE ( 3 )           ! lup and ldown, |dk[xml]| bounded by e3t : 
    642          DO_3D( 0, 0, 0, 0, 2, jpkm1 )        ! from the surface to the bottom : lup 
     642         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )        ! from the surface to the bottom : lup 
    643643            zmxld(ji,jj,jk) =    & 
    644644               &    MIN( zmxld(ji,jj,jk-1) + e3t(ji,jj,jk-1,Kmm), zmxlm(ji,jj,jk) ) 
    645645         END_3D 
    646          DO_3DS( 0, 0, 0, 0, jpkm1, 2, -1 )   ! from the bottom to the surface : ldown 
     646         DO_3DS( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpkm1, 2, -1 )   ! from the bottom to the surface : ldown 
    647647            zmxlm(ji,jj,jk) =   & 
    648648               &    MIN( zmxlm(ji,jj,jk+1) + e3t(ji,jj,jk+1,Kmm), zmxlm(ji,jj,jk) ) 
    649649         END_3D 
    650          DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     650         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    651651            zemlm = MIN ( zmxld(ji,jj,jk),  zmxlm(ji,jj,jk) ) 
    652652            zemlp = SQRT( zmxld(ji,jj,jk) * zmxlm(ji,jj,jk) ) 
    … …  
    660660      !                     !  Vertical eddy viscosity and diffusivity  (avm and avt) 
    661661      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    662       DO_3D( 0, 0, 0, 0, 1, jpkm1 )   !* vertical eddy viscosity & diffivity at w-points 
     662      DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )   !* vertical eddy viscosity & diffivity at w-points 
    663663         zsqen = SQRT( en(ji,jj,jk) ) 
    664664         zav   = rn_ediff * zmxlm(ji,jj,jk) * zsqen 
    … …  
    670670      ! 
    671671      IF( nn_pdl == 1 ) THEN          !* Prandtl number case: update avt 
    672          DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
     672         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    673673            p_avt(ji,jj,jk)   = MAX( apdlr(ji,jj,jk) * p_avt(ji,jj,jk), avtb_2d(ji,jj) * avtb(jk) ) * wmask(ji,jj,jk) 
    674674         END_3D 
    … …  
    786786      ! 
    787787      !                               !* Check of some namelist values 
    788       IF( nn_mxl  < 0   .OR.  nn_mxl  > 3 )   CALL ctl_stop( 'bad flag: nn_mxl is  0, 1 or 2 ' ) 
    789       IF( nn_pdl  < 0   .OR.  nn_pdl  > 1 )   CALL ctl_stop( 'bad flag: nn_pdl is  0 or 1    ' ) 
    790       IF( nn_htau < 0   .OR.  nn_htau > 1 )   CALL ctl_stop( 'bad flag: nn_htau is 0, 1 or 2 ' ) 
     788      IF( nn_mxl  < 0   .OR.  nn_mxl  > 3 )   CALL ctl_stop( 'bad flag: nn_mxl is  0, 1, 2 or 3' ) 
     789      IF( nn_pdl  < 0   .OR.  nn_pdl  > 1 )   CALL ctl_stop( 'bad flag: nn_pdl is  0 or 1' ) 
     790      IF( nn_htau < 0   .OR.  nn_htau > 1 )   CALL ctl_stop( 'bad flag: nn_htau is 0 or 1' ) 
    791791      IF( nn_etau == 3 .AND. .NOT. ln_cpl )   CALL ctl_stop( 'nn_etau == 3 : HF taum only known in coupled mode' ) 
    792792      ! 
    … …  
    796796         rn_mxl0 = rmxl_min 
    797797      ENDIF 
    798  
    799       IF( nn_etau == 2  )   CALL zdf_mxl( nit000, Kmm )      ! Initialization of nmln 
    800  
    801798      !                               !* depth of penetration of surface tke 
    802799      IF( nn_etau /= 0 ) THEN 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/do_loop_substitute.h90

    r14789 r14852  
    5959#endif 
    6060 
    61 #define DO_2D(L, R, B, T) DO jj = ntsj-(B), ntej+(T)   ;   DO ji = ntsi-(L), ntei+(R) 
     61#define DO_2D(L, R, B, T) DO jj = ntsj-(B), ntej+(T) ; DO ji = ntsi-(L), ntei+(R) 
     62#define DO_2D_OVR(L, R, B, T) DO_2D(L-(L+R)*nthl, R-(R+L)*nthr, B-(B+T)*nthb, T-(T+B)*ntht) 
    6263#define A1Di(H) ntsi-H:ntei+H 
    6364#define A1Dj(H) ntsj-H:ntej+H 
    … …  
    7071#define KJPT  : 
    7172 
    72 #define DO_3D(L, R, B, T, ks, ke) DO jk = ks, ke   ;   DO_2D(L, R, B, T) 
     73#define DO_3D(L, R, B, T, ks, ke) DO jk = ks, ke ; DO_2D(L, R, B, T) 
     74#define DO_3D_OVR(L, R, B, T, ks, ke) DO jk = ks, ke ; DO_2D_OVR(L, R, B, T) 
    7375 
    74 #define DO_3DS(L, R, B, T, ks, ke, ki) DO jk = ks, ke, ki   ;   DO_2D(L, R, B, T) 
     76#define DO_3DS(L, R, B, T, ks, ke, ki) DO jk = ks, ke, ki ; DO_2D(L, R, B, T) 
     77#define DO_3DS_OVR(L, R, B, T, ks, ke, ki) DO jk = ks, ke, ki ; DO_2D_OVR(L, R, B, T) 
    7578 
    7679#define END_2D   END DO   ;   END DO 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/module_example.F90

    r14789 r14852  
    102102      !!-------------------------------------------------------------------- 
    103103      ! 
    104       IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     104      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
    105105         IF( kt == nit000  )   CALL exa_mpl_init    ! Initialization (first time-step only) 
    106106 
    … …  
    175175      IF( exa_mpl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'exa_mpl_init : unable to allocate arrays' ) 
    176176      !                              ! Parameter control 
    177       IF( ln_tile .AND. ntile > 0 ) CALL ctl_stop( 'exa_mpl_init: tiling is not supported in this module by default, see manual for how to adapt your code' ) 
     177      IF( ln_tile ) CALL ctl_stop( 'exa_mpl_init: tiling is not supported in this module by default, see manual for how to adapt your code' ) 
    178178      IF( ln_opt      )   CALL ctl_stop( 'exa_mpl_init: this work and option xxx are incompatible'   ) 
    179179      IF( nn_opt == 2 )   CALL ctl_stop( 'STOP',  'exa_mpl_init: this work and option yyy may cause problems'  ) 
    … …  
    187187CONTAINS 
    188188   SUBROUTINE exa_mpl( kt, pvar1, pvar2, ptab )              ! Empty routine 
    189       REAL::   ptab(:,:) 
     189      INTEGER :: kt 
     190      REAL::   pvar1, pvar2, ptab(:,:) 
    190191      WRITE(*,*) 'exa_mpl: You should not have seen this print! error?', kt, pvar1, pvar2, ptab(1,1) 
    191192   END SUBROUTINE exa_mpl 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/nemogcm.F90

    r14789 r14852  
    390390      CALL mpp_init 
    391391 
     392#if defined key_loop_fusion 
     393      IF( nn_hls == 1 ) THEN 
     394         CALL ctl_stop( 'STOP', 'nemogcm : Loop fusion can be used only with extra-halo' ) 
     395      ENDIF 
     396#endif 
     397 
    392398      CALL halo_mng_init() 
    393399      ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/par_oce.F90

    r14789 r14852  
    7272   INTEGER, PUBLIC ::   ntei       !: end of internal part of tile domain 
    7373   INTEGER, PUBLIC ::   ntej       ! 
     74   INTEGER, PUBLIC ::   nthl, nthr !: Modifier on DO loop macro bound offset (left, right) 
     75   INTEGER, PUBLIC ::   nthb, ntht !:              "         "               (bottom, top) 
    7476 
    7577   !!--------------------------------------------------------------------- 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/step.F90

    r14789 r14852  
    174174 
    175175      !  VERTICAL PHYSICS 
     176      ! lbc_lnk needed for zdf_sh2 when using nn_hls = 2, moved here to allow tiling in zdf_phy 
     177      IF( nn_hls == 2 .AND. l_zdfsh2 ) CALL lbc_lnk( 'stp', avm_k, 'W', 1.0_wp ) 
     178 
     179      IF( ln_tile ) CALL dom_tile_start         ! [tiling] ZDF tiling loop 
     180      DO jtile = 1, nijtile 
     181         IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile ) 
     182 
    176183                         CALL zdf_phy( kstp, Nbb, Nnn, Nrhs )   ! vertical physics update (top/bot drag, avt, avs, avm + MLD) 
     184      END DO 
     185      IF( ln_tile ) CALL dom_tile_stop 
    177186 
    178187      !  LATERAL  PHYSICS 
    … …  
    181190                         CALL eos( ts(:,:,:,:,Nbb), rhd, gdept_0(:,:,:) )               ! before in situ density 
    182191 
    183          IF( ln_zps .AND. .NOT. ln_isfcav)                                    & 
     192      IF( ln_zps .AND. .NOT. ln_isfcav)                                    & 
    184193            &            CALL zps_hde    ( kstp, Nnn, jpts, ts(:,:,:,:,Nbb), gtsu, gtsv,  &  ! Partial steps: before horizontal gradient 
    185194            &                                          rhd, gru , grv    )       ! of t, s, rd at the last ocean level 
    186195 
    187          IF( ln_zps .AND.       ln_isfcav)                                                & 
     196      IF( ln_zps .AND.       ln_isfcav)                                                & 
    188197            &            CALL zps_hde_isf( kstp, Nnn, jpts, ts(:,:,:,:,Nbb), gtsu, gtsv, gtui, gtvi,  &  ! Partial steps for top cell (ISF) 
    189198            &                                          rhd, gru , grv , grui, grvi   )       ! of t, s, rd at the first ocean level 
    … …  
    213222                         vv(:,:,:,Nrhs) = 0._wp 
    214223 
    215       IF(  lk_asminc .AND. ln_asmiau .AND. ln_dyninc )   & 
    216                &         CALL dyn_asm_inc   ( kstp, Nbb, Nnn, uu, vv, Nrhs )  ! apply dynamics assimilation increment 
    217       IF( ln_bdy     )   CALL bdy_dyn3d_dmp ( kstp, Nbb,      uu, vv, Nrhs )  ! bdy damping trends 
    218 #if defined key_agrif 
     224      IF( ln_tile ) CALL dom_tile_start         ! [tiling] DYN tiling loop (1) 
     225      DO jtile = 1, nijtile 
     226         IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile ) 
     227 
     228         IF(  lk_asminc .AND. ln_asmiau .AND. ln_dyninc )   & 
     229                  &         CALL dyn_asm_inc   ( kstp, Nbb, Nnn, uu, vv, Nrhs )  ! apply dynamics assimilation increment 
     230         IF( ln_bdy     )   CALL bdy_dyn3d_dmp ( kstp, Nbb,      uu, vv, Nrhs )  ! bdy damping trends 
     231#if defined key_agrif 
     232      END DO 
     233      IF( ln_tile ) CALL dom_tile_stop 
     234 
    219235      IF(.NOT. Agrif_Root())  & 
    220236               &         CALL Agrif_Sponge_dyn        ! momentum sponge 
    221 #endif 
    222                          CALL dyn_adv( kstp, Nbb, Nnn      , uu, vv, Nrhs )  ! advection (VF or FF)   ==> RHS 
    223                          CALL dyn_vor( kstp,      Nnn      , uu, vv, Nrhs )  ! vorticity              ==> RHS 
    224                          CALL dyn_ldf( kstp, Nbb, Nnn      , uu, vv, Nrhs )  ! lateral mixing 
    225       IF( ln_zdfosm  )   CALL dyn_osm( kstp,      Nnn      , uu, vv, Nrhs )  ! OSMOSIS non-local velocity fluxes ==> RHS 
    226                          CALL dyn_hpg( kstp,      Nnn      , uu, vv, Nrhs )  ! horizontal gradient of Hydrostatic pressure 
    227                          CALL dyn_spg( kstp, Nbb, Nnn, Nrhs, uu, vv, ssh, uu_b, vv_b, Naa )  ! surface pressure gradient 
     237 
     238      IF( ln_tile ) CALL dom_tile_start         ! [tiling] DYN tiling loop (1, continued) 
     239      DO jtile = 1, nijtile 
     240         IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile ) 
     241#endif 
     242                            CALL dyn_adv( kstp, Nbb, Nnn      , uu, vv, Nrhs )  ! advection (VF or FF)   ==> RHS 
     243                            CALL dyn_vor( kstp,      Nnn      , uu, vv, Nrhs )  ! vorticity              ==> RHS 
     244                            CALL dyn_ldf( kstp, Nbb, Nnn      , uu, vv, Nrhs )  ! lateral mixing 
     245         IF( ln_zdfosm  )   CALL dyn_osm( kstp,      Nnn      , uu, vv, Nrhs )  ! OSMOSIS non-local velocity fluxes ==> RHS 
     246                            CALL dyn_hpg( kstp,      Nnn      , uu, vv, Nrhs )  ! horizontal gradient of Hydrostatic pressure 
     247      END DO 
     248      IF( ln_tile ) CALL dom_tile_stop 
     249 
     250                            CALL dyn_spg( kstp, Nbb, Nnn, Nrhs, uu, vv, ssh, uu_b, vv_b, Naa )  ! surface pressure gradient 
    228251 
    229252                                                      ! With split-explicit free surface, since now transports have been updated and ssh(:,:,Nrhs) as well 
    230253      IF( ln_dynspg_ts ) THEN                         ! vertical scale factors and vertical velocity need to be updated 
    231                             CALL div_hor       ( kstp, Nbb, Nnn )                ! Horizontal divergence  (2nd call in time-split case) 
    232          IF(.NOT.ln_linssh) CALL dom_vvl_sf_nxt( kstp, Nbb, Nnn, Naa, kcall=2 )  ! after vertical scale factors (update depth average component) 
    233       ENDIF 
    234                             CALL dyn_zdf    ( kstp, Nbb, Nnn, Nrhs, uu, vv, Naa  )  ! vertical diffusion 
     254         IF( ln_tile ) CALL dom_tile_start      ! [tiling] DYN tiling loop (2- div_hor only) 
     255         DO jtile = 1, nijtile 
     256            IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile ) 
     257 
     258                             CALL div_hor       ( kstp, Nbb, Nnn )               ! Horizontal divergence  (2nd call in time-split case) 
     259         END DO 
     260         IF( ln_tile ) CALL dom_tile_stop 
     261 
     262         IF(.NOT. ln_linssh) CALL dom_vvl_sf_nxt( kstp, Nbb, Nnn, Naa, kcall=2 )  ! after vertical scale factors (update depth average component) 
     263      ENDIF 
     264 
     265      IF( ln_tile ) CALL dom_tile_start         ! [tiling] DYN tiling loop (3- dyn_zdf only) 
     266      DO jtile = 1, nijtile 
     267         IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile ) 
     268 
     269                               CALL dyn_zdf    ( kstp, Nbb, Nnn, Nrhs, uu, vv, Naa  )  ! vertical diffusion 
     270      END DO 
     271      IF( ln_tile ) CALL dom_tile_stop 
     272 
    235273      IF( ln_dynspg_ts ) THEN                                                       ! vertical scale factors and vertical velocity need to be updated 
    236274                            CALL wzv        ( kstp, Nbb, Nnn, Naa, ww )             ! Nnn cross-level velocity 
    … …  
    268306      ! Active tracers 
    269307      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    270       ! Loop over tile domains 
    271       DO jtile = 1, nijtile 
    272          IF( ln_tile    )   CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile ) 
    273  
    274          DO_3D( 0, 0, 0, 0, 1, jpk ) 
    275             ts(ji,jj,jk,:,Nrhs) = 0._wp                                   ! set tracer trends to zero 
    276          END_3D 
     308                         ts(:,:,:,:,Nrhs) = 0._wp         ! set tracer trends to zero 
     309 
     310      IF( ln_tile ) CALL dom_tile_start         ! [tiling] TRA tiling loop (1) 
     311      DO jtile = 1, nijtile 
     312         IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile ) 
    277313 
    278314         IF(  lk_asminc .AND. ln_asmiau .AND. & 
    … …  
    286322         IF( ln_bdy     )   CALL bdy_tra_dmp( kstp, Nbb,      ts, Nrhs )  ! bdy damping trends 
    287323      END DO 
     324      IF( ln_tile ) CALL dom_tile_stop 
    288325 
    289326#if defined key_agrif 
    290327      IF(.NOT. Agrif_Root() )   THEN 
    291          IF( ln_tile    )   CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) 
    292328                            CALL Agrif_Sponge_tra        ! tracers sponge 
    293329      ENDIF 
    … …  
    295331 
    296332      ! TEMP: [tiling] Separate loop over tile domains (due to tra_adv workarounds for tiling) 
    297       DO jtile = 1, nijtile 
    298          IF( ln_tile    )   CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile ) 
     333      IF( ln_tile ) CALL dom_tile_start         ! [tiling] TRA tiling loop (2) 
     334      DO jtile = 1, nijtile 
     335         IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile ) 
    299336 
    300337                            CALL tra_adv    ( kstp, Nbb, Nnn, ts, Nrhs )  ! hor. + vert. advection ==> RHS 
    … …  
    309346         IF( ln_zdfnpc  )   CALL tra_npc    ( kstp,      Nnn, Nrhs, ts, Naa  )  ! update after fields by non-penetrative convection 
    310347      END DO 
    311  
    312       IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) ! Revert to tile over full domain 
     348      IF( ln_tile ) CALL dom_tile_stop 
     349 
    313350      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    314351      ! Set boundary conditions, time filter and swap time levels 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/stpmlf.F90

    r14789 r14852  
    6262#  include "do_loop_substitute.h90" 
    6363#  include "domzgr_substitute.h90" 
    64 #  include "do_loop_substitute.h90" 
    6564   !!---------------------------------------------------------------------- 
    6665   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    182181 
    183182      !  VERTICAL PHYSICS 
     183      IF( ln_tile ) CALL dom_tile_start         ! [tiling] ZDF tiling loop 
     184      DO jtile = 1, nijtile 
     185         IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile ) 
    184186                         CALL zdf_phy( kstp, Nbb, Nnn, Nrhs )   ! vertical physics update (top/bot drag, avt, avs, avm + MLD) 
     187      END DO 
     188      IF( ln_tile ) CALL dom_tile_stop 
    185189 
    186190      !  LATERAL  PHYSICS 
    … …  
    189193                         CALL eos( ts(:,:,:,:,Nbb), rhd, gdept_0(:,:,:) )               ! before in situ density 
    190194 
    191          IF( ln_zps .AND. .NOT. ln_isfcav)                                    & 
     195      IF( ln_zps .AND. .NOT. ln_isfcav)                                    & 
    192196            &            CALL zps_hde    ( kstp, Nnn, jpts, ts(:,:,:,:,Nbb), gtsu, gtsv,  &  ! Partial steps: before horizontal gradient 
    193197            &                                          rhd, gru , grv    )       ! of t, s, rd at the last ocean level 
    194198 
    195          IF( ln_zps .AND.       ln_isfcav)                                                & 
     199      IF( ln_zps .AND.       ln_isfcav)                                                & 
    196200            &            CALL zps_hde_isf( kstp, Nnn, jpts, ts(:,:,:,:,Nbb), gtsu, gtsv, gtui, gtvi,  &  ! Partial steps for top cell (ISF) 
    197201            &                                          rhd, gru , grv , grui, grvi   )       ! of t, s, rd at the first ocean level 
    … …  
    228232                         vv(:,:,:,Nrhs) = 0._wp 
    229233 
    230       IF(  lk_asminc .AND. ln_asmiau .AND. ln_dyninc )   & 
    231                &         CALL dyn_asm_inc   ( kstp, Nbb, Nnn, uu, vv, Nrhs )  ! apply dynamics assimilation increment 
    232       IF( ln_bdy     )   CALL bdy_dyn3d_dmp ( kstp, Nbb,      uu, vv, Nrhs )  ! bdy damping trends 
    233 #if defined key_agrif 
     234      IF( ln_tile ) CALL dom_tile_start         ! [tiling] DYN tiling loop (1) 
     235      DO jtile = 1, nijtile 
     236         IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile ) 
     237 
     238         IF(  lk_asminc .AND. ln_asmiau .AND. ln_dyninc )   & 
     239                  &         CALL dyn_asm_inc   ( kstp, Nbb, Nnn, uu, vv, Nrhs )  ! apply dynamics assimilation increment 
     240         IF( ln_bdy     )   CALL bdy_dyn3d_dmp ( kstp, Nbb,      uu, vv, Nrhs )  ! bdy damping trends 
     241#if defined key_agrif 
     242      END DO 
     243      IF( ln_tile ) CALL dom_tile_stop 
     244 
    234245      IF(.NOT. Agrif_Root())  & 
    235246               &         CALL Agrif_Sponge_dyn        ! momentum sponge 
    236 #endif 
    237                          CALL dyn_adv( kstp, Nbb, Nnn      , uu, vv, Nrhs )  ! advection (VF or FF)   ==> RHS 
    238                          CALL dyn_vor( kstp,      Nnn      , uu, vv, Nrhs )  ! vorticity              ==> RHS 
    239                          CALL dyn_ldf( kstp, Nbb, Nnn      , uu, vv, Nrhs )  ! lateral mixing 
    240       IF( ln_zdfosm  )   CALL dyn_osm( kstp,      Nnn      , uu, vv, Nrhs )  ! OSMOSIS non-local velocity fluxes ==> RHS 
    241                          CALL dyn_hpg( kstp,      Nnn      , uu, vv, Nrhs )  ! horizontal gradient of Hydrostatic pressure 
    242                          CALL dyn_spg( kstp, Nbb, Nnn, Nrhs, uu, vv, ssh, uu_b, vv_b, Naa )  ! surface pressure gradient 
    243                           
    244       IF( ln_dynspg_ts ) THEN      ! With split-explicit free surface, since now transports have been updated and ssh(:,:,Nrhs) 
    245                                    ! as well as vertical scale factors and vertical velocity need to be updated 
    246                             CALL div_hor    ( kstp, Nbb, Nnn )                ! Horizontal divergence  (2nd call in time-split case) 
    247          IF(.NOT.lk_linssh) CALL dom_qco_r3c( ssh(:,:,Naa), r3t(:,:,Naa), r3u(:,:,Naa), r3v(:,:,Naa), r3f(:,:) )   ! update ssh/h_0 ratio at t,u,v,f pts  
    248       ENDIF 
     247 
     248      IF( ln_tile ) CALL dom_tile_start         ! [tiling] DYN tiling loop (1, continued) 
     249      DO jtile = 1, nijtile 
     250         IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile ) 
     251#endif 
     252                            CALL dyn_adv( kstp, Nbb, Nnn      , uu, vv, Nrhs )  ! advection (VF or FF)   ==> RHS 
     253                            CALL dyn_vor( kstp,      Nnn      , uu, vv, Nrhs )  ! vorticity              ==> RHS 
     254                            CALL dyn_ldf( kstp, Nbb, Nnn      , uu, vv, Nrhs )  ! lateral mixing 
     255         IF( ln_zdfosm  )   CALL dyn_osm( kstp,      Nnn      , uu, vv, Nrhs )  ! OSMOSIS non-local velocity fluxes ==> RHS 
     256                            CALL dyn_hpg( kstp,      Nnn      , uu, vv, Nrhs )  ! horizontal gradient of Hydrostatic pressure 
     257      END DO 
     258      IF( ln_tile ) CALL dom_tile_stop 
     259 
     260                            CALL dyn_spg( kstp, Nbb, Nnn, Nrhs, uu, vv, ssh, uu_b, vv_b, Naa )  ! surface pressure gradient 
     261 
     262      IF( ln_tile ) CALL dom_tile_start         ! [tiling] DYN tiling loop (2) 
     263      DO jtile = 1, nijtile 
     264         IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile ) 
     265 
     266         IF( ln_dynspg_ts ) THEN      ! With split-explicit free surface, since now transports have been updated and ssh(:,:,Nrhs) 
     267                                      ! as well as vertical scale factors and vertical velocity need to be updated 
     268                            CALL div_hor    ( kstp, Nbb, Nnn )                  ! Horizontal divergence  (2nd call in time-split case) 
     269            IF(.NOT.lk_linssh) CALL dom_qco_r3c( ssh(:,:,Naa), r3t(:,:,Naa), r3u(:,:,Naa), r3v(:,:,Naa), r3f(:,:) )   ! update ssh/h_0 ratio at t,u,v,f pts 
     270         ENDIF 
    249271                            CALL dyn_zdf    ( kstp, Nbb, Nnn, Nrhs, uu, vv, Naa  )  ! vertical diffusion 
     272      END DO 
     273      IF( ln_tile ) CALL dom_tile_stop 
     274 
    250275      IF( ln_dynspg_ts ) THEN                                                       ! vertical scale factors and vertical velocity need to be updated 
    251276                            CALL wzv        ( kstp, Nbb, Nnn, Naa, ww )             ! Nnn cross-level velocity 
    … …  
    288313      ! Active tracers 
    289314      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    290       ! Loop over tile domains 
     315                         ts(:,:,:,:,Nrhs) = 0._wp         ! set tracer trends to zero 
     316 
     317      IF( ln_tile ) CALL dom_tile_start         ! [tiling] TRA tiling loop (1) 
    291318      DO jtile = 1, nijtile 
    292          IF( ln_tile    )   CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile ) 
    293  
    294          DO_3D( 0, 0, 0, 0, 1, jpk ) 
    295             ts(ji,jj,jk,:,Nrhs) = 0._wp                                   ! set tracer trends to zero 
    296          END_3D 
     319         IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile ) 
    297320 
    298321         IF(  lk_asminc .AND. ln_asmiau .AND. & 
    … …  
    306329         IF( ln_bdy     )   CALL bdy_tra_dmp( kstp, Nbb,      ts, Nrhs )  ! bdy damping trends 
    307330      END DO 
     331      IF( ln_tile ) CALL dom_tile_stop 
    308332 
    309333#if defined key_agrif 
    310334      IF(.NOT. Agrif_Root() ) THEN 
    311          IF( ln_tile    )   CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) 
    312335                            CALL Agrif_Sponge_tra        ! tracers sponge 
    313336      ENDIF 
    … …  
    315338 
    316339      ! TEMP: [tiling] Separate loop over tile domains (due to tra_adv workarounds for tiling) 
     340      IF( ln_tile ) CALL dom_tile_start         ! [tiling] TRA tiling loop (2) 
    317341      DO jtile = 1, nijtile 
    318          IF( ln_tile    )  CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile ) 
     342         IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile ) 
    319343 
    320344                            CALL tra_adv    ( kstp, Nbb, Nnn, ts, Nrhs )  ! hor. + vert. advection ==> RHS 
    … …  
    329353         IF( ln_zdfnpc  )   CALL tra_npc    ( kstp,      Nnn, Nrhs, ts, Naa  )  ! update after fields by non-penetrative convection 
    330354      END DO 
    331  
    332       IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) ! Revert to tile over full domain 
     355      IF( ln_tile ) CALL dom_tile_stop 
     356 
    333357      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    334358      ! Set boundary conditions, time filter and swap time levels 
    … …  
    516540                       &          , pts(:,:,:,jp_tem,Kaa), 'T',  1., pts(:,:,:,jp_sal,Kaa), 'T',  1. ) 
    517541      ! 
     542      ! lbc_lnk needed for zdf_sh2 when using nn_hls = 2, moved here to allow tiling in zdf_phy 
     543      IF( nn_hls == 2 .AND. l_zdfsh2 ) CALL lbc_lnk( 'stp', avm_k, 'W', 1.0_wp ) 
     544 
     545      ! dom_qco_r3c defines over [nn_hls, nn_hls-1, nn_hls, nn_hls-1] 
     546      IF( nn_hls == 2 .AND. .NOT. lk_linssh ) THEN 
     547         CALL lbc_lnk( 'finalize_lbc', r3u(:,:,Kaa), 'U', 1._wp, r3v(:,:,Kaa), 'V', 1._wp, & 
     548            &                          r3u_f(:,:),   'U', 1._wp, r3v_f(:,:),   'V', 1._wp ) 
     549      ENDIF 
    518550      !                                        !* BDY open boundaries 
    519551      IF( ln_bdy )   THEN 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/timing.F90

    r14789 r14852  
    109109 
    110110      s_timer%l_tdone = .FALSE. 
    111       IF( ntile == 0 .OR. ntile == 1 ) s_timer%niter = s_timer%niter + 1      ! All tiles count as one iteration 
     111      IF( .NOT. l_istiled .OR. ntile == 1 ) s_timer%niter = s_timer%niter + 1      ! All tiles count as one iteration 
    112112      s_timer%t_cpu = 0. 
    113113      s_timer%t_clock = 0. 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OFF/nemogcm.F90

    r14789 r14852  
    323323      CALL mpp_init 
    324324 
     325#if defined key_loop_fusion 
     326      IF( nn_hls == 1 ) THEN 
     327         CALL ctl_stop( 'STOP', 'nemogcm : Loop fusion can be used only with extra-halo' ) 
     328      ENDIF 
     329#endif 
     330 
    325331      CALL halo_mng_init() 
    326332      ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/SAS/nemogcm.F90

    r14789 r14852  
    352352      CALL mpp_init 
    353353 
     354#if defined key_loop_fusion 
     355      IF( nn_hls == 1 ) THEN 
     356         CALL ctl_stop( 'STOP', 'nemogcm : Loop fusion can be used only with extra-halo' ) 
     357      ENDIF 
     358#endif 
     359 
    354360      CALL halo_mng_init() 
    355361      ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/SWE/nemogcm.F90

    r14789 r14852  
    273273      CALL mpp_init 
    274274 
     275#if defined key_loop_fusion 
     276      IF( nn_hls == 1 ) THEN 
     277         CALL ctl_stop( 'STOP', 'nemogcm : Loop fusion can be used only with extra-halo' ) 
     278      ENDIF 
     279#endif 
     280 
    275281      CALL halo_mng_init() 
    276282      ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/SWE/stprk3.F90

    r14789 r14852  
    172172      ! 
    173173      CALL lbc_lnk( 'stp_RK3', uu(:,:,:,Naa), 'U', -1., vv(:,:,:,Naa), 'V', -1. ) 
     174      IF (nn_hls==2) CALL lbc_lnk( 'stp_MLF', r3u(:,:,Naa), 'U', 1., r3v(:,:,Naa), 'U', 1.) 
    174175      ! 
    175176      !                                 !==  Swap time levels  ==! 
    … …  
    237238      ! 
    238239      CALL lbc_lnk( 'stp_RK3', uu(:,:,:,Naa), 'U', -1., vv(:,:,:,Naa), 'V', -1. ) 
     240      IF (nn_hls==2) CALL lbc_lnk( 'stp_MLF', r3u(:,:,Naa), 'U', 1., r3v(:,:,Naa), 'U', 1.) 
    239241      ! 
    240242      !                                 !==  Swap time levels  ==! 
    … …  
    300302      ! 
    301303      CALL lbc_lnk( 'stp_RK3', uu(:,:,:,Naa), 'U', -1., vv(:,:,:,Naa), 'V', -1. ) 
     304      IF (nn_hls==2) CALL lbc_lnk( 'stp_MLF', r3u(:,:,Naa), 'U', 1., r3v(:,:,Naa), 'U', 1.) 
    302305      ! 
    303306      !                                 !==  Swap time levels  ==! 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/TOP/AGE/trcnam_age.F90

    r12377 r14852  
    5353      ln_trc_cbc(jp_age) = .false. 
    5454      ln_trc_obc(jp_age) = .false. 
     55      ln_trc_ais(jp_age) = .false. 
    5556      ! 
    5657      READ  ( numnat_ref, namage, IOSTAT = ios, ERR = 901) 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/TOP/TRP/trcadv.F90

    r14789 r14852  
    2323   USE traadv_cen     ! centered scheme           (tra_adv_cen  routine) 
    2424   USE traadv_fct     ! FCT      scheme           (tra_adv_fct  routine) 
    25    USE traadv_fct_lf  ! FCT      scheme           (tra_adv_fct  routine - loop fusion version) 
    2625   USE traadv_mus     ! MUSCL    scheme           (tra_adv_mus  routine) 
    27    USE traadv_mus_lf  ! MUSCL    scheme           (tra_adv_mus  routine - loop fusion version) 
    2826   USE traadv_ubs     ! UBS      scheme           (tra_adv_ubs  routine) 
    2927   USE traadv_qck     ! QUICKEST scheme           (tra_adv_qck  routine) 
    … …  
    127125      ! 
    128126      CASE ( np_CEN )                                 ! Centered : 2nd / 4th order 
    129          IF (nn_hls.EQ.2) CALL lbc_lnk( 'trcadv', ptr(:,:,:,:,Kmm), 'T', 1.) 
    130127         CALL tra_adv_cen( kt, nittrc000,'TRC',          zuu, zvv, zww,      Kmm, ptr, jptra, Krhs, nn_cen_h, nn_cen_v ) 
    131128      CASE ( np_FCT )                                 ! FCT      : 2nd / 4th order 
    132          IF (nn_hls.EQ.2) THEN 
    133             CALL lbc_lnk( 'trcadv', ptr(:,:,:,:,Kbb), 'T', 1., ptr(:,:,:,:,Kmm), 'T', 1.) 
    134             CALL lbc_lnk( 'traadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1., zww(:,:,:), 'W', 1.) 
    135 #if defined key_loop_fusion 
    136             CALL tra_adv_fct_lf( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_fct_h, nn_fct_v ) 
    137 #else 
    138129            CALL tra_adv_fct( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_fct_h, nn_fct_v ) 
    139 #endif 
    140          ELSE 
    141             CALL tra_adv_fct( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_fct_h, nn_fct_v ) 
    142          END IF 
    143130      CASE ( np_MUS )                                 ! MUSCL 
    144          IF (nn_hls.EQ.2) THEN 
    145             CALL lbc_lnk( 'trcadv', ptr(:,:,:,:,Kbb), 'T', 1.) 
    146 #if defined key_loop_fusion 
    147             CALL tra_adv_mus_lf( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, ln_mus_ups )  
    148 #else 
    149             CALL tra_adv_mus( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, ln_mus_ups )  
    150 #endif 
    151          ELSE 
    152             CALL tra_adv_mus( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, ln_mus_ups )  
    153          END IF 
     131            CALL tra_adv_mus( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, ln_mus_ups ) 
    154132      CASE ( np_UBS )                                 ! UBS 
    155          IF (nn_hls.EQ.2) CALL lbc_lnk( 'trcadv', ptr(:,:,:,:,Kbb), 'T', 1.) 
    156133         CALL tra_adv_ubs( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_ubs_v           ) 
    157134      CASE ( np_QCK )                                 ! QUICKEST 
    158          IF (nn_hls.EQ.2) THEN 
    159             CALL lbc_lnk( 'trcadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1.) 
    160             CALL lbc_lnk( 'traadv', ptr(:,:,:,:,Kbb), 'T', 1.) 
    161          END IF 
    162135         CALL tra_adv_qck( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs                     ) 
    163136      ! 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/TOP/TRP/trcldf.F90

    r14789 r14852  
    8383      zahv(:,:,:) = rldf * ahtv(:,:,:) 
    8484      !                                  !* Enhanced zonal diffusivity coefficent in the equatorial domain 
    85       DO_3D( 1, 1, 1, 1, 1, jpk ) 
     85      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 
    8686         IF( gdept(ji,jj,jk,Kmm) > 200. .AND. gphit(ji,jj) < 5. .AND. gphit(ji,jj) > -5. ) THEN 
    8787            zdep = MAX( gdept(ji,jj,jk,Kmm) - 1000., 0. ) / 1000. 
    … …  
    102102           &                     ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, 1 ) 
    103103      CASE ( np_blp , np_blp_i , np_blp_it )                                                               ! bilaplacian: all operator (iso-level, -neutral) 
    104          IF(nn_hls.EQ.2) CALL lbc_lnk( 'trc_ldf', ptr(:,:,:,:,Kbb), 'T',1.) 
    105104         CALL tra_ldf_blp  ( kt, Kmm, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi,            & 
    106105           &                     ptr(:,:,:,:,Kbb) , ptr(:,:,:,:,Krhs),                 jptra, nldf_trc ) 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/TOP/trcdta.F90

    r14789 r14852  
    195195               WRITE(numout,*) 'trc_dta: interpolates passive tracer data onto the s- or mixed s-z-coordinate mesh' 
    196196            ENDIF 
    197             DO_2D( 1, 1, 1, 1 )                 ! vertical interpolation of T & S 
     197            DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )                 ! vertical interpolation of T & S 
    198198               DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points 
    199199                  zl = gdept_0(ji,jj,jk) 
    … …  
    220220            ! zps-coordinate (partial steps) interpolation at the last ocean level 
    221221            IF( ln_zps ) THEN 
    222                 DO_2D( 1, 1, 1, 1 ) 
     222                DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )  
    223223                   ik = mbkt(ji,jj) 
    224224                   IF( ik > 1 ) THEN 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/tests/CANAL/EXPREF/namelist_cfg

    r14770 r14852  
    7676      cn_domcfg_out = "domain_cfg" ! newly created domain configuration filename 
    7777/ 
     78!----------------------------------------------------------------------- 
     79&namtile        !   parameters of the tiling 
     80!----------------------------------------------------------------------- 
     81/ 
    7882!!====================================================================== 
    7983!!            ***  Surface Boundary Condition namelists  ***          !! 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/tests/CPL_OASIS/EXPREF/namelist_cfg

    r14770 r14852  
    3838      ln_closea    = .false.    !  F => suppress closed seas (defined by closea_mask field)  
    3939      !                         !       from the bathymetry at runtime. 
     40/ 
     41!----------------------------------------------------------------------- 
     42&namtile        !   parameters of the tiling 
     43!----------------------------------------------------------------------- 
    4044/ 
    4145!----------------------------------------------------------------------- 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/tests/DOME/EXPREF/1_namelist_cfg

    r14254 r14852  
    4242      cn_domcfg = "DOME_domcfg"  ! domain configuration filename 
    4343      ! 
     44/ 
     45!----------------------------------------------------------------------- 
     46&namtile        !   parameters of the tiling 
     47!----------------------------------------------------------------------- 
    4448/ 
    4549!----------------------------------------------------------------------- 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/tests/DOME/EXPREF/namelist_cfg

    r14254 r14852  
    3030      cn_domcfg = "DOME_domcfg"  ! domain configuration filename 
    3131      ! 
     32/ 
     33!----------------------------------------------------------------------- 
     34&namtile        !   parameters of the tiling 
     35!----------------------------------------------------------------------- 
    3236/ 
    3337!----------------------------------------------------------------------- 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/tests/DONUT/EXPREF/namelist_cfg

    r14226 r14852  
    2727      !                    !  (=F) user defined configuration           (F => create/check namusr_def) 
    2828      cn_domcfg = "donut_cfg"  ! domain configuration filename 
     29/ 
     30!----------------------------------------------------------------------- 
     31&namtile        !   parameters of the tiling 
     32!----------------------------------------------------------------------- 
    2933/ 
    3034!----------------------------------------------------------------------- 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/tests/ICB/EXPREF/namelist_cfg

    r14229 r14852  
    4848!----------------------------------------------------------------------- 
    4949&namcfg        !   parameters of the configuration                      (default: use namusr_def in namelist_cfg) 
     50!----------------------------------------------------------------------- 
     51/ 
     52!----------------------------------------------------------------------- 
     53&namtile        !   parameters of the tiling 
    5054!----------------------------------------------------------------------- 
    5155/ 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/tests/ICE_ADV1D/EXPREF/namelist_cfg

    r14770 r14852  
    4949      !                     !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules 
    5050      cn_domcfg = "ICE_ADV1D_domcfg"    ! domain configuration filename 
     51/ 
     52!----------------------------------------------------------------------- 
     53&namtile        !   parameters of the tiling 
     54!----------------------------------------------------------------------- 
    5155/ 
    5256!!====================================================================== 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/tests/ICE_ADV2D/EXPREF/namelist_cfg

    r14770 r14852  
    4949      !                     !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules 
    5050      cn_domcfg = "ICE_ADV2D_domcfg"    ! domain configuration filename 
     51/ 
     52!----------------------------------------------------------------------- 
     53&namtile        !   parameters of the tiling 
     54!----------------------------------------------------------------------- 
    5155/ 
    5256!!====================================================================== 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/tests/ICE_AGRIF/EXPREF/1_namelist_cfg

    r14770 r14852  
    4949      !                     !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules 
    5050      cn_domcfg = "ICE_AGRIF_domcfg"    ! domain configuration filename 
     51/ 
     52!----------------------------------------------------------------------- 
     53&namtile        !   parameters of the tiling 
     54!----------------------------------------------------------------------- 
    5155/ 
    5256!!====================================================================== 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/tests/ICE_AGRIF/EXPREF/namelist_cfg

    r14770 r14852  
    4949      !                     !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules 
    5050      cn_domcfg = "ICE_AGRIF_domcfg"    ! domain configuration filename 
     51/ 
     52!----------------------------------------------------------------------- 
     53&namtile        !   parameters of the tiling 
     54!----------------------------------------------------------------------- 
    5155/ 
    5256!!====================================================================== 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/tests/ICE_RHEO/EXPREF/namelist_cfg

    r14229 r14852  
    4848   ln_read_cfg = .false.    !  (=T) read the domain configuration file 
    4949      !                     !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules 
     50/ 
     51!----------------------------------------------------------------------- 
     52&namtile        !   parameters of the tiling 
     53!----------------------------------------------------------------------- 
    5054/ 
    5155!!====================================================================== 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/tests/ISOMIP+/EXPREF/namelist_cfg

    r14770 r14852  
    5050!----------------------------------------------------------------------- 
    5151   ln_read_cfg = .true.   !  (=T) read the domain configuration file 
     52/ 
     53!----------------------------------------------------------------------- 
     54&namtile        !   parameters of the tiling 
     55!----------------------------------------------------------------------- 
    5256/ 
    5357!----------------------------------------------------------------------- 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/tests/ISOMIP/EXPREF/namelist_cfg

    r14770 r14852  
    4848!----------------------------------------------------------------------- 
    4949&namcfg        !   parameters of the configuration                      (default: use namusr_def in namelist_cfg) 
     50!----------------------------------------------------------------------- 
     51/ 
     52!----------------------------------------------------------------------- 
     53&namtile        !   parameters of the tiling 
    5054!----------------------------------------------------------------------- 
    5155/ 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT2_flux_ubs_cfg

    r14770 r14852  
    4141      !                    !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules 
    4242   ln_write_cfg = .false.   !  (=T) create the domain configuration file 
     43/ 
     44!----------------------------------------------------------------------- 
     45&namtile        !   parameters of the tiling 
     46!----------------------------------------------------------------------- 
    4347/ 
    4448!----------------------------------------------------------------------- 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/tests/OVERFLOW/EXPREF/AGRIF/1_namelist_cfg

    r14568 r14852  
    3838      cn_domcfg = "OVF_domcfg"  ! domain configuration filename 
    3939      ! 
     40/ 
     41!----------------------------------------------------------------------- 
     42&namtile        !   parameters of the tiling 
     43!----------------------------------------------------------------------- 
    4044/ 
    4145!----------------------------------------------------------------------- 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/tests/OVERFLOW/EXPREF/AGRIF/namelist_cfg

    r14568 r14852  
    3232      cn_domcfg = "OVF_domcfg"  ! domain configuration filename 
    3333      ! 
     34/ 
     35!----------------------------------------------------------------------- 
     36&namtile        !   parameters of the tiling 
     37!----------------------------------------------------------------------- 
    3438/ 
    3539!----------------------------------------------------------------------- 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/tests/OVERFLOW/EXPREF/namelist_zps_FCT4_flux_ubs_cfg

    r14770 r14852  
    4141!----------------------------------------------------------------------- 
    4242&namcfg        !   parameters of the configuration 
     43!----------------------------------------------------------------------- 
     44/ 
     45!----------------------------------------------------------------------- 
     46&namtile        !   parameters of the tiling 
    4347!----------------------------------------------------------------------- 
    4448/ 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/tests/SWG/EXPREF/namelist_cfg

    r14229 r14852  
    3232!----------------------------------------------------------------------- 
    3333   ln_read_cfg = .false.   !  (=F) user defined configuration           (F => create/check namusr_def) 
     34/ 
     35!----------------------------------------------------------------------- 
     36&namtile        !   parameters of the tiling 
     37!----------------------------------------------------------------------- 
    3438/ 
    3539!----------------------------------------------------------------------- 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/tests/TSUNAMI/EXPREF/namelist_cfg

    r14433 r14852  
    3131   ln_Iperio  =   .true.   ! i-periodicity 
    3232   ln_Jperio  =   .true.   ! j-periodicity 
     33/ 
     34!----------------------------------------------------------------------- 
     35&namtile        !   parameters of the tiling 
     36!----------------------------------------------------------------------- 
    3337/ 
    3438!----------------------------------------------------------------------- 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/tests/VORTEX/EXPREF/1_namelist_cfg

    r14770 r14852  
    4545!----------------------------------------------------------------------- 
    4646&namcfg        !   parameters of the configuration                      (default: user defined GYRE) 
     47!----------------------------------------------------------------------- 
     48/ 
     49!----------------------------------------------------------------------- 
     50&namtile        !   parameters of the tiling 
    4751!----------------------------------------------------------------------- 
    4852/ 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/tests/VORTEX/EXPREF/namelist_cfg

    r14770 r14852  
    4545!----------------------------------------------------------------------- 
    4646&namcfg        !   parameters of the configuration                      (default: use namusr_def in namelist_cfg) 
     47!----------------------------------------------------------------------- 
     48/ 
     49!----------------------------------------------------------------------- 
     50&namtile        !   parameters of the tiling 
    4751!----------------------------------------------------------------------- 
    4852/ 

  • NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/tests/WAD/EXPREF/namelist_cfg

    r14770 r14852  
    5151      !                    !  (=F) user defined configuration  ==>>>  see usrdef(_...) modules 
    5252   ln_write_cfg = .true.    !  (=T) create the domain configuration file 
     53/ 
     54!----------------------------------------------------------------------- 
     55&namtile        !   parameters of the tiling 
     56!----------------------------------------------------------------------- 
    5357/ 
    5458!----------------------------------------------------------------------- 
Note: See TracChangeset for help on using the changeset viewer.