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.
Diff from NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE@14776 to NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE@14805 – NEMO

Ignore:
Location:
NEMO/branches/2021
Files:
5 added
2 deleted
75 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/ASM/asminc.F90

    r14776 r14805  
    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_r14273_HPC-02_Daley_Tiling/src/OCE/BDY/bdydyn3d.F90

    r14776 r14805  
    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_r14273_HPC-02_Daley_Tiling/src/OCE/BDY/bdytra.F90

    r14776 r14805  
    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_r14273_HPC-02_Daley_Tiling/src/OCE/DIA/diaar5.F90

    r14776 r14805  
    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_r14273_HPC-02_Daley_Tiling/src/OCE/DIA/diaptr.F90

    r14776 r14805  
    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_r14273_HPC-02_Daley_Tiling/src/OCE/DOM/dom_oce.F90

    r14776 r14805  
    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_r14273_HPC-02_Daley_Tiling/src/OCE/DOM/domain.F90

    r14776 r14805  
    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_r14273_HPC-02_Daley_Tiling/src/OCE/DOM/domqco.F90

    r14776 r14805  
    9696#endif 
    9797      ! 
    98       IF(nn_hls==2.AND..NOT.lk_linssh) CALL lbc_lnk( 'stp_MLF', r3u(:,:,Kbb), 'U', 1.0_wp, r3v(:,:,Kbb), 'V', 1.0_wp, r3t(:,:,Kbb), 'T', 1.0_wp, & 
    99                                                  &                r3u(:,:,Kmm), 'U', 1.0_wp, r3v(:,:,Kmm), 'V', 1.0_wp, r3t(:,:,Kmm), 'T', 1.0_wp, r3f(:,:), 'F', 1.0_wp ) 
    10098   END SUBROUTINE dom_qco_init 
    10199 
    … …  
    125123      CALL dom_qco_r3c( ssh(:,:,Kmm), r3t(:,:,Kmm), r3u(:,:,Kmm), r3v(:,:,Kmm), r3f(:,:) ) 
    126124#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 ) 
    127128      ! 
    128129   END SUBROUTINE dom_qco_zgr 
    … …  
    148149      ! 
    149150      ! 
    150       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 
    151154      ! 
    152155      ! 
    … …  
    156159#if ! defined key_qcoTest_FluxForm 
    157160      !                                ! no 'key_qcoTest_FluxForm' : surface weighted ssh average 
    158          DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    159             pr3u(ji,jj) = 0.5_wp * (  e1e2t(ji  ,jj) * pssh(ji  ,jj)  & 
    160                &                    + e1e2t(ji+1,jj) * pssh(ji+1,jj)  ) * r1_hu_0(ji,jj) * r1_e1e2u(ji,jj) 
    161             pr3v(ji,jj) = 0.5_wp * (  e1e2t(ji,jj  ) * pssh(ji,jj  )  & 
    162                &                    + e1e2t(ji,jj+1) * pssh(ji,jj+1)  ) * r1_hv_0(ji,jj) * r1_e1e2v(ji,jj) 
    163          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 
    164167!!st      ELSE                                         !- Flux Form   (simple averaging) 
    165168#else 
    166          DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    167             pr3u(ji,jj) = 0.5_wp * (  pssh(ji,jj) + pssh(ji+1,jj  )  ) * r1_hu_0(ji,jj) 
    168             pr3v(ji,jj) = 0.5_wp * (  pssh(ji,jj) + pssh(ji  ,jj+1)  ) * r1_hv_0(ji,jj) 
    169          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 
    170173!!st      ENDIF 
    171174#endif          
    … …  
    181184         !                                ! no 'key_qcoTest_FluxForm' : surface weighted ssh average 
    182185 
    183             DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )                               ! start from 1 since lbc_lnk('F') doesn't update the 1st row/line 
    184                ! round brackets added to fix the order of floating point operations 
    185                ! needed to ensure halo 1 - halo 2 compatibility 
    186                pr3f(ji,jj) = 0.25_wp * ( ( e1e2t(ji  ,jj  ) * pssh(ji  ,jj  )   & 
    187                   &                      + e1e2t(ji+1,jj  ) * pssh(ji+1,jj  )   & 
    188                   &                      )                                      & ! bracket for halo 1 - halo 2 compatibility 
    189                   &                     + ( e1e2t(ji  ,jj+1) * pssh(ji  ,jj+1)  & 
    190                   &                       + e1e2t(ji+1,jj+1) * pssh(ji+1,jj+1)  & 
    191                   &                       )                                     & ! bracket for halo 1 - halo 2 compatibility 
    192                   &                    ) * r1_hf_0(ji,jj) * r1_e1e2f(ji,jj) 
    193             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 
    194197!!st         ELSE                                      !- Flux Form   (simple averaging) 
    195198#else 
    196             DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    197                ! round brackets added to fix the order of floating point operations 
    198                ! needed to ensure halo 1 - halo 2 compatibility 
    199                pr3f(ji,jj) = 0.25_wp * ( ( pssh(ji,jj  ) + pssh(ji+1,jj  ) ) & 
    200                   &                     + ( pssh(ji,jj+1) + pssh(ji+1,jj+1)  &  
    201                   &                       )                                  & ! bracket for halo 1 - halo 2 compatibility 
    202                   &                    ) * r1_hf_0(ji,jj) 
    203             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 
    204207!!st         ENDIF 
    205208#endif 

  • NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/DOM/domtile.F90

    r14776 r14805  
    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#if defined key_loop_fusion 
     55      IF( ln_tile ) THEN 
     56         CALL ctl_warn('Tiling is not yet implemented for key_loop_fusion; ln_tile is forced to FALSE') 
     57         ln_tile = .FALSE. 
     58         CALL dom_tile_init 
     59      ENDIF 
     60#endif 
     61 
     62      ntile = 0                     ! Initialise to full domain 
     63      nijtile = 1 
     64      ntsi = Nis0 
     65      ntsj = Njs0 
     66      ntei = Nie0 
     67      ntej = Nje0 
     68      nthl = 0 
     69      nthr = 0 
     70      nthb = 0 
     71      ntht = 0 
     72      l_istiled = .FALSE. 
     73 
     74      IF( ln_tile ) THEN            ! Calculate tile domain indices 
     75         iitile = Ni_0 / nn_ltile_i       ! Number of tiles 
     76         ijtile = Nj_0 / nn_ltile_j 
     77         IF( MOD( Ni_0, nn_ltile_i ) /= 0 ) iitile = iitile + 1 
     78         IF( MOD( Nj_0, nn_ltile_j ) /= 0 ) ijtile = ijtile + 1 
     79 
     80         nijtile = iitile * ijtile 
     81         ALLOCATE( ntsi_a(0:nijtile), ntsj_a(0:nijtile), ntei_a(0:nijtile), ntej_a(0:nijtile), l_tilefin(nijtile) ) 
     82 
     83         l_tilefin(:) = .FALSE. 
     84 
     85         ntsi_a(0) = Nis0                 ! Full domain 
     86         ntsj_a(0) = Njs0 
     87         ntei_a(0) = Nie0 
     88         ntej_a(0) = Nje0 
     89 
     90         DO jt = 1, nijtile               ! Tile domains 
     91            ntsi_a(jt) = Nis0 + nn_ltile_i * MOD(jt - 1, iitile) 
     92            ntsj_a(jt) = Njs0 + nn_ltile_j * ((jt - 1) / iitile) 
     93            ntei_a(jt) = MIN(ntsi_a(jt) + nn_ltile_i - 1, Nie0) 
     94            ntej_a(jt) = MIN(ntsj_a(jt) + nn_ltile_j - 1, Nje0) 
     95         ENDDO 
     96      ENDIF 
     97 
     98      IF(lwp) THEN                  ! control print 
     99         WRITE(numout,*) 
     100         WRITE(numout,*) 'dom_tile : Domain tiling decomposition' 
     101         WRITE(numout,*) '~~~~~~~~' 
     102         IF( ln_tile ) THEN 
     103            WRITE(numout,*) iitile, 'tiles in i' 
     104            WRITE(numout,*) '    Starting indices' 
     105            WRITE(numout,*) '        ', (ntsi_a(jt), jt=1, iitile) 
     106            WRITE(numout,*) '    Ending indices' 
     107            WRITE(numout,*) '        ', (ntei_a(jt), jt=1, iitile) 
     108            WRITE(numout,*) ijtile, 'tiles in j' 
     109            WRITE(numout,*) '    Starting indices' 
     110            WRITE(numout,*) '        ', (ntsj_a(jt), jt=1, nijtile, iitile) 
     111            WRITE(numout,*) '    Ending indices' 
     112            WRITE(numout,*) '        ', (ntej_a(jt), jt=1, nijtile, iitile) 
     113         ELSE 
     114            WRITE(numout,*) 'No domain tiling' 
     115            WRITE(numout,*) '    i indices =', ntsi, ':', ntei 
     116            WRITE(numout,*) '    j indices =', ntsj, ':', ntej 
     117         ENDIF 
     118      ENDIF 
     119   END SUBROUTINE dom_tile_init 
     120 
     121 
     122   SUBROUTINE dom_tile( ktsi, ktsj, ktei, ktej, ktile, ldhold, cstr ) 
    30123      !!---------------------------------------------------------------------- 
    31124      !!                     ***  ROUTINE dom_tile  *** 
    32125      !! 
    33       !! ** Purpose :   Set tile domain variables 
     126      !! ** Purpose :   Set the current tile and its domain indices 
    34127      !! 
    35128      !! ** Action  : - ktsi, ktsj     : start of internal part of domain 
    36129      !!              - ktei, ktej     : end of internal part of domain 
    37       !!              - ntile          : current tile number 
    38       !!              - nijtile        : total number of tiles 
     130      !!              - nthl, nthr     : modifier on DO loop macro bound offset (left, right) 
     131      !!              - nthb, ntht     :              "         "               (bottom, top) 
     132      !!              - ktile          : set the current tile number (ntile) 
    39133      !!---------------------------------------------------------------------- 
    40134      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  
     135      INTEGER, INTENT(in)  :: ktile                       ! Tile number 
     136      LOGICAL, INTENT(in), OPTIONAL :: ldhold             ! Pause/resume (.true.) or set (.false.) current tile 
     137      CHARACTER(len=*), INTENT(in), OPTIONAL   :: cstr    ! Debug information (added to warnings) 
     138      CHARACTER(len=23) :: clstr 
     139      LOGICAL :: llhold 
     140      CHARACTER(len=11)   :: charout 
     141      INTEGER :: iitile 
     142      !!---------------------------------------------------------------------- 
     143      llhold = .FALSE. 
     144      IF( PRESENT(ldhold) ) llhold = ldhold 
     145      clstr = '' 
     146      IF( PRESENT(cstr) ) clstr = TRIM(' ('//TRIM(cstr)//')') 
     147 
     148      IF( .NOT. ln_tile ) CALL ctl_stop('Cannot use dom_tile with ln_tile = .false.') 
     149      IF( .NOT. llhold ) THEN 
     150         IF( .NOT. l_istiled ) THEN 
     151            CALL ctl_warn('Cannot call dom_tile when tiling is inactive'//clstr) 
     152            RETURN 
     153         ENDIF 
     154 
     155         IF( ntile /= 0 ) l_tilefin(ntile) = .TRUE.         ! If setting a new tile, the current tile is complete 
     156 
     157         ntile = ktile                                      ! Set the new tile 
    53158         IF(sn_cfctl%l_prtctl) THEN 
    54             WRITE(charout, FMT="('ntile =', I4)") ktile 
     159            WRITE(charout, FMT="('ntile =', I4)") ntile 
    55160            CALL prt_ctl_info( charout ) 
    56161         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 
     162      ENDIF 
     163 
     164      ktsi = ntsi_a(ktile)                                  ! Set the domain indices 
     165      ktsj = ntsj_a(ktile) 
     166      ktei = ntei_a(ktile) 
     167      ktej = ntej_a(ktile) 
     168 
     169      ! Calculate the modifying factor on DO loop bounds (1 = do not work on points that have already been processed by a neighbouring tile) 
     170      nthl = 0 ; nthr = 0 ; nthb = 0 ; ntht = 0 
     171      iitile = Ni_0 / nn_ltile_i 
     172      IF( MOD( Ni_0, nn_ltile_i ) /= 0 ) iitile = iitile + 1 
     173      IF( ktsi > Nis0 ) THEN ; IF( l_tilefin(ktile - 1     ) ) nthl = 1 ; ENDIF    ! Left adjacent tile 
     174      IF( ktei < Nie0 ) THEN ; IF( l_tilefin(ktile + 1     ) ) nthr = 1 ; ENDIF    ! Right  "  " 
     175      IF( ktsj > Njs0 ) THEN ; IF( l_tilefin(ktile - iitile) ) nthb = 1 ; ENDIF    ! Bottom "  " 
     176      IF( ktej < Nje0 ) THEN ; IF( l_tilefin(ktile + iitile) ) ntht = 1 ; ENDIF    ! Top    "  " 
    109177   END SUBROUTINE dom_tile 
    110178 
     179 
     180   SUBROUTINE dom_tile_start( ldhold, cstr ) 
     181      !!---------------------------------------------------------------------- 
     182      !!                     ***  ROUTINE dom_tile_start  *** 
     183      !! 
     184      !! ** Purpose : Start or resume the use of tiling 
     185      !! 
     186      !! ** Method  : dom_tile_start & dom_tile_stop are used to declare a tiled region of code. 
     187      !! 
     188      !!              Tiling is active/inactive (l_istiled = .true./.false.) within/outside of this code region. 
     189      !!              After enabling tiling, no tile will initially be set (the full domain will be used) and dom_tile must 
     190      !!              be called to set a specific tile to work on. Furthermore, all tiles will be marked as incomplete 
     191      !!              (ln_tilefin(:) = .false.). 
     192      !! 
     193      !!              Tiling can be paused/resumed within the tiled code region by calling dom_tile_stop/dom_tile_start 
     194      !!              with ldhold = .true.. This can be used to temporarily revert back to using the full domain. 
     195      !! 
     196      !!                 CALL dom_tile_start                                  ! Enable tiling 
     197      !!                    CALL dom_tile(ntsi, ntei, ntsj, ntej, ktile=n)    ! Set current tile "n" 
     198      !!                    ... 
     199      !!                    CALL dom_tile_stop(.TRUE.)                        ! Pause tiling (temporarily disable) 
     200      !!                    ... 
     201      !!                    CALL dom_tile_start(.TRUE.)                       ! Resume tiling 
     202      !!                 CALL dom_tile_stop                                   ! Disable tiling 
     203      !!---------------------------------------------------------------------- 
     204      LOGICAL, INTENT(in), OPTIONAL :: ldhold            ! Resume (.true.) or start (.false.) 
     205      LOGICAL :: llhold 
     206      CHARACTER(len=*), INTENT(in), OPTIONAL   :: cstr   ! Debug information (added to warnings) 
     207      CHARACTER(len=23) :: clstr 
     208      !!---------------------------------------------------------------------- 
     209      llhold = .FALSE. 
     210      IF( PRESENT(ldhold) ) llhold = ldhold 
     211      clstr = '' 
     212      IF( PRESENT(cstr) ) clstr = TRIM(' ('//TRIM(cstr)//')') 
     213 
     214      IF( .NOT. ln_tile ) CALL ctl_stop('Cannot resume/start tiling as ln_tile = .false.') 
     215      IF( l_istiled ) THEN 
     216         CALL ctl_warn('Cannot resume/start tiling as it is already active'//clstr) 
     217         RETURN 
     218      ! TODO: [tiling] this warning will always be raised outside a tiling loop (cannot check for pause rather than stop) 
     219      ELSE IF( llhold .AND. ntile == 0 ) THEN 
     220         CALL ctl_warn('Cannot resume tiling as it is not paused'//clstr) 
     221         RETURN 
     222      ENDIF 
     223 
     224      ! Whether resumed or started, the tiling is made active. If resumed, the domain indices for the current tile are used. 
     225      IF( llhold ) CALL dom_tile(ntsi, ntsj, ntei, ntej, ktile=ntile, ldhold=.TRUE., cstr='dom_tile_start'//clstr) 
     226      l_istiled = .TRUE. 
     227   END SUBROUTINE dom_tile_start 
     228 
     229 
     230   SUBROUTINE dom_tile_stop( ldhold, cstr ) 
     231      !!---------------------------------------------------------------------- 
     232      !!                     ***  ROUTINE dom_tile_stop  *** 
     233      !! 
     234      !! ** Purpose : End or pause the use of tiling 
     235      !! 
     236      !! ** Method  : See dom_tile_start 
     237      !!---------------------------------------------------------------------- 
     238      LOGICAL, INTENT(in), OPTIONAL :: ldhold            ! Pause (.true.) or stop (.false.) 
     239      LOGICAL :: llhold 
     240      CHARACTER(len=*), INTENT(in), OPTIONAL   :: cstr   ! Debug information (added to warnings) 
     241      CHARACTER(len=23) :: clstr 
     242      !!---------------------------------------------------------------------- 
     243      llhold = .FALSE. 
     244      IF( PRESENT(ldhold) ) llhold = ldhold 
     245      clstr = '' 
     246      IF( PRESENT(cstr) ) clstr = TRIM(' ('//TRIM(cstr)//')') 
     247 
     248      IF( .NOT. ln_tile ) CALL ctl_stop('Cannot pause/stop tiling as ln_tile = .false.') 
     249      IF( .NOT. l_istiled ) THEN 
     250         CALL ctl_warn('Cannot pause/stop tiling as it is inactive'//clstr) 
     251         RETURN 
     252      ENDIF 
     253 
     254      ! Whether paused or stopped, the tiling is made inactive and the full domain indices are used. 
     255      ! If stopped, there is no active tile (ntile = 0) and the finished tile indicators are reset 
     256      CALL dom_tile(ntsi, ntsj, ntei, ntej, ktile=0, ldhold=llhold, cstr='dom_tile_stop'//clstr) 
     257      IF( .NOT. llhold ) l_tilefin(:) = .FALSE. 
     258      l_istiled = .FALSE. 
     259   END SUBROUTINE dom_tile_stop 
    111260   !!====================================================================== 
    112261END MODULE domtile 

  • NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/DOM/domutl.F90

    r14776 r14805  
    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_r14273_HPC-02_Daley_Tiling/src/OCE/DOM/domvvl.F90

    r14776 r14805  
    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_r14273_HPC-02_Daley_Tiling/src/OCE/DOM/dtatsd.F90

    r14776 r14805  
    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_r14273_HPC-02_Daley_Tiling/src/OCE/DYN/divhor.F90

    r14776 r14805  
    6969      ! 
    7070      IF( kt == nit000 ) THEN 
    71          IF(lwp) WRITE(numout,*) 
    72          IF(lwp) WRITE(numout,*) 'div_hor : horizontal velocity divergence ' 
    73          IF(lwp) WRITE(numout,*) '~~~~~~~   ' 
    74          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 
    7579      ENDIF 
    7680      ! 
    77       DO_3D( nn_hls-1, nn_hls, nn_hls-1, nn_hls, 1, jpkm1 )                                    !==  Horizontal divergence  ==! 
     81      DO_3D_OVR( nn_hls-1, nn_hls, nn_hls-1, nn_hls, 1, jpkm1 )                                    !==  Horizontal divergence  ==! 
    7882         ! round brackets added to fix the order of floating point operations 
    7983         ! needed to ensure halo 1 - halo 2 compatibility 
    … …  
    9397      !  
    9498#endif 
    95       ! WED025 + isomip true  
    9699      IF( ln_isf )                      CALL isf_hdiv( kt, Kmm, hdiv )           !==  ice shelf         ==!   (update hdiv field) 
    97100      ! 

  • NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/DYN/dynadv_cen2.F90

    r14776 r14805  
    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_r14273_HPC-02_Daley_Tiling/src/OCE/DYN/dynadv_ubs.F90

    r14776 r14805  
    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( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )                       ! laplacia 
     114         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )                       ! laplacian 
    111115            ! round brackets added to fix the order of floating point operations 
    112116            ! needed to ensure halo 1 - halo 2 compatibility 
    … …  
    116120               &                   )                                                 & ! bracket for halo 1 - halo 2 compatibility 
    117121               &                 ) * umask(ji  ,jj  ,jk) 
    118             zlv_vv(ji,jj,jk,1) = ( ( pvv (ji  ,jj+1,jk,Kbb) - pvv (ji  ,jj  ,jk,Kbb) &  
     122            zlv_vv(ji,jj,jk,1) = ( ( pvv (ji  ,jj+1,jk,Kbb) - pvv (ji  ,jj  ,jk,Kbb) & 
    119123               &                   )                                                 & ! bracket for halo 1 - halo 2 compatibility 
    120124               &                 + ( pvv (ji  ,jj-1,jk,Kbb) - pvv (ji  ,jj  ,jk,Kbb) & 
    … …  
    135139            zlv_vv(ji,jj,jk,2) = ( ( zfv(ji  ,jj+1,jk) - zfv(ji  ,jj  ,jk)           & 
    136140               &                   )                                                 & ! bracket for halo 1 - halo 2 compatibility 
    137                &                 + ( zfv(ji  ,jj-1,jk) - zfv(ji  ,jj  ,jk)           &  
     141               &                 + ( zfv(ji  ,jj-1,jk) - zfv(ji  ,jj  ,jk)           & 
    138142               &                   )                                                 & ! bracket for halo 1 - halo 2 compatibility 
    139143               &                 ) * vmask(ji  ,jj  ,jk) 
    … …  
    144148         END_2D 
    145149      END DO 
    146       ! NOTE: [tiling] sign reversal necessary for results to be independent of nn_hls (bug in trunk) 
    147       IF( nn_hls==1 ) CALL lbc_lnk( 'dynadv_ubs', zlu_uu(:,:,:,1), 'U', -1.0_wp , zlu_uv(:,:,:,1), 'U', -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,  & 
    148151                                              &   zlu_uu(:,:,:,2), 'U', -1.0_wp , zlu_uv(:,:,:,2), 'U', -1.0_wp,  & 
    149152                                              &   zlv_vv(:,:,:,1), 'V', -1.0_wp , zlv_vu(:,:,:,1), 'V', -1.0_wp,  & 
    … …  
    154157      DO jk = 1, jpkm1                       ! ====================== ! 
    155158         !                                         ! horizontal volume fluxes 
    156          zfu(:,:,jk) = 0.25_wp * e2u(:,:) * e3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm) 
    157          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 
    158163         ! 
    159164         DO_2D( 1, 0, 1, 0 )                       ! horizontal momentum fluxes at T- and F-point 

  • NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/DYN/dynatf.F90

    r14776 r14805  
    169169# endif 
    170170      ! 
    171       IF (nn_hls==1) CALL lbc_lnk( 'dynatf', puu(:,:,:,Kaa), 'U', -1.0_wp, pvv(:,:,:,Kaa), 'V', -1.0_wp )     !* local domain boundaries 
     171      CALL lbc_lnk( 'dynatf', puu(:,:,:,Kaa), 'U', -1.0_wp, pvv(:,:,:,Kaa), 'V', -1.0_wp )     !* local domain boundaries 
    172172      ! 
    173173      !                                !* BDY open boundaries 
    … …  
    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_r14273_HPC-02_Daley_Tiling/src/OCE/DYN/dynatf_qco.F90

    r14776 r14805  
    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_r14273_HPC-02_Daley_Tiling/src/OCE/DYN/dynhpg.F90

    r14776 r14805  
    118118      CASE ( np_zps )   ;   CALL hpg_zps    ( kt, Kmm, puu, pvv, Krhs )  ! z-coordinate plus partial steps (interpolation) 
    119119      CASE ( np_sco )   ;   CALL hpg_sco    ( kt, Kmm, puu, pvv, Krhs )  ! s-coordinate (standard jacobian formulation) 
    120       CASE ( np_djc )    
     120      CASE ( np_djc ) 
    121121             ! [ comm_cleanup ] : it should not be needed but the removal/shift of this lbc_lnk results in a seg_fault error 
    122              IF (nn_hls==2) CALL lbc_lnk( 'dynhpg', r3t(:,:,Kmm), 'T', 1.) 
     122             ! TODO: [tiling] to check if still needed 
     123!#if defined key_qco 
     124!             IF (nn_hls==2) CALL lbc_lnk( 'dynhpg', r3t(:,:,Kmm), 'T', 1.) 
     125!#endif 
    123126                            CALL hpg_djc    ( kt, Kmm, puu, pvv, Krhs )  ! s-coordinate (Density Jacobian with Cubic polynomial) 
    124127      CASE ( np_prj )   ;   CALL hpg_prj    ( kt, Kmm, puu, pvv, Krhs )  ! s-coordinate (Pressure Jacobian scheme) 
    … …  
    269272      INTEGER  ::   ji, jj, jk       ! dummy loop indices 
    270273      REAL(wp) ::   zcoef0, zcoef1   ! temporary scalars 
    271       REAL(wp), DIMENSION(jpi,jpj) ::  zhpi, zhpj 
    272       !!---------------------------------------------------------------------- 
    273       ! 
    274       IF( kt == nit000 ) THEN 
    275          IF(lwp) WRITE(numout,*) 
    276          IF(lwp) WRITE(numout,*) 'dyn:hpg_zco : hydrostatic pressure gradient trend' 
    277          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   z-coordinate case ' 
     274      REAL(wp), DIMENSION(A2D(nn_hls)) ::  zhpi, zhpj 
     275      !!---------------------------------------------------------------------- 
     276      ! 
     277      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     278         IF( kt == nit000 ) THEN 
     279            IF(lwp) WRITE(numout,*) 
     280            IF(lwp) WRITE(numout,*) 'dyn:hpg_zco : hydrostatic pressure gradient trend' 
     281            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   z-coordinate case ' 
     282         ENDIF 
    278283      ENDIF 
    279284      ! 
    … …  
    321326      INTEGER  ::   iku, ikv                         ! temporary integers 
    322327      REAL(wp) ::   zcoef0, zcoef1, zcoef2, zcoef3   ! temporary scalars 
    323       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zhpi, zhpj 
    324       REAL(wp), DIMENSION(jpi,jpj,jpts)   :: zgtsu, zgtsv 
    325       REAL(wp), DIMENSION(jpi,jpj)     :: zgru, zgrv 
    326       !!---------------------------------------------------------------------- 
    327       ! 
    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' 
     328      REAL(wp), DIMENSION(A2D(nn_hls),jpk ) :: zhpi, zhpj 
     329      REAL(wp), DIMENSION(A2D(nn_hls),jpts) :: zgtsu, zgtsv 
     330      REAL(wp), DIMENSION(A2D(nn_hls)     ) :: zgru, zgrv 
     331      !!---------------------------------------------------------------------- 
     332      ! 
     333      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     334         IF( kt == nit000 ) THEN 
     335            IF(lwp) WRITE(numout,*) 
     336            IF(lwp) WRITE(numout,*) 'dyn:hpg_zps : hydrostatic pressure gradient trend' 
     337            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   z-coordinate with partial steps - vector optimization' 
     338         ENDIF 
    332339      ENDIF 
    333340 
    … …  
    413420      REAL(wp) ::   zcoef0, zuap, zvap, ztmp       ! local scalars 
    414421      LOGICAL  ::   ll_tmp1, ll_tmp2               ! local logical variables 
    415       REAL(wp), DIMENSION(jpi,jpj,jpk)      ::   zhpi, zhpj 
     422      REAL(wp), DIMENSION(A2D(nn_hls),jpk)  ::   zhpi, zhpj 
    416423      REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   zcpx, zcpy   !W/D pressure filter 
    417424      !!---------------------------------------------------------------------- 
    418425      ! 
    419       IF( ln_wd_il ) ALLOCATE(zcpx(jpi,jpj), zcpy(jpi,jpj)) 
    420       ! 
    421       IF( kt == nit000 ) THEN 
    422          IF(lwp) WRITE(numout,*) 
    423          IF(lwp) WRITE(numout,*) 'dyn:hpg_sco : hydrostatic pressure gradient trend' 
    424          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   s-coordinate case, OCE original scheme used' 
     426      IF( ln_wd_il ) ALLOCATE(zcpx(A2D(nn_hls)), zcpy(A2D(nn_hls))) 
     427      ! 
     428      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     429         IF( kt == nit000 ) THEN 
     430            IF(lwp) WRITE(numout,*) 
     431            IF(lwp) WRITE(numout,*) 'dyn:hpg_sco : hydrostatic pressure gradient trend' 
     432            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   s-coordinate case, OCE original scheme used' 
     433         ENDIF 
    425434      ENDIF 
    426435      ! 
    … …  
    550559      REAL(wp) ::   ze3w, ze3wi1, ze3wj1   ! local scalars 
    551560      REAL(wp) ::   zcoef0, zuap, zvap     !   -      - 
    552       REAL(wp), DIMENSION(jpi,jpj,jpk ) ::  zhpi, zhpj 
    553       REAL(wp), DIMENSION(jpi,jpj,jpts) ::  zts_top 
    554       REAL(wp), DIMENSION(jpi,jpj)      ::  zrhdtop_oce 
     561      REAL(wp), DIMENSION(A2D(nn_hls),jpk ) ::  zhpi, zhpj 
     562      REAL(wp), DIMENSION(A2D(nn_hls),jpts) ::  zts_top 
     563      REAL(wp), DIMENSION(A2D(nn_hls))      ::  zrhdtop_oce 
    555564      !!---------------------------------------------------------------------- 
    556565      ! 
    … …  
    562571      ! compute rhd at the ice/oce interface (ocean side) 
    563572      ! usefull to reduce residual current in the test case ISOMIP with no melting 
    564       DO ji = 1, jpi 
    565         DO jj = 1, jpj 
    566           ikt = mikt(ji,jj) 
    567           zts_top(ji,jj,1) = ts(ji,jj,ikt,1,Kmm) 
    568           zts_top(ji,jj,2) = ts(ji,jj,ikt,2,Kmm) 
    569         END DO 
    570       END DO 
     573      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     574         ikt = mikt(ji,jj) 
     575         zts_top(ji,jj,1) = ts(ji,jj,ikt,1,Kmm) 
     576         zts_top(ji,jj,2) = ts(ji,jj,ikt,2,Kmm) 
     577      END_2D 
    571578      CALL eos( zts_top, risfdep, zrhdtop_oce ) 
    572579 
    … …  
    638645      INTEGER  ::   iktb, iktt          ! jk indices at tracer points for top and bottom points  
    639646      REAL(wp) ::   zcoef0, zep, cffw   ! temporary scalars 
    640       REAL(wp) ::   z_grav_10, z1_12 
     647      REAL(wp) ::   z_grav_10, z1_12, z1_cff 
    641648      REAL(wp) ::   cffu, cffx          !    "         " 
    642649      REAL(wp) ::   cffv, cffy          !    "         " 
    643650      LOGICAL  ::   ll_tmp1, ll_tmp2    ! local logical variables 
    644       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zhpi, zhpj 
    645   
    646       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdzx, zdzy, zdzz                          ! Primitive grid differences ('delta_xyz') 
    647       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdz_i, zdz_j, zdz_k                       ! Harmonic average of primitive grid differences ('d_xyz') 
    648       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdrhox, zdrhoy, zdrhoz                    ! Primitive rho differences ('delta_rho') 
    649       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdrho_i, zdrho_j, zdrho_k                 ! Harmonic average of primitive rho differences ('d_rho') 
    650       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   z_rho_i, z_rho_j, z_rho_k                 ! Face intergrals 
    651       REAL(wp), DIMENSION(jpi,jpj)     ::   zz_dz_i, zz_dz_j, zz_drho_i, zz_drho_j    ! temporary arrays  
     651      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zhpi, zhpj 
     652 
     653      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zdzx, zdzy, zdzz                          ! Primitive grid differences ('delta_xyz') 
     654      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zdz_i, zdz_j, zdz_k                       ! Harmonic average of primitive grid differences ('d_xyz') 
     655      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zdrhox, zdrhoy, zdrhoz                    ! Primitive rho differences ('delta_rho') 
     656      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zdrho_i, zdrho_j, zdrho_k                 ! Harmonic average of primitive rho differences ('d_rho') 
     657      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   z_rho_i, z_rho_j, z_rho_k                 ! Face intergrals 
     658      REAL(wp), DIMENSION(A2D(nn_hls))     ::   zz_dz_i, zz_dz_j, zz_drho_i, zz_drho_j    ! temporary arrays 
    652659      REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   zcpx, zcpy   !W/D pressure filter 
    653660      !!---------------------------------------------------------------------- 
    654661      ! 
    655662      IF( ln_wd_il ) THEN 
    656          ALLOCATE( zcpx(jpi,jpj) , zcpy(jpi,jpj) ) 
     663         ALLOCATE( zcpx(A2D(nn_hls)) , zcpy(A2D(nn_hls)) ) 
    657664        DO_2D( 0, 0, 0, 0 ) 
    658665          ll_tmp1 = MIN(  ssh(ji,jj,Kmm)              ,  ssh(ji+1,jj,Kmm) ) >                & 
    … …  
    691698          END IF 
    692699        END_2D 
    693         ! NOTE: [tiling] sign reversal necessary for results to be independent of nn_hls (bug in trunk) 
    694         IF( nn_hls == 1 ) CALL lbc_lnk( 'dynhpg', zdrhox, 'U', -1._wp, zdzx, 'U', -1._wp, zdrhoy, 'V', -1._wp, zdzy, 'V', -1._wp ) 
    695700      END IF 
    696701 
    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' 
     702      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     703         IF( kt == nit000 ) THEN 
     704            IF(lwp) WRITE(numout,*) 
     705            IF(lwp) WRITE(numout,*) 'dyn:hpg_djc : hydrostatic pressure gradient trend' 
     706            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   s-coordinate case, density Jacobian with cubic polynomial scheme' 
     707         ENDIF 
    701708      ENDIF 
    702709 
    … …  
    726733      zdz_k  (:,:,:) = 0._wp 
    727734 
    728       DO_3D( 1, 1, 1, 1, 2, jpk-2 )  
    729          cffw = 2._wp * zdrhoz(ji  ,jj  ,jk) * zdrhoz(ji,jj,jk+1) 
    730          IF( cffw > zep) THEN 
    731             zdrho_k(ji,jj,jk) = cffw / ( zdrhoz(ji,jj,jk) + zdrhoz(ji,jj,jk+1) ) 
    732          ENDIF 
     735      DO_3D( 1, 1, 1, 1, 2, jpk-2 ) 
     736         cffw = MAX( 2._wp * zdrhoz(ji,jj,jk) * zdrhoz(ji,jj,jk+1), 0._wp ) 
     737         z1_cff = zdrhoz(ji,jj,jk) + zdrhoz(ji,jj,jk+1) 
     738         zdrho_k(ji,jj,jk) = cffw / SIGN( MAX( ABS(z1_cff), zep ), z1_cff ) 
    733739         zdz_k(ji,jj,jk) = 2._wp *   zdzz(ji,jj,jk) * zdzz(ji,jj,jk+1)   & 
    734740            &                  / ( zdzz(ji,jj,jk) + zdzz(ji,jj,jk+1) ) 
    … …  
    740746 
    741747! mb for sea-ice shelves we will need to re-write this upper boundary condition in the same form as the lower boundary condition 
    742       zdrho_k(:,:,1) = aco_bc_vrt * ( rhd    (:,:,2) - rhd    (:,:,1) ) - bco_bc_vrt * zdrho_k(:,:,2) 
    743       zdz_k  (:,:,1) = aco_bc_vrt * (-gde3w(:,:,2) + gde3w(:,:,1) ) - bco_bc_vrt * zdz_k  (:,:,2) 
     748      DO_2D( 1, 1, 1, 1 ) 
     749         zdrho_k(ji,jj,1) = aco_bc_vrt * ( rhd  (ji,jj,2) - rhd  (ji,jj,1) ) - bco_bc_vrt * zdrho_k(ji,jj,2) 
     750         zdz_k  (ji,jj,1) = aco_bc_vrt * (-gde3w(ji,jj,2) + gde3w(ji,jj,1) ) - bco_bc_vrt * zdz_k  (ji,jj,2) 
     751      END_2D 
    744752 
    745753      DO_2D( 1, 1, 1, 1 ) 
    … …  
    788796      !  5. compute and store elementary horizontal differences in provisional arrays  
    789797      !---------------------------------------------------------------------------------------- 
    790       DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) 
    791          zdrhox(ji,jj,jk) =   rhd    (ji+1,jj  ,jk) - rhd    (ji,jj,jk  ) 
    792          zdzx  (ji,jj,jk) = - gde3w(ji+1,jj  ,jk) + gde3w(ji,jj,jk  ) 
    793          zdrhoy(ji,jj,jk) =   rhd    (ji  ,jj+1,jk) - rhd    (ji,jj,jk  ) 
    794          zdzy  (ji,jj,jk) = - gde3w(ji  ,jj+1,jk) + gde3w(ji,jj,jk  ) 
    795       END_3D 
    796  
    797       IF (nn_hls==1) CALL lbc_lnk( 'dynhpg', zdrhox, 'U', -1., zdzx, 'U', -1., zdrhoy, 'V', -1., zdzy, 'V', -1. )  
     798      zdrhox(:,:,:) = 0._wp 
     799      zdzx  (:,:,:) = 0._wp 
     800      zdrhoy(:,:,:) = 0._wp 
     801      zdzy  (:,:,:) = 0._wp 
     802 
     803      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
     804         zdrhox(ji,jj,jk) = rhd  (ji+1,jj  ,jk) - rhd  (ji  ,jj  ,jk) 
     805         zdzx  (ji,jj,jk) = gde3w(ji  ,jj  ,jk) - gde3w(ji+1,jj  ,jk) 
     806         zdrhoy(ji,jj,jk) = rhd  (ji  ,jj+1,jk) - rhd  (ji  ,jj  ,jk) 
     807         zdzy  (ji,jj,jk) = gde3w(ji  ,jj  ,jk) - gde3w(ji  ,jj+1,jk) 
     808      END_3D 
     809 
     810      IF( nn_hls == 1 ) CALL lbc_lnk( 'dynhpg', zdrhox, 'U', -1._wp, zdzx, 'U', -1._wp, zdrhoy, 'V', -1._wp, zdzy, 'V', -1._wp ) 
    798811 
    799812      !------------------------------------------------------------------------- 
    … …  
    802815 
    803816      DO_3D( 0, 1, 0, 1, 1, jpkm1 ) 
    804          cffu = 2._wp * zdrhox(ji-1,jj  ,jk) * zdrhox(ji,jj,jk  ) 
    805          IF( cffu > zep ) THEN 
    806             zdrho_i(ji,jj,jk) = cffu / ( zdrhox(ji-1,jj,jk) + zdrhox(ji,jj,jk) ) 
    807          ELSE 
    808             zdrho_i(ji,jj,jk ) = 0._wp 
    809          ENDIF 
    810  
    811          cffx = 2._wp * zdzx  (ji-1,jj  ,jk) * zdzx  (ji,jj,jk  ) 
    812          IF( cffx > zep ) THEN 
    813             zdz_i(ji,jj,jk) = cffx / ( zdzx(ji-1,jj,jk) + zdzx(ji,jj,jk) ) 
    814          ELSE 
    815             zdz_i(ji,jj,jk) = 0._wp 
    816          ENDIF 
    817  
    818          cffv = 2._wp * zdrhoy(ji  ,jj-1,jk) * zdrhoy(ji,jj,jk  ) 
    819          IF( cffv > zep ) THEN 
    820             zdrho_j(ji,jj,jk) = cffv / ( zdrhoy(ji,jj-1,jk) + zdrhoy(ji,jj,jk) ) 
    821          ELSE 
    822             zdrho_j(ji,jj,jk) = 0._wp 
    823          ENDIF 
    824  
    825          cffy = 2._wp * zdzy  (ji  ,jj-1,jk) * zdzy  (ji,jj,jk  ) 
    826          IF( cffy > zep ) THEN 
    827             zdz_j(ji,jj,jk) = cffy / ( zdzy(ji,jj-1,jk) + zdzy(ji,jj,jk) ) 
    828          ELSE 
    829             zdz_j(ji,jj,jk) = 0._wp 
    830          ENDIF 
     817         cffu = MAX( 2._wp * zdrhox(ji-1,jj,jk) * zdrhox(ji,jj,jk), 0._wp ) 
     818         z1_cff = zdrhox(ji-1,jj,jk) + zdrhox(ji,jj,jk) 
     819         zdrho_i(ji,jj,jk) = cffu / SIGN( MAX( ABS(z1_cff), zep ), z1_cff ) 
     820 
     821         cffx = MAX( 2._wp * zdzx(ji-1,jj,jk)   * zdzx(ji,jj,jk), 0._wp ) 
     822         z1_cff = zdzx(ji-1,jj,jk)   + zdzx(ji,jj,jk) 
     823         zdz_i(ji,jj,jk)   = cffx / SIGN( MAX( ABS(z1_cff), zep ), z1_cff ) 
     824 
     825         cffv = MAX( 2._wp * zdrhoy(ji,jj-1,jk) * zdrhoy(ji,jj,jk), 0._wp ) 
     826         z1_cff = zdrhoy(ji,jj-1,jk) + zdrhoy(ji,jj,jk) 
     827         zdrho_j(ji,jj,jk) = cffv / SIGN( MAX( ABS(z1_cff), zep ), z1_cff ) 
     828 
     829         cffy = MAX( 2._wp * zdzy(ji,jj-1,jk)   * zdzy(ji,jj,jk), 0._wp ) 
     830         z1_cff = zdzy(ji,jj-1,jk)   + zdzy(ji,jj,jk) 
     831         zdz_j(ji,jj,jk)   = cffy / SIGN( MAX( ABS(z1_cff), zep ), z1_cff ) 
    831832      END_3D 
    832833       
    … …  
    842843         zz_drho_j(:,:) = zdrho_j(:,:,jk) 
    843844         zz_dz_j  (:,:) = zdz_j  (:,:,jk) 
    844          DO_2D( 0, 1, 0, 1) 
    845             ! Walls coming from left: should check from 2 to jpi-1 (and jpj=2-jpj) 
    846             IF (ji < jpi) THEN 
    847                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   
    848                   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)  
    849                   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) 
    850                END IF 
     845         ! Walls coming from left: should check from 2 to jpi-1 (and jpj=2-jpj) 
     846         DO_2D( 0, 0, 0, 1 ) 
     847            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 
     848               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) 
     849               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) 
    851850            END IF 
    852             ! Walls coming from right: should check from 3 to jpi (and jpj=2-jpj) 
    853             IF (ji > 2) THEN 
    854                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 
    855                   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)   
    856                   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) 
    857                END IF 
     851         END_2D 
     852         ! Walls coming from right: should check from 3 to jpi (and jpj=2-jpj) 
     853         DO_2D( -1, 1, 0, 1 ) 
     854            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 
     855               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) 
     856               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) 
    858857            END IF 
    859             ! Walls coming from left: should check from 2 to jpj-1 (and jpi=2-jpi) 
    860             IF (jj < jpj) THEN 
    861                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 
    862                   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) 
    863                   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) 
    864                END IF 
    865             END IF  
    866             ! Walls coming from right: should check from 3 to jpj (and jpi=2-jpi) 
    867             IF (jj > 2) THEN 
    868                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  
    869                   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)  
    870                   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) 
    871                END IF 
     858         END_2D 
     859         ! Walls coming from left: should check from 2 to jpj-1 (and jpi=2-jpi) 
     860         DO_2D( 0, 1, 0, 0 ) 
     861            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 
     862               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) 
     863               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) 
     864            END IF 
     865         END_2D 
     866         ! Walls coming from right: should check from 3 to jpj (and jpi=2-jpi) 
     867         DO_2D( 0, 1, -1, 1 ) 
     868            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 
     869               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) 
     870               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) 
    872871            END IF 
    873872         END_2D 
    … …  
    976975      REAL(wp) :: zrhdt1 
    977976      REAL(wp) :: zdpdx1, zdpdx2, zdpdy1, zdpdy2 
    978       REAL(wp), DIMENSION(jpi,jpj)     ::   zpgu, zpgv   ! 2D workspace 
    979       REAL(wp), DIMENSION(jpi,jpj)     ::   zsshu_n, zsshv_n 
    980       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdept, zrhh 
    981       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp 
     977      REAL(wp), DIMENSION(A2D(nn_hls))     ::   zpgu, zpgv   ! 2D workspace 
     978      REAL(wp), DIMENSION(A2D(nn_hls))     ::   zsshu_n, zsshv_n 
     979      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zdept, zrhh 
     980      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp 
    982981      REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   zcpx, zcpy   !W/D pressure filter 
    983982      !!---------------------------------------------------------------------- 
    984983      ! 
    985       IF( kt == nit000 ) THEN 
    986          IF(lwp) WRITE(numout,*) 
    987          IF(lwp) WRITE(numout,*) 'dyn:hpg_prj : hydrostatic pressure gradient trend' 
    988          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   s-coordinate case, cubic spline pressure Jacobian' 
     984      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     985         IF( kt == nit000 ) THEN 
     986            IF(lwp) WRITE(numout,*) 
     987            IF(lwp) WRITE(numout,*) 'dyn:hpg_prj : hydrostatic pressure gradient trend' 
     988            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   s-coordinate case, cubic spline pressure Jacobian' 
     989         ENDIF 
    989990      ENDIF 
    990991 
    … …  
    10031004      ! 
    10041005      IF( ln_wd_il ) THEN 
    1005          ALLOCATE( zcpx(jpi,jpj) , zcpy(jpi,jpj) ) 
     1006         ALLOCATE( zcpx(A2D(nn_hls)) , zcpy(A2D(nn_hls)) ) 
    10061007         DO_2D( 0, 0, 0, 0 ) 
    1007           ll_tmp1 = MIN(  ssh(ji,jj,Kmm)              ,  ssh(ji+1,jj,Kmm) ) >                & 
    1008                &    MAX( -ht_0(ji,jj)              , -ht_0(ji+1,jj) ) .AND.            & 
    1009                &    MAX(  ssh(ji,jj,Kmm) + ht_0(ji,jj),  ssh(ji+1,jj,Kmm) + ht_0(ji+1,jj) )  & 
    1010                &                                                      > rn_wdmin1 + rn_wdmin2 
    1011           ll_tmp2 = ( ABS( ssh(ji,jj,Kmm)             -  ssh(ji+1,jj,Kmm) ) > 1.E-12 ) .AND. (         & 
    1012                &    MAX(   ssh(ji,jj,Kmm)             ,  ssh(ji+1,jj,Kmm) ) >                & 
    1013                &    MAX(  -ht_0(ji,jj)             , -ht_0(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 ) 
    1014  
    1015           IF(ll_tmp1) THEN 
    1016             zcpx(ji,jj) = 1.0_wp 
    1017           ELSE IF(ll_tmp2) THEN 
    1018             ! no worries about  ssh(ji+1,jj,Kmm) -  ssh(ji  ,jj,Kmm) = 0, it won't happen ! here 
    1019             zcpx(ji,jj) = ABS( (ssh(ji+1,jj,Kmm) + ht_0(ji+1,jj) - ssh(ji,jj,Kmm) - ht_0(ji,jj)) & 
    1020                         &    / (ssh(ji+1,jj,Kmm) -  ssh(ji  ,jj,Kmm)) ) 
    1021             
    1022              zcpx(ji,jj) = max(min( zcpx(ji,jj) , 1.0_wp),0.0_wp) 
    1023           ELSE 
    1024             zcpx(ji,jj) = 0._wp 
    1025           END IF 
    1026     
    1027           ll_tmp1 = MIN(  ssh(ji,jj,Kmm)              ,  ssh(ji,jj+1,Kmm) ) >                & 
    1028                &    MAX( -ht_0(ji,jj)              , -ht_0(ji,jj+1) ) .AND.            & 
    1029                &    MAX(  ssh(ji,jj,Kmm) + ht_0(ji,jj),  ssh(ji,jj+1,Kmm) + ht_0(ji,jj+1) )  & 
    1030                &                                                      > rn_wdmin1 + rn_wdmin2 
    1031           ll_tmp2 = ( ABS( ssh(ji,jj,Kmm)             -  ssh(ji,jj+1,Kmm) ) > 1.E-12 ) .AND. (      & 
    1032                &    MAX(   ssh(ji,jj,Kmm)             ,  ssh(ji,jj+1,Kmm) ) >                & 
    1033                &    MAX(  -ht_0(ji,jj)             , -ht_0(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 ) 
    1034  
    1035           IF(ll_tmp1) THEN 
    1036             zcpy(ji,jj) = 1.0_wp 
    1037           ELSE IF(ll_tmp2) THEN 
    1038             ! no worries about  ssh(ji,jj+1,Kmm) -  ssh(ji,jj  ,Kmm) = 0, it won't happen ! here 
    1039             zcpy(ji,jj) = ABS( (ssh(ji,jj+1,Kmm) + ht_0(ji,jj+1) - ssh(ji,jj,Kmm) - ht_0(ji,jj)) & 
    1040                         &    / (ssh(ji,jj+1,Kmm) - ssh(ji,jj  ,Kmm)) ) 
    1041              zcpy(ji,jj) = max(min( zcpy(ji,jj) , 1.0_wp),0.0_wp) 
    1042  
     1008            ll_tmp1 = MIN(   ssh(ji,jj,Kmm)              ,   ssh(ji+1,jj,Kmm)                 ) >       & 
     1009               &      MAX( -ht_0(ji,jj)                  , -ht_0(ji+1,jj)                     ) .AND.   & 
     1010               &      MAX(   ssh(ji,jj,Kmm) + ht_0(ji,jj),   ssh(ji+1,jj,Kmm) + ht_0(ji+1,jj) ) >       & 
     1011               &      rn_wdmin1 + rn_wdmin2 
     1012            ll_tmp2 = ( ABS(   ssh(ji,jj,Kmm) -   ssh(ji+1,jj,Kmm) ) > 1.E-12 ) .AND.                   & 
     1013               &      ( MAX(   ssh(ji,jj,Kmm) ,   ssh(ji+1,jj,Kmm) ) >                                  & 
     1014               &        MAX( -ht_0(ji,jj)     , -ht_0(ji+1,jj)     ) + rn_wdmin1 + rn_wdmin2 ) 
     1015 
     1016            IF(ll_tmp1) THEN 
     1017               zcpx(ji,jj) = 1.0_wp 
     1018            ELSE IF(ll_tmp2) THEN 
     1019               ! no worries about  ssh(ji+1,jj,Kmm) -  ssh(ji  ,jj,Kmm) = 0, it won't happen ! here 
     1020               zcpx(ji,jj) = ABS( (ssh(ji+1,jj,Kmm) + ht_0(ji+1,jj) - ssh(ji,jj,Kmm) - ht_0(ji,jj)) & 
     1021                           &    / (ssh(ji+1,jj,Kmm) -  ssh(ji  ,jj,Kmm)) ) 
     1022               zcpx(ji,jj) = MAX(MIN( zcpx(ji,jj) , 1.0_wp),0.0_wp) 
     1023            ELSE 
     1024               zcpx(ji,jj) = 0._wp 
     1025            END IF 
     1026 
     1027            ll_tmp1 = MIN(   ssh(ji,jj,Kmm)              ,   ssh(ji,jj+1,Kmm)                 ) >       & 
     1028               &      MAX( -ht_0(ji,jj)                  , -ht_0(ji,jj+1)                     ) .AND.   & 
     1029               &      MAX(   ssh(ji,jj,Kmm) + ht_0(ji,jj),   ssh(ji,jj+1,Kmm) + ht_0(ji,jj+1) ) >       & 
     1030               &      rn_wdmin1 + rn_wdmin2 
     1031            ll_tmp2 = ( ABS(   ssh(ji,jj,Kmm) -   ssh(ji,jj+1,Kmm) ) > 1.E-12 ) .AND.                   & 
     1032               &      ( MAX(   ssh(ji,jj,Kmm) ,   ssh(ji,jj+1,Kmm) ) >                                  & 
     1033               &        MAX( -ht_0(ji,jj)     , -ht_0(ji,jj+1)     ) + rn_wdmin1 + rn_wdmin2 ) 
     1034 
     1035            IF(ll_tmp1) THEN 
     1036               zcpy(ji,jj) = 1.0_wp 
     1037            ELSE IF(ll_tmp2) THEN 
     1038               ! no worries about  ssh(ji,jj+1,Kmm) -  ssh(ji,jj  ,Kmm) = 0, it won't happen ! here 
     1039               zcpy(ji,jj) = ABS( (ssh(ji,jj+1,Kmm) + ht_0(ji,jj+1) - ssh(ji,jj,Kmm) - ht_0(ji,jj)) & 
     1040                           &    / (ssh(ji,jj+1,Kmm) -  ssh(ji,jj  ,Kmm)) ) 
     1041               zcpy(ji,jj) = MAX(MIN( zcpy(ji,jj) , 1.0_wp),0.0_wp) 
    10431042            ELSE 
    10441043               zcpy(ji,jj) = 0._wp 
    … …  
    10491048      ! Clean 3-D work arrays 
    10501049      zhpi(:,:,:) = 0._wp 
    1051       zrhh(:,:,:) = rhd(:,:,:) 
     1050      zrhh(:,:,:) = rhd(A2D(nn_hls),:) 
    10521051 
    10531052      ! Preparing vertical density profile "zrhh(:,:,:)" for hybrid-sco coordinate 
    10541053      DO_2D( 1, 1, 1, 1 ) 
    1055        jk = mbkt(ji,jj) 
    1056        IF(     jk <=  1   ) THEN   ;   zrhh(ji,jj,    :   ) = 0._wp 
    1057        ELSEIF( jk ==  2   ) THEN   ;   zrhh(ji,jj,jk+1:jpk) = rhd(ji,jj,jk) 
    1058        ELSEIF( jk < jpkm1 ) THEN 
    1059           DO jkk = jk+1, jpk 
    1060              zrhh(ji,jj,jkk) = interp1(gde3w(ji,jj,jkk  ), gde3w(ji,jj,jkk-1),   & 
    1061                 &                      gde3w(ji,jj,jkk-2), zrhh (ji,jj,jkk-1), zrhh(ji,jj,jkk-2)) 
    1062           END DO 
    1063        ENDIF 
     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 
    10641063      END_2D 
    10651064 
    … …  
    10831082      ! Integrate the hydrostatic pressure "zhpi(:,:,:)" at "T(ji,jj,1)" 
    10841083      DO_2D( 0, 1, 0, 1 ) 
    1085        zrhdt1 = zrhh(ji,jj,1) - interp3( zdept(ji,jj,1), asp(ji,jj,1), bsp(ji,jj,1),  & 
    1086           &                                              csp(ji,jj,1), dsp(ji,jj,1) ) * 0.25_wp * e3w(ji,jj,1,Kmm) 
    1087  
    1088        ! assuming linear profile across the top half surface layer 
    1089        zhpi(ji,jj,1) =  0.5_wp * e3w(ji,jj,1,Kmm) * zrhdt1 
     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 
    10901089      END_2D 
    10911090 
    10921091      ! Calculate the pressure "zhpi(:,:,:)" at "T(ji,jj,2:jpkm1)" 
    10931092      DO_3D( 0, 1, 0, 1, 2, jpkm1 ) 
    1094       zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) +                                  & 
    1095          &             integ_spline( zdept(ji,jj,jk-1), zdept(ji,jj,jk),   & 
    1096          &                           asp  (ji,jj,jk-1), bsp  (ji,jj,jk-1), & 
    1097          &                           csp  (ji,jj,jk-1), dsp  (ji,jj,jk-1)  ) 
     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)  ) 
    10981097      END_3D 
    10991098 
    … …  
    11081107!                         & r1_e1e2v(ji,jj) * vmask(ji,jj,1) * 0.5_wp  
    11091108!!gm not this: 
    1110        zsshu_n(ji,jj) = (e1e2u(ji,jj) * ssh(ji,jj,Kmm) + e1e2u(ji+1, jj) * ssh(ji+1,jj,Kmm)) * & 
    1111                       & r1_e1e2u(ji,jj) * umask(ji,jj,1) * 0.5_wp  
    1112        zsshv_n(ji,jj) = (e1e2v(ji,jj) * ssh(ji,jj,Kmm) + e1e2v(ji+1, jj) * ssh(ji,jj+1,Kmm)) * & 
    1113                       & r1_e1e2v(ji,jj) * vmask(ji,jj,1) * 0.5_wp  
     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 
    11141113      END_2D 
    11151114 
    11161115      DO_2D( 0, 0, 0, 0 ) 
    1117        zu(ji,jj,1) = - ( e3u(ji,jj,1,Kmm) - zsshu_n(ji,jj) )  
    1118        zv(ji,jj,1) = - ( e3v(ji,jj,1,Kmm) - zsshv_n(ji,jj) ) 
     1116         zu(ji,jj,1) = - ( e3u(ji,jj,1,Kmm) - zsshu_n(ji,jj) ) 
     1117         zv(ji,jj,1) = - ( e3v(ji,jj,1,Kmm) - zsshv_n(ji,jj) ) 
    11191118      END_2D 
    11201119 
    11211120      DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    1122       zu(ji,jj,jk) = zu(ji,jj,jk-1) - e3u(ji,jj,jk,Kmm) 
    1123       zv(ji,jj,jk) = zv(ji,jj,jk-1) - e3v(ji,jj,jk,Kmm) 
     1121         zu(ji,jj,jk) = zu(ji,jj,jk-1) - e3u(ji,jj,jk,Kmm) 
     1122         zv(ji,jj,jk) = zv(ji,jj,jk-1) - e3v(ji,jj,jk,Kmm) 
    11241123      END_3D 
    11251124 
    11261125      DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    1127       zu(ji,jj,jk) = zu(ji,jj,jk) + 0.5_wp * e3u(ji,jj,jk,Kmm) 
    1128       zv(ji,jj,jk) = zv(ji,jj,jk) + 0.5_wp * e3v(ji,jj,jk,Kmm) 
     1126         zu(ji,jj,jk) = zu(ji,jj,jk) + 0.5_wp * e3u(ji,jj,jk,Kmm) 
     1127         zv(ji,jj,jk) = zv(ji,jj,jk) + 0.5_wp * e3v(ji,jj,jk,Kmm) 
    11291128      END_3D 
    11301129 
    11311130      DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    1132       zu(ji,jj,jk) = MIN(  zu(ji,jj,jk) , MAX( -zdept(ji,jj,jk) , -zdept(ji+1,jj,jk) )  ) 
    1133       zu(ji,jj,jk) = MAX(  zu(ji,jj,jk) , MIN( -zdept(ji,jj,jk) , -zdept(ji+1,jj,jk) )  ) 
    1134       zv(ji,jj,jk) = MIN(  zv(ji,jj,jk) , MAX( -zdept(ji,jj,jk) , -zdept(ji,jj+1,jk) )  ) 
    1135       zv(ji,jj,jk) = MAX(  zv(ji,jj,jk) , MIN( -zdept(ji,jj,jk) , -zdept(ji,jj+1,jk) )  ) 
     1131         zu(ji,jj,jk) = MIN(  zu(ji,jj,jk) , MAX( -zdept(ji,jj,jk) , -zdept(ji+1,jj,jk) )  ) 
     1132         zu(ji,jj,jk) = MAX(  zu(ji,jj,jk) , MIN( -zdept(ji,jj,jk) , -zdept(ji+1,jj,jk) )  ) 
     1133         zv(ji,jj,jk) = MIN(  zv(ji,jj,jk) , MAX( -zdept(ji,jj,jk) , -zdept(ji,jj+1,jk) )  ) 
     1134         zv(ji,jj,jk) = MAX(  zv(ji,jj,jk) , MIN( -zdept(ji,jj,jk) , -zdept(ji,jj+1,jk) )  ) 
    11361135      END_3D 
    11371136 
    11381137 
    11391138      DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    1140       zpwes = 0._wp; zpwed = 0._wp 
    1141       zpnss = 0._wp; zpnsd = 0._wp 
    1142       zuijk = zu(ji,jj,jk) 
    1143       zvijk = zv(ji,jj,jk) 
    1144  
    1145       !!!!!     for u equation 
    1146       IF( jk <= mbku(ji,jj) ) THEN 
    1147          IF( -zdept(ji+1,jj,jk) >= -zdept(ji,jj,jk) ) THEN 
    1148            jis = ji + 1; jid = ji 
    1149          ELSE 
    1150            jis = ji;     jid = ji +1 
     1139         zpwes = 0._wp; zpwed = 0._wp 
     1140         zpnss = 0._wp; zpnsd = 0._wp 
     1141         zuijk = zu(ji,jj,jk) 
     1142         zvijk = zv(ji,jj,jk) 
     1143 
     1144         !!!!!     for u equation 
     1145         IF( jk <= mbku(ji,jj) ) THEN 
     1146            IF( -zdept(ji+1,jj,jk) >= -zdept(ji,jj,jk) ) THEN 
     1147              jis = ji + 1; jid = ji 
     1148            ELSE 
     1149              jis = ji;     jid = ji +1 
     1150            ENDIF 
     1151 
     1152            ! integrate the pressure on the shallow side 
     1153            jk1 = jk 
     1154            DO WHILE ( -zdept(jis,jj,jk1) > zuijk ) 
     1155               IF( jk1 == mbku(ji,jj) ) THEN 
     1156                  zuijk = -zdept(jis,jj,jk1) 
     1157                  EXIT 
     1158               ENDIF 
     1159               zdeps = MIN(zdept(jis,jj,jk1+1), -zuijk) 
     1160               zpwes = zpwes +                                      & 
     1161                  integ_spline(zdept(jis,jj,jk1), zdeps,            & 
     1162                                 asp(jis,jj,jk1), bsp(jis,jj,jk1),  & 
     1163                                 csp(jis,jj,jk1), dsp(jis,jj,jk1)) 
     1164               jk1 = jk1 + 1 
     1165            END DO 
     1166 
     1167            ! integrate the pressure on the deep side 
     1168            jk1 = jk 
     1169            DO WHILE ( -zdept(jid,jj,jk1) < zuijk ) 
     1170               IF( jk1 == 1 ) THEN 
     1171                  zdeps = zdept(jid,jj,1) + MIN(zuijk, ssh(jid,jj,Kmm)*znad) 
     1172                  zrhdt1 = zrhh(jid,jj,1) - interp3(zdept(jid,jj,1), asp(jid,jj,1), & 
     1173                                                    bsp(jid,jj,1)  , csp(jid,jj,1), & 
     1174                                                    dsp(jid,jj,1)) * zdeps 
     1175                  zpwed  = zpwed + 0.5_wp * (zrhh(jid,jj,1) + zrhdt1) * zdeps 
     1176                  EXIT 
     1177               ENDIF 
     1178               zdeps = MAX(zdept(jid,jj,jk1-1), -zuijk) 
     1179               zpwed = zpwed +                                        & 
     1180                  integ_spline(zdeps,             zdept(jid,jj,jk1),  & 
     1181                               asp(jid,jj,jk1-1), bsp(jid,jj,jk1-1),  & 
     1182                               csp(jid,jj,jk1-1), dsp(jid,jj,jk1-1) ) 
     1183               jk1 = jk1 - 1 
     1184            END DO 
     1185 
     1186            ! update the momentum trends in u direction 
     1187            zdpdx1 = zcoef0 * r1_e1u(ji,jj) * ( zhpi(ji+1,jj,jk) - zhpi(ji,jj,jk) ) 
     1188            IF( .NOT.ln_linssh ) THEN 
     1189               zdpdx2 = zcoef0 * r1_e1u(ji,jj) * & 
     1190                  &    ( REAL(jis-jid, wp) * (zpwes + zpwed) + (ssh(ji+1,jj,Kmm)-ssh(ji,jj,Kmm)) ) 
     1191            ELSE 
     1192               zdpdx2 = zcoef0 * r1_e1u(ji,jj) * REAL(jis-jid, wp) * (zpwes + zpwed) 
     1193            ENDIF 
     1194            IF( ln_wd_il ) THEN 
     1195               zdpdx1 = zdpdx1 * zcpx(ji,jj) * wdrampu(ji,jj) 
     1196               zdpdx2 = zdpdx2 * zcpx(ji,jj) * wdrampu(ji,jj) 
     1197            ENDIF 
     1198            puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + (zdpdx1 + zdpdx2 - zpgu(ji,jj)) * umask(ji,jj,jk) 
    11511199         ENDIF 
    11521200 
    1153          ! integrate the pressure on the shallow side 
    1154          jk1 = jk 
    1155          DO WHILE ( -zdept(jis,jj,jk1) > zuijk ) 
    1156            IF( jk1 == mbku(ji,jj) ) THEN 
    1157              zuijk = -zdept(jis,jj,jk1) 
    1158              EXIT 
    1159            ENDIF 
    1160            zdeps = MIN(zdept(jis,jj,jk1+1), -zuijk) 
    1161            zpwes = zpwes +                                    & 
    1162                 integ_spline(zdept(jis,jj,jk1), zdeps,            & 
    1163                        asp(jis,jj,jk1),    bsp(jis,jj,jk1), & 
    1164                        csp(jis,jj,jk1),    dsp(jis,jj,jk1)) 
    1165            jk1 = jk1 + 1 
    1166          END DO 
    1167  
    1168          ! integrate the pressure on the deep side 
    1169          jk1 = jk 
    1170          DO WHILE ( -zdept(jid,jj,jk1) < zuijk ) 
    1171            IF( jk1 == 1 ) THEN 
    1172              zdeps = zdept(jid,jj,1) + MIN(zuijk, ssh(jid,jj,Kmm)*znad) 
    1173              zrhdt1 = zrhh(jid,jj,1) - interp3(zdept(jid,jj,1), asp(jid,jj,1), & 
    1174                                                bsp(jid,jj,1),   csp(jid,jj,1), & 
    1175                                                dsp(jid,jj,1)) * zdeps 
    1176              zpwed  = zpwed + 0.5_wp * (zrhh(jid,jj,1) + zrhdt1) * zdeps 
    1177              EXIT 
    1178            ENDIF 
    1179            zdeps = MAX(zdept(jid,jj,jk1-1), -zuijk) 
    1180            zpwed = zpwed +                                        & 
    1181                   integ_spline(zdeps,              zdept(jid,jj,jk1), & 
    1182                          asp(jid,jj,jk1-1), bsp(jid,jj,jk1-1),  & 
    1183                          csp(jid,jj,jk1-1), dsp(jid,jj,jk1-1) ) 
    1184            jk1 = jk1 - 1 
    1185          END DO 
    1186  
    1187          ! update the momentum trends in u direction 
    1188  
    1189          zdpdx1 = zcoef0 * r1_e1u(ji,jj) * ( zhpi(ji+1,jj,jk) - zhpi(ji,jj,jk) ) 
    1190          IF( .NOT.ln_linssh ) THEN 
    1191            zdpdx2 = zcoef0 * r1_e1u(ji,jj) * & 
    1192               &    ( REAL(jis-jid, wp) * (zpwes + zpwed) + (ssh(ji+1,jj,Kmm)-ssh(ji,jj,Kmm)) ) 
    1193           ELSE 
    1194            zdpdx2 = zcoef0 * r1_e1u(ji,jj) * REAL(jis-jid, wp) * (zpwes + zpwed) 
     1201         !!!!!     for v equation 
     1202         IF( jk <= mbkv(ji,jj) ) THEN 
     1203            IF( -zdept(ji,jj+1,jk) >= -zdept(ji,jj,jk) ) THEN 
     1204               jjs = jj + 1; jjd = jj 
     1205            ELSE 
     1206               jjs = jj    ; jjd = jj + 1 
     1207            ENDIF 
     1208 
     1209            ! integrate the pressure on the shallow side 
     1210            jk1 = jk 
     1211            DO WHILE ( -zdept(ji,jjs,jk1) > zvijk ) 
     1212               IF( jk1 == mbkv(ji,jj) ) THEN 
     1213                  zvijk = -zdept(ji,jjs,jk1) 
     1214                  EXIT 
     1215               ENDIF 
     1216               zdeps = MIN(zdept(ji,jjs,jk1+1), -zvijk) 
     1217               zpnss = zpnss +                                       & 
     1218                  integ_spline(zdept(ji,jjs,jk1), zdeps,             & 
     1219                               asp(ji,jjs,jk1),   bsp(ji,jjs,jk1),   & 
     1220                               csp(ji,jjs,jk1),   dsp(ji,jjs,jk1) ) 
     1221              jk1 = jk1 + 1 
     1222            END DO 
     1223 
     1224            ! integrate the pressure on the deep side 
     1225            jk1 = jk 
     1226            DO WHILE ( -zdept(ji,jjd,jk1) < zvijk ) 
     1227               IF( jk1 == 1 ) THEN 
     1228                  zdeps = zdept(ji,jjd,1) + MIN(zvijk, ssh(ji,jjd,Kmm)*znad) 
     1229                  zrhdt1 = zrhh(ji,jjd,1) - interp3(zdept(ji,jjd,1), asp(ji,jjd,1), & 
     1230                                                    bsp(ji,jjd,1)  , csp(ji,jjd,1), & 
     1231                                                    dsp(ji,jjd,1) ) * zdeps 
     1232                  zpnsd  = zpnsd + 0.5_wp * (zrhh(ji,jjd,1) + zrhdt1) * zdeps 
     1233                  EXIT 
     1234               ENDIF 
     1235               zdeps = MAX(zdept(ji,jjd,jk1-1), -zvijk) 
     1236               zpnsd = zpnsd +                                        & 
     1237                  integ_spline(zdeps,             zdept(ji,jjd,jk1),  & 
     1238                               asp(ji,jjd,jk1-1), bsp(ji,jjd,jk1-1),  & 
     1239                               csp(ji,jjd,jk1-1), dsp(ji,jjd,jk1-1) ) 
     1240               jk1 = jk1 - 1 
     1241            END DO 
     1242 
     1243            ! update the momentum trends in v direction 
     1244            zdpdy1 = zcoef0 * r1_e2v(ji,jj) * ( zhpi(ji,jj+1,jk) - zhpi(ji,jj,jk) ) 
     1245            IF( .NOT.ln_linssh ) THEN 
     1246               zdpdy2 = zcoef0 * r1_e2v(ji,jj) * & 
     1247                       ( REAL(jjs-jjd, wp) * (zpnss + zpnsd) + (ssh(ji,jj+1,Kmm)-ssh(ji,jj,Kmm)) ) 
     1248            ELSE 
     1249               zdpdy2 = zcoef0 * r1_e2v(ji,jj) * REAL(jjs-jjd, wp) * (zpnss + zpnsd ) 
     1250            ENDIF 
     1251            IF( ln_wd_il ) THEN 
     1252               zdpdy1 = zdpdy1 * zcpy(ji,jj) * wdrampv(ji,jj) 
     1253               zdpdy2 = zdpdy2 * zcpy(ji,jj) * wdrampv(ji,jj) 
     1254            ENDIF 
     1255 
     1256            pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + (zdpdy1 + zdpdy2 - zpgv(ji,jj)) * vmask(ji,jj,jk) 
    11951257         ENDIF 
    1196          IF( ln_wd_il ) THEN 
    1197             zdpdx1 = zdpdx1 * zcpx(ji,jj) * wdrampu(ji,jj) 
    1198             zdpdx2 = zdpdx2 * zcpx(ji,jj) * wdrampu(ji,jj) 
    1199          ENDIF 
    1200          puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + (zdpdx1 + zdpdx2 - zpgu(ji,jj)) * umask(ji,jj,jk)  
    1201       ENDIF 
    1202  
    1203       !!!!!     for v equation 
    1204       IF( jk <= mbkv(ji,jj) ) THEN 
    1205          IF( -zdept(ji,jj+1,jk) >= -zdept(ji,jj,jk) ) THEN 
    1206            jjs = jj + 1; jjd = jj 
    1207          ELSE 
    1208            jjs = jj    ; jjd = jj + 1 
    1209          ENDIF 
    1210  
    1211          ! integrate the pressure on the shallow side 
    1212          jk1 = jk 
    1213          DO WHILE ( -zdept(ji,jjs,jk1) > zvijk ) 
    1214            IF( jk1 == mbkv(ji,jj) ) THEN 
    1215              zvijk = -zdept(ji,jjs,jk1) 
    1216              EXIT 
    1217            ENDIF 
    1218            zdeps = MIN(zdept(ji,jjs,jk1+1), -zvijk) 
    1219            zpnss = zpnss +                                      & 
    1220                   integ_spline(zdept(ji,jjs,jk1), zdeps,            & 
    1221                          asp(ji,jjs,jk1),    bsp(ji,jjs,jk1), & 
    1222                          csp(ji,jjs,jk1),    dsp(ji,jjs,jk1) ) 
    1223            jk1 = jk1 + 1 
    1224          END DO 
    1225  
    1226          ! integrate the pressure on the deep side 
    1227          jk1 = jk 
    1228          DO WHILE ( -zdept(ji,jjd,jk1) < zvijk ) 
    1229            IF( jk1 == 1 ) THEN 
    1230              zdeps = zdept(ji,jjd,1) + MIN(zvijk, ssh(ji,jjd,Kmm)*znad) 
    1231              zrhdt1 = zrhh(ji,jjd,1) - interp3(zdept(ji,jjd,1), asp(ji,jjd,1), & 
    1232                                                bsp(ji,jjd,1),   csp(ji,jjd,1), & 
    1233                                                dsp(ji,jjd,1) ) * zdeps 
    1234              zpnsd  = zpnsd + 0.5_wp * (zrhh(ji,jjd,1) + zrhdt1) * zdeps 
    1235              EXIT 
    1236            ENDIF 
    1237            zdeps = MAX(zdept(ji,jjd,jk1-1), -zvijk) 
    1238            zpnsd = zpnsd +                                        & 
    1239                   integ_spline(zdeps,              zdept(ji,jjd,jk1), & 
    1240                          asp(ji,jjd,jk1-1), bsp(ji,jjd,jk1-1), & 
    1241                          csp(ji,jjd,jk1-1), dsp(ji,jjd,jk1-1) ) 
    1242            jk1 = jk1 - 1 
    1243          END DO 
    1244  
    1245  
    1246          ! update the momentum trends in v direction 
    1247  
    1248          zdpdy1 = zcoef0 * r1_e2v(ji,jj) * ( zhpi(ji,jj+1,jk) - zhpi(ji,jj,jk) ) 
    1249          IF( .NOT.ln_linssh ) THEN 
    1250             zdpdy2 = zcoef0 * r1_e2v(ji,jj) * & 
    1251                     ( REAL(jjs-jjd, wp) * (zpnss + zpnsd) + (ssh(ji,jj+1,Kmm)-ssh(ji,jj,Kmm)) ) 
    1252          ELSE 
    1253             zdpdy2 = zcoef0 * r1_e2v(ji,jj) * REAL(jjs-jjd, wp) * (zpnss + zpnsd ) 
    1254          ENDIF 
    1255          IF( ln_wd_il ) THEN 
    1256             zdpdy1 = zdpdy1 * zcpy(ji,jj) * wdrampv(ji,jj)  
    1257             zdpdy2 = zdpdy2 * zcpy(ji,jj) * wdrampv(ji,jj)  
    1258          ENDIF 
    1259  
    1260          pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + (zdpdy1 + zdpdy2 - zpgv(ji,jj)) * vmask(ji,jj,jk) 
    1261       ENDIF 
    12621258         ! 
    12631259      END_3D 
    … …  
    12781274      !! Reference: CJC Kruger, Constrained Cubic Spline Interpoltation 
    12791275      !!---------------------------------------------------------------------- 
    1280       REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   fsp, xsp           ! value and coordinate 
    1281       REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   asp, bsp, csp, dsp ! coefficients of the interpoated function 
    1282       INTEGER                   , INTENT(in   ) ::   polynomial_type    ! 1: cubic spline   ;   2: Linear 
     1276      REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(in   ) ::   fsp, xsp           ! value and coordinate 
     1277      REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(  out) ::   asp, bsp, csp, dsp ! coefficients of the interpoated function 
     1278      INTEGER                             , INTENT(in   ) ::   polynomial_type    ! 1: cubic spline   ;   2: Linear 
    12831279      ! 
    12841280      INTEGER  ::   ji, jj, jk                 ! dummy loop indices 
    1285       INTEGER  ::   jpi, jpj, jpkm1 
    12861281      REAL(wp) ::   zdf1, zdf2, zddf1, zddf2, ztmp1, ztmp2, zdxtmp 
    12871282      REAL(wp) ::   zdxtmp1, zdxtmp2, zalpha 
    1288       REAL(wp) ::   zdf(size(fsp,3)) 
    1289       !!---------------------------------------------------------------------- 
    1290       ! 
    1291 !!gm  WHAT !!!!!   THIS IS VERY DANGEROUS !!!!!   
    1292       jpi   = size(fsp,1) 
    1293       jpj   = size(fsp,2) 
    1294       jpkm1 = MAX( 1, size(fsp,3) - 1 ) 
     1283      REAL(wp) ::   zdf(jpk) 
     1284      !!---------------------------------------------------------------------- 
    12951285      ! 
    12961286      IF (polynomial_type == 1) THEN     ! Constrained Cubic Spline 
    1297          DO ji = 1, jpi 
    1298             DO jj = 1, jpj 
    1299            !!Fritsch&Butland's method, 1984 (preferred, but more computation) 
    1300            !    DO jk = 2, jpkm1-1 
    1301            !       zdxtmp1 = xsp(ji,jj,jk)   - xsp(ji,jj,jk-1) 
    1302            !       zdxtmp2 = xsp(ji,jj,jk+1) - xsp(ji,jj,jk) 
    1303            !       zdf1    = ( fsp(ji,jj,jk)   - fsp(ji,jj,jk-1) ) / zdxtmp1 
    1304            !       zdf2    = ( fsp(ji,jj,jk+1) - fsp(ji,jj,jk)   ) / zdxtmp2 
    1305            ! 
    1306            !       zalpha = ( zdxtmp1 + 2._wp * zdxtmp2 ) / ( zdxtmp1 + zdxtmp2 ) / 3._wp 
    1307            ! 
    1308            !       IF(zdf1 * zdf2 <= 0._wp) THEN 
    1309            !           zdf(jk) = 0._wp 
    1310            !       ELSE 
    1311            !         zdf(jk) = zdf1 * zdf2 / ( ( 1._wp - zalpha ) * zdf1 + zalpha * zdf2 ) 
    1312            !       ENDIF 
    1313            !    END DO 
    1314  
    1315            !!Simply geometric average 
    1316                DO jk = 2, jpkm1-1 
    1317                   zdf1 = (fsp(ji,jj,jk  ) - fsp(ji,jj,jk-1)) / (xsp(ji,jj,jk  ) - xsp(ji,jj,jk-1)) 
    1318                   zdf2 = (fsp(ji,jj,jk+1) - fsp(ji,jj,jk  )) / (xsp(ji,jj,jk+1) - xsp(ji,jj,jk  )) 
    1319  
    1320                   IF(zdf1 * zdf2 <= 0._wp) THEN 
    1321                      zdf(jk) = 0._wp 
    1322                   ELSE 
    1323                      zdf(jk) = 2._wp * zdf1 * zdf2 / (zdf1 + zdf2) 
    1324                   ENDIF 
    1325                END DO 
    1326  
    1327                zdf(1)     = 1.5_wp * ( fsp(ji,jj,2) - fsp(ji,jj,1) ) / & 
    1328                           &          ( xsp(ji,jj,2) - xsp(ji,jj,1) )           -  0.5_wp * zdf(2) 
    1329                zdf(jpkm1) = 1.5_wp * ( fsp(ji,jj,jpkm1) - fsp(ji,jj,jpkm1-1) ) / & 
    1330                           &          ( xsp(ji,jj,jpkm1) - xsp(ji,jj,jpkm1-1) ) - 0.5_wp * zdf(jpkm1 - 1) 
    1331  
    1332                DO jk = 1, jpkm1 - 1 
    1333                  zdxtmp = xsp(ji,jj,jk+1) - xsp(ji,jj,jk) 
    1334                  ztmp1  = (zdf(jk+1) + 2._wp * zdf(jk)) / zdxtmp 
    1335                  ztmp2  =  6._wp * (fsp(ji,jj,jk+1) - fsp(ji,jj,jk)) / zdxtmp / zdxtmp 
    1336                  zddf1  = -2._wp * ztmp1 + ztmp2 
    1337                  ztmp1  = (2._wp * zdf(jk+1) + zdf(jk)) / zdxtmp 
    1338                  zddf2  =  2._wp * ztmp1 - ztmp2 
    1339  
    1340                  dsp(ji,jj,jk) = (zddf2 - zddf1) / 6._wp / zdxtmp 
    1341                  csp(ji,jj,jk) = ( xsp(ji,jj,jk+1) * zddf1 - xsp(ji,jj,jk)*zddf2 ) / 2._wp / zdxtmp 
    1342                  bsp(ji,jj,jk) = ( fsp(ji,jj,jk+1) - fsp(ji,jj,jk) ) / zdxtmp - & 
    1343                                & csp(ji,jj,jk) * ( xsp(ji,jj,jk+1) + xsp(ji,jj,jk) ) - & 
    1344                                & dsp(ji,jj,jk) * ((xsp(ji,jj,jk+1) + xsp(ji,jj,jk))**2 - & 
    1345                                &                   xsp(ji,jj,jk+1) * xsp(ji,jj,jk)) 
    1346                  asp(ji,jj,jk) = fsp(ji,jj,jk) - xsp(ji,jj,jk) * (bsp(ji,jj,jk) + & 
    1347                                &                (xsp(ji,jj,jk) * (csp(ji,jj,jk) + & 
    1348                                &                 dsp(ji,jj,jk) * xsp(ji,jj,jk)))) 
    1349                END DO 
     1287         DO_2D( 1, 1, 1, 1 ) 
     1288            !!Fritsch&Butland's method, 1984 (preferred, but more computation) 
     1289            !    DO jk = 2, jpkm1-1 
     1290            !       zdxtmp1 = xsp(ji,jj,jk)   - xsp(ji,jj,jk-1) 
     1291            !       zdxtmp2 = xsp(ji,jj,jk+1) - xsp(ji,jj,jk) 
     1292            !       zdf1    = ( fsp(ji,jj,jk)   - fsp(ji,jj,jk-1) ) / zdxtmp1 
     1293            !       zdf2    = ( fsp(ji,jj,jk+1) - fsp(ji,jj,jk)   ) / zdxtmp2 
     1294            ! 
     1295            !       zalpha = ( zdxtmp1 + 2._wp * zdxtmp2 ) / ( zdxtmp1 + zdxtmp2 ) / 3._wp 
     1296            ! 
     1297            !       IF(zdf1 * zdf2 <= 0._wp) THEN 
     1298            !           zdf(jk) = 0._wp 
     1299            !       ELSE 
     1300            !         zdf(jk) = zdf1 * zdf2 / ( ( 1._wp - zalpha ) * zdf1 + zalpha * zdf2 ) 
     1301            !       ENDIF 
     1302            !    END DO 
     1303 
     1304            !!Simply geometric average 
     1305            DO jk = 2, jpk-2 
     1306               zdf1 = (fsp(ji,jj,jk  ) - fsp(ji,jj,jk-1)) / (xsp(ji,jj,jk  ) - xsp(ji,jj,jk-1)) 
     1307               zdf2 = (fsp(ji,jj,jk+1) - fsp(ji,jj,jk  )) / (xsp(ji,jj,jk+1) - xsp(ji,jj,jk  )) 
     1308 
     1309               IF(zdf1 * zdf2 <= 0._wp) THEN 
     1310                  zdf(jk) = 0._wp 
     1311               ELSE 
     1312                  zdf(jk) = 2._wp * zdf1 * zdf2 / (zdf1 + zdf2) 
     1313               ENDIF 
    13501314            END DO 
    1351          END DO 
     1315 
     1316            zdf(1)     = 1.5_wp * ( fsp(ji,jj,2) - fsp(ji,jj,1) ) / & 
     1317                       &          ( xsp(ji,jj,2) - xsp(ji,jj,1) )           -  0.5_wp * zdf(2) 
     1318            zdf(jpkm1) = 1.5_wp * ( fsp(ji,jj,jpkm1) - fsp(ji,jj,jpkm1-1) ) / & 
     1319                       &          ( xsp(ji,jj,jpkm1) - xsp(ji,jj,jpkm1-1) ) - 0.5_wp * zdf(jpk - 2) 
     1320 
     1321            DO jk = 1, jpk-2 
     1322               zdxtmp = xsp(ji,jj,jk+1) - xsp(ji,jj,jk) 
     1323               ztmp1  = (zdf(jk+1) + 2._wp * zdf(jk)) / zdxtmp 
     1324               ztmp2  =  6._wp * (fsp(ji,jj,jk+1) - fsp(ji,jj,jk)) / zdxtmp / zdxtmp 
     1325               zddf1  = -2._wp * ztmp1 + ztmp2 
     1326               ztmp1  = (2._wp * zdf(jk+1) + zdf(jk)) / zdxtmp 
     1327               zddf2  =  2._wp * ztmp1 - ztmp2 
     1328 
     1329               dsp(ji,jj,jk) = (zddf2 - zddf1) / 6._wp / zdxtmp 
     1330               csp(ji,jj,jk) = ( xsp(ji,jj,jk+1) * zddf1 - xsp(ji,jj,jk)*zddf2 ) / 2._wp / zdxtmp 
     1331               bsp(ji,jj,jk) = ( fsp(ji,jj,jk+1) - fsp(ji,jj,jk) ) / zdxtmp - & 
     1332                             & csp(ji,jj,jk) * ( xsp(ji,jj,jk+1) + xsp(ji,jj,jk) ) - & 
     1333                             & dsp(ji,jj,jk) * ((xsp(ji,jj,jk+1) + xsp(ji,jj,jk))**2 - & 
     1334                             &                   xsp(ji,jj,jk+1) * xsp(ji,jj,jk)) 
     1335               asp(ji,jj,jk) = fsp(ji,jj,jk) - xsp(ji,jj,jk) * (bsp(ji,jj,jk) + & 
     1336                             &                (xsp(ji,jj,jk) * (csp(ji,jj,jk) + & 
     1337                             &                 dsp(ji,jj,jk) * xsp(ji,jj,jk)))) 
     1338            END DO 
     1339         END_2D 
    13521340 
    13531341      ELSEIF ( polynomial_type == 2 ) THEN     ! Linear 
    1354          DO ji = 1, jpi 
    1355             DO jj = 1, jpj 
    1356                DO jk = 1, jpkm1-1 
    1357                   zdxtmp =xsp(ji,jj,jk+1) - xsp(ji,jj,jk) 
    1358                   ztmp1 = fsp(ji,jj,jk+1) - fsp(ji,jj,jk) 
    1359  
    1360                   dsp(ji,jj,jk) = 0._wp 
    1361                   csp(ji,jj,jk) = 0._wp 
    1362                   bsp(ji,jj,jk) = ztmp1 / zdxtmp 
    1363                   asp(ji,jj,jk) = fsp(ji,jj,jk) - bsp(ji,jj,jk) * xsp(ji,jj,jk) 
    1364                END DO 
    1365             END DO 
    1366          END DO 
     1342         DO_3D( 1, 1, 1, 1, 1, jpk-2 ) 
     1343            zdxtmp =xsp(ji,jj,jk+1) - xsp(ji,jj,jk) 
     1344            ztmp1 = fsp(ji,jj,jk+1) - fsp(ji,jj,jk) 
     1345 
     1346            dsp(ji,jj,jk) = 0._wp 
     1347            csp(ji,jj,jk) = 0._wp 
     1348            bsp(ji,jj,jk) = ztmp1 / zdxtmp 
     1349            asp(ji,jj,jk) = fsp(ji,jj,jk) - bsp(ji,jj,jk) * xsp(ji,jj,jk) 
     1350         END_3D 
    13671351         ! 
    13681352      ELSE 

  • NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/DYN/dynkeg.F90

    r14776 r14805  
    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( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
     113         DO_3D( 0, nn_hls-1, 0, nn_hls-1, 1, jpkm1 ) 
    112114            ! round brackets added to fix the order of floating point operations 
    113115            ! needed to ensure halo 1 - halo 2 compatibility 
    … …  
    121123               &         + pvv(ji  ,jj  ,jk,Kmm) * pvv(ji  ,jj  ,jk,Kmm) )  & 
    122124               &  +      ( ( 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) )  & 
    123                &  +        ( pvv(ji-1,jj  ,jk,Kmm) + pvv(ji+1,jj  ,jk,Kmm) ) * ( pvv(ji-1,jj  ,jk,Kmm) + pvv(ji+1,jj  ,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) )  & 
    124126               &         )                                                               ! bracket for halo 1 - halo 2 compatibility 
    125127            zhke(ji,jj,jk) = r1_48 * ( zv + zu ) 

  • NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/DYN/dynldf_iso.F90

    r14776 r14805  
    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   ! 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( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 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          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 ) 
     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_r14273_HPC-02_Daley_Tiling/src/OCE/DYN/dynldf_lap_blp.F90

    r14776 r14805  
    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      CALL dyn_ldf_lap_t( kt, Kbb, Kmm, pu, pv, is_tile(pu), pu_rhs, pv_rhs, is_tile(pu_rhs), kpass ) 
     53   END SUBROUTINE dyn_ldf_lap 
     54 
     55 
     56   SUBROUTINE dyn_ldf_lap_t( kt, Kbb, Kmm, pu, pv, ktuv, pu_rhs, pv_rhs, ktuv_rhs, kpass ) 
    4157      !!---------------------------------------------------------------------- 
    4258      !!                     ***  ROUTINE dyn_ldf_lap  *** 
    … …  
    5268      !! Reference : S.Griffies, R.Hallberg 2000 Mon.Wea.Rev., DOI:/  
    5369      !!---------------------------------------------------------------------- 
    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] 
     70      INTEGER                                 , INTENT(in   ) ::   kt               ! ocean time-step index 
     71      INTEGER                                 , INTENT(in   ) ::   Kbb, Kmm         ! ocean time level indices 
     72      INTEGER                                 , INTENT(in   ) ::   kpass            ! =1/2 first or second passage 
     73      INTEGER                                 , INTENT(in   ) ::   ktuv, ktuv_rhs 
     74      REAL(wp), DIMENSION(A2D_T(ktuv)    ,JPK), INTENT(in   ) ::   pu, pv           ! before velocity  [m/s] 
     75      REAL(wp), DIMENSION(A2D_T(ktuv_rhs),JPK), INTENT(inout) ::   pu_rhs, pv_rhs   ! velocity trend   [m/s2] 
    5976      ! 
    6077      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     78      INTEGER  ::   iij 
    6179      REAL(wp) ::   zsign        ! local scalars 
    6280      REAL(wp) ::   zua, zva     ! local scalars 
    … …  
    6583      !!---------------------------------------------------------------------- 
    6684      ! 
    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,*) '~~~~~~~ ' 
     85#if defined key_loop_fusion 
     86      CALL dyn_ldf_lap_lf( kt, Kbb, Kmm, pu, pv, pu_rhs, pv_rhs, kpass ) 
     87#else 
     88      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     89         IF( kt == nit000 .AND. lwp ) THEN 
     90            WRITE(numout,*) 
     91            WRITE(numout,*) 'dyn_ldf : iso-level harmonic (laplacian) operator, pass=', kpass 
     92            WRITE(numout,*) '~~~~~~~ ' 
     93         ENDIF 
     94      ENDIF 
     95      ! 
     96      ! Define pu_rhs/pv_rhs halo points for multi-point haloes in bilaplacian case 
     97      IF( nldf_dyn == np_blp .AND. kpass == 1 ) THEN ; iij = nn_hls 
     98      ELSE                                           ; iij = 1 
    7199      ENDIF 
    72100      ! 
    … …  
    79107      CASE ( np_typ_rot )       !==  Vorticity-Divergence operator  ==! 
    80108         ! 
    81          ALLOCATE( zcur(jpi,jpj) , zdiv(jpi,jpj) ) 
     109         ALLOCATE( zcur(A2D(nn_hls)) , zdiv(A2D(nn_hls)) ) 
    82110         ! 
    83111         DO jk = 1, jpkm1                                 ! Horizontal slab 
    84112            ! 
    85             DO_2D( nn_hls-1, nn_hls, nn_hls-1, nn_hls ) 
     113            DO_2D( iij-1, iij, iij-1, iij ) 
    86114               !                                      ! ahm * e3 * curl  (computed from 1 to jpim1/jpjm1) 
    87115               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 
    … …  
    94122            END_2D 
    95123            ! 
    96             DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )                       ! - curl( curl) + grad( div ) 
     124            DO_2D( iij-1, iij-1, iij-1, iij-1 )   ! - curl( curl) + grad( div ) 
    97125               pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * umask(ji,jj,jk) * (    &    ! * by umask is mandatory for dyn_ldf_blp use 
    98126                  &              - ( zcur(ji  ,jj) - zcur(ji,jj-1) ) * r1_e2u(ji,jj) / e3u(ji,jj,jk,Kmm)   & 
    … …  
    110138      CASE ( np_typ_sym )       !==  Symmetric operator  ==! 
    111139         ! 
    112          ALLOCATE( zten(jpi,jpj) , zshe(jpi,jpj) ) 
     140         ALLOCATE( zten(A2D(nn_hls)) , zshe(A2D(nn_hls)) ) 
    113141         ! 
    114142         DO jk = 1, jpkm1                                 ! Horizontal slab 
    115143            ! 
    116             DO_2D( nn_hls-1, nn_hls, nn_hls-1, nn_hls ) 
     144            DO_2D( iij-1, iij, iij-1, iij ) 
    117145               !                                      ! shearing stress component (F-point)   NB : ahmf has already been multiplied by fmask 
    118146               zshe(ji-1,jj-1) = ahmf(ji-1,jj-1,jk)                                                              & 
    … …  
    129157            END_2D 
    130158            ! 
    131             DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     159            DO_2D( iij-1, iij-1, iij-1, iij-1 ) 
    132160               pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm)                               & 
    133161                  &    * (   (   zten(ji+1,jj  ) * e2t(ji+1,jj  )*e2t(ji+1,jj  ) * e3t(ji+1,jj  ,jk,Kmm)                       & 
    … …  
    150178      END SELECT 
    151179      ! 
    152    END SUBROUTINE dyn_ldf_lap 
     180#endif 
     181   END SUBROUTINE dyn_ldf_lap_t 
    153182 
    154183 
    … …  
    171200      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu_rhs, pv_rhs   ! momentum trend 
    172201      ! 
    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,*) '~~~~~~~~~~~~' 
     202      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zulap, zvlap   ! laplacian at u- and v-point 
     203      !!---------------------------------------------------------------------- 
     204      ! 
     205#if defined key_loop_fusion 
     206      CALL dyn_ldf_blp_lf( kt, Kbb, Kmm, pu, pv, pu_rhs, pv_rhs ) 
     207#else 
     208      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     209         IF( kt == nit000 )  THEN 
     210            IF(lwp) WRITE(numout,*) 
     211            IF(lwp) WRITE(numout,*) 'dyn_ldf_blp : bilaplacian operator momentum ' 
     212            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 
     213         ENDIF 
    180214      ENDIF 
    181215      ! 
    … …  
    189223      CALL dyn_ldf_lap( kt, Kbb, Kmm, zulap, zvlap, pu_rhs, pv_rhs, 2 )   ! rotated laplacian applied to zlap (output in pt(:,:,:,:,Krhs)) 
    190224      ! 
     225#endif 
    191226   END SUBROUTINE dyn_ldf_blp 
    192227 

  • NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/DYN/dynvor.F90

    r14776 r14805  
    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 
    258260            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    … …  
    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      ! 
    … …  
    632657         CASE ( 0 )                                   ! original formulation  (masked averaging of e3t divided by 4) 
    633658            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    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)  ) 
     659               ! NOTE: [halo1-halo2] brackets added to make results independent of nn_hls 
     660               ze3f = (  (e3t(ji  ,jj+1,jk,Kmm)*tmask(ji  ,jj+1,jk)    & 
     661                  &    +  e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk))   & 
     662                  &    + (e3t(ji  ,jj  ,jk,Kmm)*tmask(ji  ,jj  ,jk)    & 
     663                  &    +  e3t(ji+1,jj  ,jk,Kmm)*tmask(ji+1,jj  ,jk))  ) 
    638664               IF( ze3f /= 0._wp ) THEN   ;   z1_e3f(ji,jj) = 4._wp / ze3f 
    639665               ELSE                       ;   z1_e3f(ji,jj) = 0._wp 
    … …  
    642668         CASE ( 1 )                                   ! new formulation  (masked averaging of e3t divided by the sum of mask) 
    643669            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    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               ! NOTE: [halo1-halo2] brackets added to make results independent of nn_hls 
     671               ze3f = (  (e3t(ji  ,jj+1,jk,Kmm)*tmask(ji  ,jj+1,jk)    & 
     672                  &    +  e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk))   & 
     673                  &    + (e3t(ji  ,jj  ,jk,Kmm)*tmask(ji  ,jj  ,jk)    & 
     674                  &    +  e3t(ji+1,jj  ,jk,Kmm)*tmask(ji+1,jj  ,jk))  ) 
    648675               zmsk = (                    tmask(ji,jj+1,jk) +                     tmask(ji+1,jj+1,jk)   & 
    649676                  &                      + tmask(ji,jj  ,jk) +                     tmask(ji+1,jj  ,jk)  ) 
    … …  
    706733      ! 
    707734      !                                                ! =============== 
    708       DO jk = 1, jpkm1                                 ! Horizontal slab 
    709          !                                             ! =============== 
    710          ! 
     735      !                                                ! Horizontal slab 
     736      !                                                ! =============== 
     737#if defined key_loop_fusion 
     738      DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
    711739         !                                   !==  horizontal fluxes  ==! 
    712          zwx(:,:) = e2u(:,:) * e3u(:,:,jk,Kmm) * pu(:,:,jk) 
    713          zwy(:,:) = e1v(:,:) * e3v(:,:,jk,Kmm) * pv(:,:,jk) 
     740         zwx         = e2u(ji  ,jj  ) * e3u(ji  ,jj  ,jk,Kmm) * pu(ji  ,jj  ,jk) 
     741         zwx_im1     = e2u(ji-1,jj  ) * e3u(ji-1,jj  ,jk,Kmm) * pu(ji-1,jj  ,jk) 
     742         zwx_jp1     = e2u(ji  ,jj+1) * e3u(ji  ,jj+1,jk,Kmm) * pu(ji  ,jj+1,jk) 
     743         zwx_im1_jp1 = e2u(ji-1,jj+1) * e3u(ji-1,jj+1,jk,Kmm) * pu(ji-1,jj+1,jk) 
     744         zwy         = e1v(ji  ,jj  ) * e3v(ji  ,jj  ,jk,Kmm) * pv(ji  ,jj  ,jk) 
     745         zwy_ip1     = e1v(ji+1,jj  ) * e3v(ji+1,jj  ,jk,Kmm) * pv(ji+1,jj  ,jk) 
     746         zwy_jm1     = e1v(ji  ,jj-1) * e3v(ji  ,jj-1,jk,Kmm) * pv(ji  ,jj-1,jk) 
     747         zwy_ip1_jm1 = e1v(ji+1,jj-1) * e3v(ji+1,jj-1,jk,Kmm) * pv(ji+1,jj-1,jk) 
     748         !                                   !==  compute and add the vorticity term trend  =! 
     749         ztne     = zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk) 
     750         ztnw     = zwz(ji-1,jj-1,jk) + zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) 
     751         ztnw_ip1 = zwz(ji  ,jj-1,jk) + zwz(ji  ,jj  ,jk) + zwz(ji+1,jj  ,jk) 
     752         ztse     = zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk) + zwz(ji-1,jj-1,jk) 
     753         ztse_jp1 = zwz(ji  ,jj+1,jk) + zwz(ji  ,jj  ,jk) + zwz(ji-1,jj  ,jk) 
     754         ztsw_jp1 = zwz(ji  ,jj  ,jk) + zwz(ji-1,jj  ,jk) + zwz(ji-1,jj+1,jk) 
     755         ztsw_ip1 = zwz(ji+1,jj-1,jk) + zwz(ji  ,jj-1,jk) + zwz(ji  ,jj  ,jk) 
     756         ! 
     757         zua = + r1_12 * r1_e1u(ji,jj) * (  ztne * zwy + ztnw_ip1 * zwy_ip1   & 
     758            &                             + ztse * zwy_jm1 + ztsw_ip1 * zwy_ip1_jm1 ) 
     759         zva = - r1_12 * r1_e2v(ji,jj) * (  ztsw_jp1 * zwx_im1_jp1 + ztse_jp1 * zwx_jp1   & 
     760            &                             + ztnw * zwx_im1 + ztne * zwx ) 
     761         pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zua 
     762         pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) + zva 
     763      END_3D 
     764#else 
     765      DO jk = 1, jpkm1 
     766         ! 
     767         !                                   !==  horizontal fluxes  ==! 
     768         DO_2D( 1, 1, 1, 1 ) 
     769            zwx(ji,jj) = e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * pu(ji,jj,jk) 
     770            zwy(ji,jj) = e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * pv(ji,jj,jk) 
     771         END_2D 
    714772         ! 
    715773         !                                   !==  compute and add the vorticity term trend  =! 
    … …  
    729787            pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) + zva 
    730788         END_2D 
    731          !                                             ! =============== 
    732       END DO                                           !   End of slab 
     789      END DO 
     790#endif 
     791         !                                             ! =============== 
     792         !                                             !   End of slab 
    733793      !                                                ! =============== 
    734794   END SUBROUTINE vor_een 
    … …  
    762822      REAL(wp) ::   zua, zva       ! local scalars 
    763823      REAL(wp) ::   zmsk, z1_e3t   ! local scalars 
    764       REAL(wp), DIMENSION(jpi,jpj)       ::   zwx , zwy 
    765       REAL(wp), DIMENSION(jpi,jpj)       ::   ztnw, ztne, ztsw, ztse 
    766       REAL(wp), DIMENSION(jpi,jpj,jpkm1) ::   zwz   ! 3D workspace, avoid lbc_lnk on jpk that is not defined 
    767       !!---------------------------------------------------------------------- 
    768       ! 
    769       IF( kt == nit000 ) THEN 
    770          IF(lwp) WRITE(numout,*) 
    771          IF(lwp) WRITE(numout,*) 'dyn:vor_eeT : vorticity term: energy and enstrophy conserving scheme' 
    772          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
     824      REAL(wp), DIMENSION(A2D(nn_hls))       ::   zwx , zwy 
     825      REAL(wp), DIMENSION(A2D(nn_hls))       ::   ztnw, ztne, ztsw, ztse 
     826      REAL(wp), DIMENSION(A2D(nn_hls),jpkm1) ::   zwz   ! 3D workspace, avoid lbc_lnk on jpk that is not defined 
     827      !!---------------------------------------------------------------------- 
     828      ! 
     829      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     830         IF( kt == nit000 ) THEN 
     831            IF(lwp) WRITE(numout,*) 
     832            IF(lwp) WRITE(numout,*) 'dyn:vor_eeT : vorticity term: energy and enstrophy conserving scheme' 
     833            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
     834         ENDIF 
    773835      ENDIF 
    774836      ! 
    … …  
    785847         CASE ( np_RVO )                           !* relative vorticity 
    786848            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    787                zwz(ji,jj,jk) = (  e2v(ji+1,jj  ) * pv(ji+1,jj  ,jk) - e2v(ji,jj) * pv(ji,jj,jk)    & 
    788                   &             - e1u(ji  ,jj+1) * pu(ji  ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) & 
     849               ! NOTE: [halo1-halo2] brackets added to make results independent of nn_hls 
     850               zwz(ji,jj,jk) = (  (e2v(ji+1,jj  ) * pv(ji+1,jj  ,jk) - e2v(ji,jj) * pv(ji,jj,jk))    & 
     851                  &             - (e1u(ji  ,jj+1) * pu(ji  ,jj+1,jk) - e1u(ji,jj) * pu(ji,jj,jk))  ) & 
    789852                  &          * r1_e1e2f(ji,jj) 
    790853            END_2D 
    … …  
    801864         CASE ( np_CRV )                           !* Coriolis + relative vorticity 
    802865            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    803                zwz(ji,jj,jk) = (  ff_f(ji,jj) + (  e2v(ji+1,jj  ) * pv(ji+1,jj  ,jk) - e2v(ji,jj) * pv(ji,jj,jk)    & 
    804                   &                              - e1u(ji  ,jj+1) * pu(ji  ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) & 
    805                   &                         * r1_e1e2f(ji,jj)    ) 
     866               ! NOTE: [halo1-halo2] brackets added to make results independent of nn_hls 
     867               zwz(ji,jj,jk) = (  ff_f(ji,jj) + (  (e2v(ji+1,jj  ) * pv(ji+1,jj  ,jk) - e2v(ji,jj) * pv(ji,jj,jk))    & 
     868                  &                              - (e1u(ji  ,jj+1) * pu(ji  ,jj+1,jk) - e1u(ji,jj) * pu(ji,jj,jk))  ) & 
     869                  &                           * r1_e1e2f(ji,jj)    ) 
    806870            END_2D 
    807871            IF( ln_dynvor_msk ) THEN                     ! mask the relative vorticity 
    … …  
    830894         ! 
    831895         !                                   !==  horizontal fluxes  ==! 
    832          zwx(:,:) = e2u(:,:) * e3u(:,:,jk,Kmm) * pu(:,:,jk) 
    833          zwy(:,:) = e1v(:,:) * e3v(:,:,jk,Kmm) * pv(:,:,jk) 
     896         DO_2D( 1, 1, 1, 1 ) 
     897            zwx(ji,jj) = e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * pu(ji,jj,jk) 
     898            zwy(ji,jj) = e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * pv(ji,jj,jk) 
     899         END_2D 
    834900         ! 
    835901         !                                   !==  compute and add the vorticity term trend  =! 

  • NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/DYN/dynzad.F90

    r14776 r14805  
    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( nn_hls-1, nn_hls, nn_hls-1, nn_hls )              ! 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 
    88          DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )              ! vertical momentum advection at w-point 
     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 
     92         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) ) 
    9094            zwvw(ji,jj,jk) = ( zww(ji  ,jj+1) + zww(ji,jj) ) * ( pvv(ji,jj,jk-1,Kmm) - pvv(ji,jj,jk,Kmm) ) 
    … …  
    9397      ! 
    9498      ! Surface and bottom advective fluxes set to zero 
    95       DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     99      DO_2D( 0, 0, 0, 0 ) 
    96100         zwuw(ji,jj, 1 ) = 0._wp 
    97101         zwvw(ji,jj, 1 ) = 0._wp 
    … …  
    100104      END_2D 
    101105      ! 
    102       DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )   ! Vertical momentum advection at u- and v-points 
     106      DO_3D( 0, 0, 0, 0, 1, jpkm1 )   ! Vertical momentum advection at u- and v-points 
    103107         puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj)   & 
    104108            &                                      / e3u(ji,jj,jk,Kmm) 

  • NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/DYN/dynzdf.F90

    r14776 r14805  
    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_r14273_HPC-02_Daley_Tiling/src/OCE/DYN/sshwzv.F90

    r14776 r14805  
    103103      ! 
    104104      zhdiv(:,:) = 0._wp 
    105       DO_3D( nn_hls-1, nn_hls, nn_hls-1, nn_hls, 1, jpkm1 )                                 ! Horizontal divergence of barotropic transports  
     105      DO_3D( 1, nn_hls, 1, nn_hls, 1, jpkm1 )                                 ! Horizontal divergence of barotropic transports 
    106106        zhdiv(ji,jj) = zhdiv(ji,jj) + e3t(ji,jj,jk,Kmm) * hdiv(ji,jj,jk) 
    107107      END_3D 
    … …  
    110110      ! compute the vertical velocity which can be used to compute the non-linear terms of the momentum equations. 
    111111      !  
    112       DO_2D( nn_hls-1, nn_hls, nn_hls-1, nn_hls ) 
     112      DO_2D_OVR( 1, nn_hls, 1, nn_hls )                ! Loop bounds limited by hdiv definition in div_hor 
    113113         pssh(ji,jj,Kaa) = (  pssh(ji,jj,Kbb) - rDt * ( zcoef * ( emp_b(ji,jj) + emp(ji,jj) ) + zhdiv(ji,jj) )  ) * ssmask(ji,jj) 
    114114      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 ) 
    115117      ! 
    116118#if defined key_agrif 
    … …  
    187189         !                             ! Is it problematic to have a wrong vertical velocity in boundary cells? 
    188190         !                             ! Same question holds for hdiv. Perhaps just for security 
    189          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 
    190192            ! computation of w 
    191             pww(:,:,jk) = pww(:,:,jk+1) - (   e3t(:,:,jk,Kmm) * hdiv(:,:,jk)   & 
    192                &                            +                  zhdiv(:,:,jk)   & 
    193                &                            + r1_Dt * (  e3t(:,:,jk,Kaa)       & 
    194                &                                       - e3t(:,:,jk,Kbb) )   ) * tmask(:,:,jk) 
    195          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 
    196198         !          IF( ln_vvl_layer ) pww(:,:,:) = 0.e0 
    197199         DEALLOCATE( zhdiv )  
    … …  
    199201      ELSEIF( ln_linssh )   THEN                      !==  linear free surface cases  ==! 
    200202         !                                            !=================================! 
    201          DO jk = jpkm1, 1, -1                               ! integrate from the bottom the hor. divergence 
    202             pww(:,:,jk) = pww(:,:,jk+1) - (  e3t(:,:,jk,Kmm) * hdiv(:,:,jk)  ) * tmask(:,:,jk) 
    203          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 
    204206         !                                            !==========================================! 
    205207      ELSE                                            !==  Quasi-Eulerian vertical coordinate  ==!   ('key_qco') 
    206208         !                                            !==========================================! 
    207          DO jk = jpkm1, 1, -1                               ! integrate from the bottom the hor. divergence 
    208             pww(:,:,jk) = pww(:,:,jk+1) - (  e3t(:,:,jk,Kmm) * hdiv(:,:,jk)                 & 
    209                &                            + r1_Dt * (  e3t(:,:,jk,Kaa)        & 
    210                &                                       - e3t(:,:,jk,Kbb)  )   ) * tmask(:,:,jk) 
    211          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 
    212214      ENDIF 
    213215 

  • NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/DYN/wet_dry.F90

    r14776 r14805  
    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_r14273_HPC-02_Daley_Tiling/src/OCE/IOM/iom.F90

    r14776 r14805  
    20142014      IF( iom_use(cdname) ) THEN 
    20152015#if defined key_xios 
    2016          CALL xios_send_field( cdname, pfield2d ) 
     2016         IF( is_tile(pfield2d) == 1 ) THEN 
     2017            CALL xios_send_field( cdname, pfield2d, ntile - 1 ) 
     2018         ELSE IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN 
     2019            CALL xios_send_field( cdname, pfield2d ) 
     2020         ENDIF 
    20172021#else 
    20182022         WRITE(numout,*) pfield2d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 
    … …  
    20262030      IF( iom_use(cdname) ) THEN 
    20272031#if defined key_xios 
    2028          CALL xios_send_field( cdname, pfield2d ) 
     2032         IF( is_tile(pfield2d) == 1 ) THEN 
     2033            CALL xios_send_field( cdname, pfield2d, ntile - 1 ) 
     2034         ELSE IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN 
     2035            CALL xios_send_field( cdname, pfield2d ) 
     2036         ENDIF 
    20292037#else 
    20302038         WRITE(numout,*) pfield2d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 
    … …  
    20382046      IF( iom_use(cdname) ) THEN 
    20392047#if defined key_xios 
    2040          CALL xios_send_field( cdname, pfield3d ) 
     2048         IF( is_tile(pfield3d) == 1 ) THEN 
     2049            CALL xios_send_field( cdname, pfield3d, ntile - 1 ) 
     2050         ELSE IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN 
     2051            CALL xios_send_field( cdname, pfield3d ) 
     2052         ENDIF 
    20412053#else 
    20422054         WRITE(numout,*) pfield3d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 
    … …  
    20502062      IF( iom_use(cdname) ) THEN 
    20512063#if defined key_xios 
    2052          CALL xios_send_field( cdname, pfield3d ) 
     2064         IF( is_tile(pfield3d) == 1 ) THEN 
     2065            CALL xios_send_field( cdname, pfield3d, ntile - 1 ) 
     2066         ELSE IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN 
     2067            CALL xios_send_field( cdname, pfield3d ) 
     2068         ENDIF 
    20532069#else 
    20542070         WRITE(numout,*) pfield3d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 
    … …  
    20622078      IF( iom_use(cdname) ) THEN 
    20632079#if defined key_xios 
    2064          CALL xios_send_field (cdname, pfield4d ) 
     2080         IF( is_tile(pfield4d) == 1 ) THEN 
     2081            CALL xios_send_field( cdname, pfield4d, ntile - 1 ) 
     2082         ELSE IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN 
     2083            CALL xios_send_field( cdname, pfield4d ) 
     2084         ENDIF 
    20652085#else 
    20662086         WRITE(numout,*) pfield4d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 
    … …  
    20742094      IF( iom_use(cdname) ) THEN 
    20752095#if defined key_xios 
    2076          CALL xios_send_field (cdname, pfield4d ) 
     2096         IF( is_tile(pfield4d) == 1 ) THEN 
     2097            CALL xios_send_field( cdname, pfield4d, ntile - 1 ) 
     2098         ELSE IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN 
     2099            CALL xios_send_field( cdname, pfield4d ) 
     2100         ENDIF 
    20772101#else 
    20782102         WRITE(numout,*) pfield4d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 
    … …  
    20882112   SUBROUTINE iom_set_domain_attr( cdid, ni_glo, nj_glo, ibegin, jbegin, ni, nj,                                               & 
    20892113      &                                    data_dim, data_ibegin, data_ni, data_jbegin, data_nj, lonvalue, latvalue, mask,     & 
     2114      &                                  ntiles, tile_ibegin, tile_jbegin, tile_ni, tile_nj,                                   & 
     2115      &                                  tile_data_ibegin, tile_data_jbegin, tile_data_ni, tile_data_nj,                       & 
    20902116      &                                    nvertex, bounds_lon, bounds_lat, area ) 
    20912117      !!---------------------------------------------------------------------- 
    … …  
    20932119      CHARACTER(LEN=*)                  , INTENT(in) ::   cdid 
    20942120      INTEGER                 , OPTIONAL, INTENT(in) ::   ni_glo, nj_glo, ibegin, jbegin, ni, nj 
     2121      INTEGER,  DIMENSION(:)  , OPTIONAL, INTENT(in) ::   tile_ibegin, tile_jbegin, tile_ni, tile_nj 
     2122      INTEGER,  DIMENSION(:)  , OPTIONAL, INTENT(in) ::   tile_data_ibegin, tile_data_jbegin, tile_data_ni, tile_data_nj 
    20952123      INTEGER                 , OPTIONAL, INTENT(in) ::   data_dim, data_ibegin, data_ni, data_jbegin, data_nj 
    2096       INTEGER                 , OPTIONAL, INTENT(in) ::   nvertex 
     2124      INTEGER                 , OPTIONAL, INTENT(in) ::   nvertex, ntiles 
    20972125      REAL(dp), DIMENSION(:)  , OPTIONAL, INTENT(in) ::   lonvalue, latvalue 
    20982126      REAL(dp), DIMENSION(:,:), OPTIONAL, INTENT(in) ::   bounds_lon, bounds_lat, area 
    … …  
    21032131         CALL xios_set_domain_attr     ( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   & 
    21042132            &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj ,   & 
     2133            &    ntiles=ntiles, tile_ibegin=tile_ibegin, tile_jbegin=tile_jbegin, tile_ni=tile_ni, tile_nj=tile_nj,        & 
     2134            &    tile_data_ibegin=tile_data_ibegin, tile_data_jbegin=tile_data_jbegin,                                     & 
     2135            &    tile_data_ni=tile_data_ni, tile_data_nj=tile_data_nj,                                                     & 
    21052136            &    lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_1D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon,      & 
    21062137            &    bounds_lat_1D=bounds_lat, area=area, type='curvilinear') 
    … …  
    21092140         CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   & 
    21102141            &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj ,   & 
     2142            &    ntiles=ntiles, tile_ibegin=tile_ibegin, tile_jbegin=tile_jbegin, tile_ni=tile_ni, tile_nj=tile_nj,        & 
     2143            &    tile_data_ibegin=tile_data_ibegin, tile_data_jbegin=tile_data_jbegin,                                     & 
     2144            &    tile_data_ni=tile_data_ni, tile_data_nj=tile_data_nj,                                                     & 
    21112145            &    lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_1D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon,      & 
    21122146            &    bounds_lat_1D=bounds_lat, area=area, type='curvilinear' ) 
    … …  
    22762310      ! 
    22772311      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zmask 
     2312      INTEGER :: jn 
     2313      INTEGER, DIMENSION(nijtile) :: ini, inj, idb 
    22782314      LOGICAL, INTENT(IN) :: ldxios, ldrxios 
    22792315      !!---------------------------------------------------------------------- 
    … …  
    22812317      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) 
    22822318      CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = -nn_hls, data_ni=jpi, data_jbegin = -nn_hls, data_nj=jpj) 
     2319 
     2320      IF( ln_tile ) THEN 
     2321         DO jn = 1, nijtile 
     2322            ini(jn) = ntei_a(jn) - ntsi_a(jn) + 1     ! Tile size in i and j 
     2323            inj(jn) = ntej_a(jn) - ntsj_a(jn) + 1 
     2324            idb(jn) = -nn_hls                         ! Tile data offset (halo size) 
     2325         END DO 
     2326 
     2327         ! Tile_[ij]begin are defined with respect to the processor data domain, so data_[ij]begin is added 
     2328         CALL iom_set_domain_attr("grid_"//cdgrd, ntiles=nijtile,                                     & 
     2329            & tile_ibegin=ntsi_a(1:nijtile) + idb(:) - 1, tile_jbegin=ntsj_a(1:nijtile) + idb(:) - 1, & 
     2330            & tile_ni=ini(:), tile_nj=inj(:),                                                         & 
     2331            & tile_data_ibegin=idb(:), tile_data_jbegin=idb(:),                                       & 
     2332            & tile_data_ni=ini(:) - 2 * idb(:), tile_data_nj=inj(:) - 2 * idb(:)) 
     2333      ENDIF 
     2334 
    22832335!don't define lon and lat for restart reading context. 
    22842336      IF ( .NOT.ldrxios ) & 

  • NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/ISF/isfhdiv.F90

    r14776 r14805  
    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( nn_hls, nn_hls, nn_hls, nn_hls )  
     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_r14273_HPC-02_Daley_Tiling/src/OCE/ISF/isftbl.F90

    r14776 r14805  
    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_r14273_HPC-02_Daley_Tiling/src/OCE/LDF/ldftra.F90

    r14776 r14805  
    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,*) 
    … …  
    758759      END_3D 
    759760      ! 
    760       DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 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( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 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_r14273_HPC-02_Daley_Tiling/src/OCE/OBS/diaobs.F90

    r14776 r14805  
    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_r14273_HPC-02_Daley_Tiling/src/OCE/SBC/sbcmod.F90

    r14776 r14805  
    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_r14273_HPC-02_Daley_Tiling/src/OCE/SBC/sbcrnf.F90

    r14776 r14805  
    206206      IF( ln_rnf_depth .OR. ln_rnf_depth_ini ) THEN      !==   runoff distributed over several levels   ==! 
    207207         IF( ln_linssh ) THEN    !* constant volume case : just apply the runoff input flow 
    208             DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     208            DO_2D_OVR( nn_hls-1, nn_hls, nn_hls-1, nn_hls ) 
    209209               DO jk = 1, nk_rnf(ji,jj) 
    210210                  phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_rho0 / h_rnf(ji,jj) 
    … …  
    212212            END_2D 
    213213         ELSE                    !* variable volume case 
    214             DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )              ! update the depth over which runoffs are distributed 
     214            DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls )         ! update the depth over which runoffs are distributed 
    215215               h_rnf(ji,jj) = 0._wp 
    216216               DO jk = 1, nk_rnf(ji,jj)                             ! recalculates h_rnf to be the depth in metres 
    … …  
    224224         ENDIF 
    225225      ELSE                       !==   runoff put only at the surface   ==! 
    226          h_rnf (:,:)   = e3t (:,:,1,Kmm)        ! update h_rnf to be depth of top box 
    227          phdivn(:,:,1) = phdivn(:,:,1) - ( rnf(:,:) + rnf_b(:,:) ) * zfact * r1_rho0 / e3t(:,:,1,Kmm) 
     226         DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls ) 
     227            h_rnf (ji,jj)   = e3t (ji,jj,1,Kmm)        ! update h_rnf to be depth of top box 
     228            phdivn(ji,jj,1) = phdivn(ji,jj,1) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_rho0 / e3t(ji,jj,1,Kmm) 
     229         END_2D 
    228230      ENDIF 
    229231      ! 

  • NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/SBC/sbcssr.F90

    r14776 r14805  
    9595            ! 
    9696            IF( nn_sstr == 1 ) THEN                                   !* Temperature restoring term 
    97                DO_2D( 1, 1, 1, 1 ) 
     97               DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    9898                  zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj,1) ) * tmask(ji,jj,1) 
    9999                  qns(ji,jj) = qns(ji,jj) + zqrp 
    … …  
    105105              ! use fraction of ice ( fr_i ) to adjust relaxation under ice if nn_sssr_ice .ne. 1 
    106106              ! n.b. coefice is initialised and fixed to 1._wp if nn_sssr_ice = 1 
    107                DO_2D( 1, 1, 1, 1 ) 
     107               DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    108108                  SELECT CASE ( nn_sssr_ice ) 
    109109                    CASE ( 0 )    ;  coefice(ji,jj) = 1._wp - fr_i(ji,jj)              ! no/reduced damping under ice 
    … …  
    115115            IF( nn_sssr == 1 ) THEN                                   !* Salinity damping term (salt flux only (sfx)) 
    116116               zsrp = rn_deds / rday                                  ! from [mm/day] to [kg/m2/s] 
    117                DO_2D( 1, 1, 1, 1 ) 
     117               DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    118118                  zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths 
    119119                     &        *   coefice(ji,jj)            &      ! Optional control of damping under sea-ice 
    … …  
    126126               zsrp = rn_deds / rday                                  ! from [mm/day] to [kg/m2/s] 
    127127               zerp_bnd = rn_sssr_bnd / rday                          !       -              -     
    128                DO_2D( 1, 1, 1, 1 ) 
     128               DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    129129                  zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths 
    130130                     &        *   coefice(ji,jj)            &      ! Optional control of damping under sea-ice 

  • NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/eosbn2.F90

    r14776 r14805  
    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_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/traadv.F90

    r14776 r14805  
    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) 
    … …  
    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 
    … …  
    180173            CALL tra_adv_cen    ( kt, nit000, 'TRA',         zuu, zvv, zww, Kmm, pts, jpts, Krhs, nn_cen_h, nn_cen_v ) 
    181174         CASE ( np_FCT )                                 ! FCT scheme      : 2nd / 4th order 
    182             IF (nn_hls==2) THEN 
    183 #if defined key_loop_fusion 
    184                CALL tra_adv_fct_lf ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_fct_h, nn_fct_v ) 
    185 #else 
    186175               CALL tra_adv_fct    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_fct_h, nn_fct_v ) 
    187 #endif 
    188             ELSE 
    189                CALL tra_adv_fct    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_fct_h, nn_fct_v ) 
    190             END IF 
    191176         CASE ( np_MUS )                                 ! MUSCL 
    192             IF (nn_hls==2) THEN 
    193 #if defined key_loop_fusion 
    194                 CALL tra_adv_mus_lf ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, ln_mus_ups ) 
    195 #else 
    196177                CALL tra_adv_mus    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, ln_mus_ups ) 
    197 #endif 
    198             ELSE 
    199                 CALL tra_adv_mus    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, ln_mus_ups ) 
    200             END IF 
    201178         CASE ( np_UBS )                                 ! UBS 
    202179            CALL tra_adv_ubs    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_ubs_v   ) 
    … …  
    216193         ENDIF 
    217194 
    218          ! 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) 
    219          IF( ln_tile .AND. ntile == 0 ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 1 ) 
    220  
     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. ) 
    221197      ENDIF 
    222198      !                                              ! print mean trends (used for debugging) 
    … …  
    224200         &                                  tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    225201 
    226       ! TEMP: [tiling] This change not necessary if using XIOS (subdomain support) 
    227       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 
    228204         DEALLOCATE( zuu, zvv, zww ) 
    229205      ENDIF 
    … …  
    297273        CALL ctl_stop( 'tra_adv_init: FCT scheme, choose 2nd or 4th order' ) 
    298274      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 
    299279      IF( ln_traadv_ubs .AND. ( nn_ubs_v /= 2 .AND. nn_ubs_v /= 4 )   ) THEN     ! UBS 
    300280        CALL ctl_stop( 'tra_adv_init: UBS scheme, choose 2nd or 4th order' ) 

  • NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/traadv_cen.F90

    r14776 r14805  
    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,*) 
    … …  
    184190      END DO 
    185191      ! 
     192#endif 
    186193   END SUBROUTINE tra_adv_cen 
    187194 

  • NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/traadv_fct.F90

    r14776 r14805  
    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 
    … …  
    380381      ENDIF 
    381382      ! 
     383#endif 
    382384   END SUBROUTINE tra_adv_fct 
    383385 
    … …  
    676678   END SUBROUTINE tridia_solver 
    677679 
     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 
    6781007   !!====================================================================== 
    6791008END MODULE traadv_fct 

  • NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/traadv_mus.F90

    r14776 r14805  
    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,*) 

  • NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/traadv_qck.F90

    r14776 r14805  
    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 
    … …  
    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 
     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 
    241246         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 
    … …  
    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_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/traadv_ubs.F90

    r14776 r14805  
    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,*) 
    … …  
    260266      END DO 
    261267      ! 
     268#endif 
    262269   END SUBROUTINE tra_adv_ubs 
    263270 

  • NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/traatf_qco.F90

    r14776 r14805  
    146146         ENDIF 
    147147         ! 
    148          IF (nn_hls==1) CALL lbc_lnk( 'traatfqco', pts(:,:,:,jp_tem,Kmm) , 'T', 1._wp, pts(:,:,:,jp_sal,Kmm) , 'T', 1._wp ) 
     148         CALL lbc_lnk( 'traatfqco', pts(:,:,:,jp_tem,Kmm) , 'T', 1._wp, pts(:,:,:,jp_sal,Kmm) , 'T', 1._wp ) 
    149149         ! 
    150150      ENDIF 

  • NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/trabbc.F90

    r14776 r14805  
    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_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/trabbl.F90

    r14776 r14805  
    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 iom_put( "uoce_bbl", utr_bbl )  ! bbl i-transport 
    144             CALL iom_put( "voce_bbl", vtr_bbl )  ! bbl j-transport 
    145          ENDIF 
     139         CALL iom_put( "uoce_bbl", utr_bbl )  ! bbl i-transport 
     140         CALL iom_put( "voce_bbl", vtr_bbl )  ! bbl j-transport 
    146141         ! 
    147142      ENDIF 
    … …  
    214209 
    215210 
     211   ! NOTE: [tiling] tiling changes the results, but only the order of floating point operations is different 
    216212   SUBROUTINE tra_bbl_adv( pt, pt_rhs, kjpt, Kmm ) 
    217213      !!---------------------------------------------------------------------- 
    … …  
    237233      INTEGER  ::   iis , iid , ijs , ijd    ! local integers 
    238234      INTEGER  ::   ikus, ikud, ikvs, ikvd   !   -       - 
    239       INTEGER  ::   isi, isj                 !   -       - 
    240235      REAL(wp) ::   zbtr, ztra               ! local scalars 
    241236      REAL(wp) ::   zu_bbl, zv_bbl           !   -      - 
    242237      !!---------------------------------------------------------------------- 
    243       ! 
    244       IF( ntsi == Nis0 ) THEN ; isi = 1 ; ELSE ; isi = 0 ; ENDIF    ! Avoid double-counting when using tiling 
    245       IF( ntsj == Njs0 ) THEN ; isj = 1 ; ELSE ; isj = 0 ; ENDIF 
    246238      !                                                          ! =========== 
    247239      DO jn = 1, kjpt                                            ! tracer loop 
    248240         !                                                       ! =========== 
    249          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 
    250242            IF( utr_bbl(ji,jj) /= 0.e0 ) THEN            ! non-zero i-direction bbl advection 
    251243               ! down-slope i/k-indices (deep)      &   up-slope i/k indices (shelf) 
    … …  
    339331      !!---------------------------------------------------------------------- 
    340332      ! 
    341       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 
    342334         IF( kt == kit000 )  THEN 
    343335            IF(lwp)  WRITE(numout,*) 
    … …  
    362354      IF( nn_bbl_ldf == 1 ) THEN          !   diffusive bbl   ! 
    363355         !                                !-------------------! 
    364          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 ) 
    365357            !                                                   ! i-direction 
    366358            za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem)              ! 2*(alpha,beta) at u-point 
    … …  
    392384         ! 
    393385         CASE( 1 )                                   != use of upper velocity 
    394             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 
    395387               !                                                  ! i-direction 
    396388               za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem)               ! 2*(alpha,beta) at u-point 
    … …  
    421413         CASE( 2 )                                 != bbl velocity = F( delta rho ) 
    422414            zgbbl = grav * rn_gambbl 
    423             DO_2D( 1, 0, 1, 0 )                         ! criteria: rho_up > rho_down 
     415            DO_2D_OVR( 1, 0, 1, 0 )                         ! criteria: rho_up > rho_down 
    424416               !                                                  ! i-direction 
    425417               ! down-slope T-point i/k-index (deep)  &   up-slope T-point i/k-index (shelf) 

  • NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/traisf.F90

    r14776 r14805  
    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_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/traldf.F90

    r14776 r14805  
    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             CALL tra_ldf_blp  ( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs),             jpts, nldf_tra ) 
    95          END SELECT 
    96          ! 
    97          IF( l_trdtra )   THEN                    !* save the horizontal diffusive trends for further diagnostics 
    98             ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:) 
    99             ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:) 
    100             CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_ldf, ztrdt ) 
    101             CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_ldf, ztrds ) 
    102             DEALLOCATE( ztrdt, ztrds ) 
    103          ENDIF 
    104  
    105          ! TEMP: [tiling] This change not necessary after extra haloes development (lbc_lnk removed from tra_ldf_blp, zps_hde*) 
    106          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 ) 
    10785      ENDIF 
    10886      !                                        !* print mean trends (used for debugging) 

  • NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/traldf_iso.F90

    r14776 r14805  
    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( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 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( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 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)          & 
    … …  
    186191            zahv_w = ( (  pahv(ji,jj  ,jk-1) + pahv(ji,jj-1,jk)                    & 
    187192               &       )                                                           & ! bracket for halo 1 - halo 2 compatibility 
    188                &       + ( pahv(ji,jj-1,jk-1) + pahv(ji,jj  ,jk)                   &  
     193               &       + ( pahv(ji,jj-1,jk-1) + pahv(ji,jj  ,jk)                   & 
    189194               &         ) ) * zmskv                                                 ! bracket for halo 1 - halo 2 compatibility 
    190195               ! 
    … …  
    194199         ! 
    195200         IF( ln_traldf_msc ) THEN                ! stabilizing vertical diffusivity coefficient 
    196             DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )  
     201            DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    197202               ! round brackets added to fix the order of floating point operations 
    198203               ! needed to ensure halo 1 - halo 2 compatibility 
    … …  
    202207                  &            )                                                                               & ! bracket for halo 1 - halo 2 compatibility 
    203208                  &            + ( ( pahv(ji,jj  ,jk) + pahv(ji,jj  ,jk-1) ) / ( e2v(ji,jj  ) * e2v(ji,jj  ) ) & 
    204                   &              + ( pahv(ji,jj-1,jk) + pahv(ji,jj-1,jk-1) ) / ( e2v(ji,jj-1) * e2v(ji,jj-1) ) &   
     209                  &              + ( pahv(ji,jj-1,jk) + pahv(ji,jj-1,jk-1) ) / ( e2v(ji,jj-1) * e2v(ji,jj-1) ) & 
    205210                  &              ) )                                                                             ! bracket for halo 1 - halo 2 compatibility 
    206211            END_3D 
    207212            ! 
    208213            IF( ln_traldf_blp ) THEN                ! bilaplacian operator 
    209                DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )  
     214               DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    210215                  akz(ji,jj,jk) = 16._wp   & 
    211216                     &   * ah_wslp2   (ji,jj,jk)   & 
    … …  
    215220               END_3D 
    216221            ELSEIF( ln_traldf_lap ) THEN              ! laplacian operator 
    217                DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )  
     222               DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    218223                  ze3w_2 = e3w(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm) 
    219224                  zcoef0 = rDt * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2  ) 
    … …  
    223228           ! 
    224229         ELSE                                    ! 33 flux set to zero with akz=ah_wslp2 ==>> computed in full implicit 
    225             DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk )  
     230            DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 
    226231               akz(ji,jj,jk) = ah_wslp2(ji,jj,jk) 
    227232            END_3D 
    … …  
    236241         !!   I - masked horizontal derivative 
    237242         !!---------------------------------------------------------------------- 
    238 !!gm : bug.... why (x,:,:)?   (1,jpj,:) and (jpi,1,:) should be sufficient.... 
    239          zdit (ntsi-nn_hls,:,:) = 0._wp     ;     zdit (ntei+nn_hls,:,:) = 0._wp 
    240          zdjt (ntsi-nn_hls,:,:) = 0._wp     ;     zdjt (ntei+nn_hls,:,:) = 0._wp 
    241          !!end 
     243         zdit(:,:,:) = 0._wp 
     244         zdjt(:,:,:) = 0._wp 
    242245 
    243246         ! Horizontal tracer gradient 
    244          DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )  
     247         DO_3D( iij, iij-1, iij, iij-1, 1, jpkm1 ) 
    245248            zdit(ji,jj,jk) = ( pt(ji+1,jj  ,jk,jn) - pt(ji,jj,jk,jn) ) * umask(ji,jj,jk) 
    246249            zdjt(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn) - pt(ji,jj,jk,jn) ) * vmask(ji,jj,jk) 
    247250         END_3D 
    248251         IF( ln_zps ) THEN      ! botton and surface ocean correction of the horizontal gradient 
    249                DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )            ! bottom correction (partial bottom cell) 
     252            DO_2D( iij, iij-1, iij, iij-1 )            ! bottom correction (partial bottom cell) 
    250253               zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn) 
    251254               zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn) 
    252255            END_2D 
    253256            IF( ln_isfcav ) THEN      ! first wet level beneath a cavity 
    254                DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )  
     257               DO_2D( iij, iij-1, iij, iij-1 ) 
    255258                  IF( miku(ji,jj) > 1 )   zdit(ji,jj,miku(ji,jj)) = pgui(ji,jj,jn) 
    256259                  IF( mikv(ji,jj) > 1 )   zdjt(ji,jj,mikv(ji,jj)) = pgvi(ji,jj,jn) 
    … …  
    265268         DO jk = 1, jpkm1                                 ! Horizontal slab 
    266269            ! 
    267             DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     270            DO_2D( iij, iij, iij, iij ) 
    268271               !                             !== Vertical tracer gradient 
    269272               zdk1t(ji,jj) = ( pt(ji,jj,jk,jn) - pt(ji,jj,jk+1,jn) ) * wmask(ji,jj,jk+1)     ! level jk+1 
    … …  
    274277            END_2D 
    275278            ! 
    276             DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )           !==  Horizontal fluxes 
     279            DO_2D( iij, iij-1, iij, iij-1 )           !==  Horizontal fluxes 
    277280               zabe1 = pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm) 
    278281               zabe2 = pahv(ji,jj,jk) * e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm) 
    … …  
    292295                  &               + zcof1 * ( ( zdkt (ji+1,jj) + zdk1t(ji,jj)    & 
    293296                  &                           )                                  & ! bracket for halo 1 - halo 2 compatibility 
    294                   &                         + ( zdk1t(ji+1,jj) + zdkt (ji,jj)    &  
     297                  &                         + ( zdk1t(ji+1,jj) + zdkt (ji,jj)    & 
    295298                  &                           )                                  & ! bracket for halo 1 - halo 2 compatibility 
    296299                  &                         ) ) * umask(ji,jj,jk) 
    … …  
    300303                  &                         + ( zdk1t(ji,jj+1) + zdkt (ji,jj)    & 
    301304                  &                           )                                  & ! bracket for halo 1 - halo 2 compatibility 
    302                   &                         ) ) * vmask(ji,jj,jk)       
     305                  &                         ) ) * vmask(ji,jj,jk) 
    303306            END_2D 
    304307            ! 
    305             DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )           !== horizontal divergence and add to pta 
     308            DO_2D( iij-1, iij-1, iij-1, iij-1 )           !== horizontal divergence and add to pta 
    306309               ! round brackets added to fix the order of floating point operations 
    307310               ! needed to ensure halo 1 - halo 2 compatibility 
    … …  
    324327         ztfw(:,:, 1 ) = 0._wp      ;      ztfw(:,:,jpk) = 0._wp 
    325328 
    326          DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )    ! interior (2=<jk=<jpk-1) 
     329         DO_3D( iij-1, iij-1, iij-1, iij-1, 2, jpkm1 )    ! interior (2=<jk=<jpk-1) 
    327330            ! 
    328331            zmsku = wmask(ji,jj,jk) / MAX(   umask(ji  ,jj,jk-1) + umask(ji-1,jj,jk)          & 
    … …  
    344347                  &                     )                                              & ! bracket for halo 1 - halo 2 compatibility 
    345348                  &                   + ( zdit(ji-1,jj  ,jk-1) + zdit(ji  ,jj  ,jk)    & 
    346                   &                     )                                              & ! bracket for halo 1 - halo 2 compatibility  
     349                  &                     )                                              & ! bracket for halo 1 - halo 2 compatibility 
    347350                  &                   )                                                & 
    348351                  &        + zcoef4 * ( ( zdjt(ji  ,jj  ,jk-1) + zdjt(ji  ,jj-1,jk)    & 
    … …  
    354357         !                                !==  add the vertical 33 flux  ==! 
    355358         IF( ln_traldf_lap ) THEN               ! laplacian case: eddy coef = ah_wslp2 - akz 
    356             DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )  
     359            DO_3D( iij-1, iij-1, iij-1, iij-1, 2, jpkm1 ) 
    357360               ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk)   & 
    358361                  &                            * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) )               & 
    … …  
    363366            SELECT CASE( kpass ) 
    364367            CASE(  1  )                            ! 1st pass : eddy coef = ah_wslp2 
    365                DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )  
     368               DO_3D( iij-1, iij-1, iij-1, iij-1, 2, jpkm1 ) 
    366369                  ztfw(ji,jj,jk) =   & 
    367370                     &  ztfw(ji,jj,jk) + ah_wslp2(ji,jj,jk) * e1e2t(ji,jj)   & 
    … …  
    369372               END_3D 
    370373            CASE(  2  )                         ! 2nd pass : eddy flux = ah_wslp2 and akz applied on pt  and pt2 gradients, resp. 
    371                DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )  
     374               DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    372375                  ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk)                  & 
    373376                     &                            * (  ah_wslp2(ji,jj,jk) * ( pt (ji,jj,jk-1,jn) - pt (ji,jj,jk,jn) )   & 
    … …  
    377380         ENDIF 
    378381         ! 
    379          DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )    !==  Divergence of vertical fluxes added to pta  ==!  
     382         DO_3D( iij-1, iij-1, iij-1, iij-1, 1, jpkm1 )    !==  Divergence of vertical fluxes added to pta  ==! 
    380383            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)   & 
    381384               &                                             / e3t(ji,jj,jk,Kmm) 

  • NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/traldf_lap_blp.F90

    r14776 r14805  
    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  ==! 
     160         DO_3D( iij-1, iij-1, iij-1, iij-1, 1, jpkm1 )            !== Second derivative (divergence) added to the general tracer trends  ==! 
    161161            ! round brackets added to fix the order of floating point operations 
    162162            ! needed to ensure halo 1 - halo 2 compatibility 
    … …  
    215215      !!--------------------------------------------------------------------- 
    216216      ! 
    217       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 
    218218         IF( kt == kit000 .AND. lwp )  THEN 
    219219            WRITE(numout,*) 
    … …  
    241241      IF (nn_hls==1) CALL lbc_lnk( 'traldf_lap_blp', zlap(:,:,:,:) , 'T', 1.0_wp )     ! Lateral boundary conditions (unchanged sign) 
    242242      !                                               ! Partial top/bottom cell: GRADh( zlap ) 
    243       IF( ln_zps ) THEN 
    244          IF( ln_isfcav ) THEN   ;   CALL zps_hde_isf( kt, Kmm, kjpt, zlap, zglu, zglv, zgui, zgvi )  ! both top & bottom 
    245          ELSE   ;   CALL zps_hde    ( kt, Kmm, kjpt, zlap, zglu, zglv )              ! only bottom 
    246          ENDIF 
     243      IF( ln_isfcav .AND. ln_zps ) THEN   ;   CALL zps_hde_isf( kt, Kmm, kjpt, zlap, zglu, zglv, zgui, zgvi )  ! both top & bottom 
     244      ELSEIF(             ln_zps ) THEN   ;   CALL zps_hde    ( kt, Kmm, kjpt, zlap, zglu, zglv )              ! only bottom 
    247245      ENDIF 
    248246      ! 

  • NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/traldf_triad.F90

    r14776 r14805  
    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, kp   ! dummy loop indices 
     109      INTEGER  ::  ji, jj, jk, jn, kp, iij   ! dummy loop indices 
    112110      REAL(wp) ::  zcoef0, ze3w_2, zsign          !   -      - 
    113111      ! 
    … …  
    115113      REAL(wp) ::   ze1ur, ze2vr, ze3wr, zdxt, zdyt, zdzt, zdyt_jp1, ze3wr_jp1, zdzt_jp1, zah_slp1, zah_slp_jp1, zaei_slp_jp1 
    116114      REAL(wp) ::   zah_slp, zaei_slp, zdxt_ip1, ze3wr_ip1, zdzt_ip1, zah_slp_ip1, zaei_slp_ip1, zaei_slp1 
    117       REAL(wp), DIMENSION(A2D(nn_hls),0:1)     ::   zdkt3d                         ! vertical tracer gradient at 2 levels 
    118       REAL(wp), DIMENSION(A2D(nn_hls)        ) ::   z2d                            ! 2D workspace 
    119       REAL(wp), DIMENSION(A2D(nn_hls)    ,jpk) ::   zdit, zdjt, zftu, zftv, ztfw   ! 3D     - 
    120       ! TEMP: [tiling] This can be A2D(nn_hls) if XIOS has subdomain support 
    121       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zpsi_uw, zpsi_vw 
     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     - 
    122118      !!---------------------------------------------------------------------- 
    123119      ! 
    124       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 
    125121         IF( kpass == 1 .AND. kt == kit000 )  THEN 
    126122            IF(lwp) WRITE(numout,*) 
    … …  
    138134      ENDIF 
    139135      ! 
     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      ! 
    140142      IF( kpass == 1 ) THEN   ;   zsign =  1._wp      ! bilaplacian operator require a minus sign (eddy diffusivity >0) 
    141143      ELSE                    ;   zsign = -1._wp 
    … …  
    148150      IF( kpass == 1 ) THEN         !==  first pass only  and whatever the tracer is  ==! 
    149151         ! 
    150          DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 
     152         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 
    151153            akz     (ji,jj,jk) = 0._wp 
    152154            ah_wslp2(ji,jj,jk) = 0._wp 
    … …  
    154156         ! 
    155157         DO kp = 0, 1                            ! i-k triads 
    156             DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
     158            DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
    157159               ze3wr = 1._wp / e3w(ji,jj,jk+kp,Kmm) 
    158160               zbu   = e1e2u(ji,jj) * e3u(ji,jj,jk,Kmm) 
    … …  
    177179         ! 
    178180         DO kp = 0, 1                            ! j-k triads 
    179             DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
     181            DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
    180182               ze3wr = 1.0_wp / e3w(ji,jj,jk+kp,Kmm) 
    181183               zbv   = e1e2v(ji,jj) * e3v(ji,jj,jk,Kmm) 
    … …  
    204206            ! 
    205207            IF( ln_traldf_blp ) THEN                ! bilaplacian operator 
    206                DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
     208               DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    207209                  akz(ji,jj,jk) = 16._wp           & 
    208210                     &   * ah_wslp2   (ji,jj,jk)   & 
    … …  
    212214               END_3D 
    213215            ELSEIF( ln_traldf_lap ) THEN              ! laplacian operator 
    214                DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
     216               DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
    215217                  ze3w_2 = e3w(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm) 
    216218                  zcoef0 = rDt * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2  ) 
    … …  
    220222           ! 
    221223         ELSE                                    ! 33 flux set to zero with akz=ah_wslp2 ==>> computed in full implicit 
    222             DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 
     224            DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 
    223225               akz(ji,jj,jk) = ah_wslp2(ji,jj,jk) 
    224226            END_3D 
    225227         ENDIF 
    226228         ! 
    227          ! TEMP: [tiling] These changes not necessary if XIOS has subdomain support 
    228          IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only for the full domain 
    229             IF( ln_ldfeiv_dia .AND. cdtype == 'TRA' ) THEN 
    230                IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) 
    231  
    232                   zpsi_uw(:,:,:) = 0._wp 
    233                   zpsi_vw(:,:,:) = 0._wp 
    234                    
    235                   DO kp = 0, 1 
    236                      DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 
    237                         ! round brackets added to fix the order of floating point operations 
    238                         ! needed to ensure halo 1 - halo 2 compatibility 
    239                         zpsi_uw(ji,jj,jk+kp) = zpsi_uw(ji,jj,jk+kp)                                     & 
    240                            & + ( 0.25_wp * aeiu(ji,jj,jk) * e2u(ji,jj) * triadi_g(ji,jj,jk,1,kp)        &  
    241                            &   + 0.25_wp * aeiu(ji,jj,jk) * e2u(ji,jj) * triadi_g(ji+1,jj,jk,0,kp)      & 
    242                            &   )                                                                        ! bracket for halo 1 - halo 2 compatibility 
    243                         zpsi_vw(ji,jj,jk+kp) = zpsi_vw(ji,jj,jk+kp)                                     & 
    244                            & + ( 0.25_wp * aeiv(ji,jj,jk) * e1v(ji,jj) * triadj_g(ji,jj,jk,1,kp)        & 
    245                            &   + 0.25_wp * aeiv(ji,jj,jk) * e1v(ji,jj) * triadj_g(ji,jj+1,jk,0,kp)      & 
    246                            &   )                                                                        ! bracket for halo 1 - halo 2 compatibility 
    247                      END_3D 
    248                   END DO 
    249                CALL ldf_eiv_dia( zpsi_uw, zpsi_vw, Kmm ) 
    250  
    251                IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = nijtile ) 
    252             ENDIF 
     229         IF( ln_ldfeiv_dia .AND. cdtype == 'TRA' ) THEN 
     230            zpsi_uw(:,:,:) = 0._wp 
     231            zpsi_vw(:,:,:) = 0._wp 
     232 
     233            DO kp = 0, 1 
     234               DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 
     235                  ! round brackets added to fix the order of floating point operations 
     236                  ! needed to ensure halo 1 - halo 2 compatibility 
     237                  zpsi_uw(ji,jj,jk+kp) = zpsi_uw(ji,jj,jk+kp)                                     & 
     238                     & + ( 0.25_wp * aeiu(ji,jj,jk) * e2u(ji,jj) * triadi_g(ji,jj,jk,1,kp)        & 
     239                     &   + 0.25_wp * aeiu(ji,jj,jk) * e2u(ji,jj) * triadi_g(ji+1,jj,jk,0,kp)      & 
     240                     &   )                                                                        ! bracket for halo 1 - halo 2 compatibility 
     241                  zpsi_vw(ji,jj,jk+kp) = zpsi_vw(ji,jj,jk+kp)                                     & 
     242                     & + ( 0.25_wp * aeiv(ji,jj,jk) * e1v(ji,jj) * triadj_g(ji,jj,jk,1,kp)        & 
     243                     &   + 0.25_wp * aeiv(ji,jj,jk) * e1v(ji,jj) * triadj_g(ji,jj+1,jk,0,kp)      & 
     244                     &   )                                                                        ! bracket for halo 1 - halo 2 compatibility 
     245               END_3D 
     246            END DO 
     247            CALL ldf_eiv_dia( zpsi_uw, zpsi_vw, Kmm ) 
    253248         ENDIF 
    254249         ! 
    … …  
    263258         zftu(:,:,:) = 0._wp 
    264259         zftv(:,:,:) = 0._wp 
    265          ! 
    266          DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )    !==  before lateral T & S gradients at T-level jk  ==! 
     260         zdit(:,:,:) = 0._wp 
     261         zdjt(:,:,:) = 0._wp 
     262         ! 
     263         DO_3D( iij, iij-1, iij, iij-1, 1, jpkm1 )    !==  before lateral T & S gradients at T-level jk  ==! 
    267264            zdit(ji,jj,jk) = ( pt(ji+1,jj  ,jk,jn) - pt(ji,jj,jk,jn) ) * umask(ji,jj,jk) 
    268265            zdjt(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn) - pt(ji,jj,jk,jn) ) * vmask(ji,jj,jk) 
    269266         END_3D 
    270267         IF( ln_zps .AND. l_grad_zps ) THEN    ! partial steps: correction at top/bottom ocean level 
    271             DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )                    ! bottom level 
     268            DO_2D( iij, iij-1, iij, iij-1 )                    ! bottom level 
    272269               zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn) 
    273270               zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn) 
    274271            END_2D 
    275272            IF( ln_isfcav ) THEN                   ! top level (ocean cavities only) 
    276                DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
     273               DO_2D( iij, iij-1, iij, iij-1 ) 
    277274                  IF( miku(ji,jj)  > 1 )   zdit(ji,jj,miku(ji,jj) ) = pgui(ji,jj,jn) 
    278275                  IF( mikv(ji,jj)  > 1 )   zdjt(ji,jj,mikv(ji,jj) ) = pgvi(ji,jj,jn) 
    … …  
    287284         DO jk = 1, jpkm1 
    288285            !                    !==  Vertical tracer gradient at level jk and jk+1 
    289             DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     286            DO_2D( iij, iij, iij, iij ) 
    290287               zdkt3d(ji,jj,1) = ( pt(ji,jj,jk,jn) - pt(ji,jj,jk+1,jn) ) * tmask(ji,jj,jk+1) 
    291288            END_2D 
    … …  
    294291            IF( jk == 1 ) THEN   ;   zdkt3d(:,:,0) = zdkt3d(:,:,1) 
    295292            ELSE 
    296                DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     293               DO_2D( iij, iij, iij, iij ) 
    297294                  zdkt3d(ji,jj,0) = ( pt(ji,jj,jk-1,jn) - pt(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 
    298295               END_2D 
    … …  
    300297            ! 
    301298            zaei_slp = 0._wp 
     299            zaei_slp_ip1 = 0._wp 
     300            zaei_slp_jp1 = 0._wp 
     301            zaei_slp1 = 0._wp 
    302302            ! 
    303303            IF( ln_botmix_triad ) THEN 
    304304               DO kp = 0, 1              !==  Horizontal & vertical fluxes 
    305                   DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
     305                  DO_2D( iij, iij-1, iij, iij-1 ) 
    306306                     ze1ur = r1_e1u(ji,jj) 
    307307                     zdxt  = zdit(ji,jj,jk) * ze1ur 
    … …  
    315315                     zbu_ip1 = 0.25_wp * e1e2u(ji+1,jj) * e3u(ji+1,jj,jk,Kmm) 
    316316                     ! ln_botmix_triad is .T. don't mask zah for bottom half cells    !!gm ?????   ahu is masked.... 
    317                      zah = pahu(ji,jj,jk)  
    318                      zah_ip1 = pahu(ji+1,jj,jk)  
     317                     zah = pahu(ji,jj,jk) 
     318                     zah_ip1 = pahu(ji+1,jj,jk) 
    319319                     zah_slp  = zah * triadi(ji,jj,jk,1,kp) 
    320320                     zah_slp_ip1  = zah_ip1 * triadi(ji+1,jj,jk,1,kp) 
    … …  
    331331                                         &      + ( zah * zdxt + zah_slp1 * zdzt_ip1 - zaei_slp1 * zdzt_ip1 ) * zbu * ze1ur  & 
    332332                                         &      )                                                                            ! bracket for halo 1 - halo 2 compatibility 
    333                      ztfw(ji+1,jj,jk+kp) =  ztfw(ji+1,jj,jk+kp)                                                              &  
     333                     ztfw(ji+1,jj,jk+kp) =  ztfw(ji+1,jj,jk+kp)                                                              & 
    334334                                         &    - ( (zah_slp_ip1 + zaei_slp_ip1) * zdxt_ip1 * zbu_ip1 * ze3wr_ip1              & 
    335                                          &      + ( zah_slp1 + zaei_slp1) * zdxt * zbu * ze3wr_ip1                           &  
     335                                         &      + ( zah_slp1 + zaei_slp1) * zdxt * zbu * ze3wr_ip1                           & 
    336336                                         &      )                                                                            ! bracket for halo 1 - halo 2 compatibility 
    337337                  END_2D 
    … …  
    339339               ! 
    340340               DO kp = 0, 1 
    341                   DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
     341                  DO_2D( iij, iij-1, iij, iij-1 ) 
    342342                     ze2vr = r1_e2v(ji,jj) 
    343343                     zdyt  = zdjt(ji,jj,jk) * ze2vr 
    … …  
    351351                     ! ln_botmix_triad is .T. don't mask zah for bottom half cells    !!gm ?????   ahu is masked.... 
    352352                     zah = pahv(ji,jj,jk)          ! pahv(ji,jj+jp,jk)  ???? 
    353                      zah_jp1 = pahv(ji,jj+1,jk)  
     353                     zah_jp1 = pahv(ji,jj+1,jk) 
    354354                     zah_slp = zah * triadj(ji,jj,jk,1,kp) 
    355355                     zah_slp1 = zah * triadj(ji,jj+1,jk,0,kp) 
    356356                     zah_slp_jp1 = zah_jp1 * triadj(ji,jj+1,jk,1,kp) 
    357357                     IF( ln_ldfeiv )   THEN 
    358                         zaei_slp = aeiv(ji,jj,jk) * triadj_g(ji,jj,jk,1,kp)   
    359                         zaei_slp_jp1 = aeiv(ji,jj+1,jk) * triadj_g(ji,jj+1,jk,1,kp)   
     358                        zaei_slp = aeiv(ji,jj,jk) * triadj_g(ji,jj,jk,1,kp) 
     359                        zaei_slp_jp1 = aeiv(ji,jj+1,jk) * triadj_g(ji,jj+1,jk,1,kp) 
    360360                        zaei_slp1 = aeiv(ji,jj,jk) * triadj_g(ji,jj+1,jk,0,kp) 
    361361                     ENDIF 
    … …  
    376376               ! 
    377377               DO kp = 0, 1               !==  Horizontal & vertical fluxes 
    378                   DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
     378                  DO_2D( iij, iij-1, iij, iij-1 ) 
    379379                     ze1ur = r1_e1u(ji,jj) 
    380380                     zdxt  = zdit(ji,jj,jk) * ze1ur 
    … …  
    389389                     ! ln_botmix_triad is .F. mask zah for bottom half cells 
    390390                     zah = pahu(ji,jj,jk) * umask(ji,jj,jk+kp)         ! pahu(ji+ip,jj,jk)   ===>>  ???? 
    391                      zah_ip1 = pahu(ji+1,jj,jk) * umask(ji+1,jj,jk+kp)  
     391                     zah_ip1 = pahu(ji+1,jj,jk) * umask(ji+1,jj,jk+kp) 
    392392                     zah_slp  = zah * triadi(ji,jj,jk,1,kp) 
    393393                     zah_slp_ip1  = zah_ip1 * triadi(ji+1,jj,jk,1,kp) 
    394394                     zah_slp1  = zah * triadi(ji+1,jj,jk,0,kp) 
    395395                     IF( ln_ldfeiv )   THEN 
    396                         zaei_slp = aeiu(ji,jj,jk) * triadi_g(ji,jj,jk,1,kp)  
     396                        zaei_slp = aeiu(ji,jj,jk) * triadi_g(ji,jj,jk,1,kp) 
    397397                        zaei_slp_ip1 = aeiu(ji+1,jj,jk) * triadi_g(ji+1,jj,jk,1,kp) 
    398398                        zaei_slp1 = aeiu(ji,jj,jk) * triadi_g(ji+1,jj,jk,0,kp) 
    399399                     ENDIF 
    400 !                     zftu(ji   ,jj,jk  ) = zftu(ji   ,jj,jk ) - ( zah * zdxt + (zah_slp - zaei_slp) * zdzt ) * zbu * ze1ur - ( zah * zdxt + (zah_slp1 - zaei_slp1) * zdzt_ip1 ) * zbu * ze1ur 
    401 !                     ztfw(ji+1,jj,jk+kp) = ztfw(ji+1,jj,jk+kp) - (zah_slp_ip1 + zaei_slp_ip1) * zdxt_ip1 * zbu_ip1 * ze3wr_ip1 - (zah_slp1 + zaei_slp1) * zdxt * zbu * ze3wr_ip1 
    402400                     ! round brackets added to fix the order of floating point operations 
    403401                     ! needed to ensure halo 1 - halo 2 compatibility 
    … …  
    406404                                         &      + ( zah * zdxt + zah_slp1 * zdzt_ip1 - zaei_slp1 * zdzt_ip1 ) * zbu * ze1ur  & 
    407405                                         &      )                                                                            ! bracket for halo 1 - halo 2 compatibility 
    408                      ztfw(ji+1,jj,jk+kp) =  ztfw(ji+1,jj,jk+kp)                                                              &  
     406                     ztfw(ji+1,jj,jk+kp) =  ztfw(ji+1,jj,jk+kp)                                                              & 
    409407                                         &    - ( (zah_slp_ip1 + zaei_slp_ip1) * zdxt_ip1 * zbu_ip1 * ze3wr_ip1              & 
    410408                                         &      + ( zah_slp1 + zaei_slp1) * zdxt * zbu * ze3wr_ip1                           & 
    … …  
    414412               ! 
    415413               DO kp = 0, 1 
    416                   DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
     414                  DO_2D( iij, iij-1, iij, iij-1 ) 
    417415                     ze2vr = r1_e2v(ji,jj) 
    418416                     zdyt  = zdjt(ji,jj,jk) * ze2vr 
    … …  
    431429                     zah_slp_jp1 = zah_jp1 * triadj(ji,jj+1,jk,1,kp) 
    432430                     IF( ln_ldfeiv )   THEN 
    433                         zaei_slp = aeiv(ji,jj,jk) * triadj_g(ji,jj,jk,1,kp)  
     431                        zaei_slp = aeiv(ji,jj,jk) * triadj_g(ji,jj,jk,1,kp) 
    434432                        zaei_slp_jp1 = aeiv(ji,jj+1,jk) * triadj_g(ji,jj+1,jk,1,kp) 
    435433                        zaei_slp1 = aeiv(ji,jj,jk) * triadj_g(ji,jj+1,jk,0,kp) 
    436434                     ENDIF 
    437 !                     zftv(ji,jj  ,jk   ) = zftv(ji,jj  ,jk   ) - ( zah * zdyt + (zah_slp - zaei_slp) * zdzt ) * zbv * ze2vr - ( zah * zdyt + (zah_slp1 - zaei_slp1) * zdzt_jp1 ) * zbv * ze2vr 
    438 !                     ztfw(ji,jj+1,jk+kp) = ztfw(ji,jj+1,jk+kp) - ( zah_slp_jp1 + zaei_slp_jp1) * zdyt_jp1 * zbv_jp1 * ze3wr_jp1 - (zah_slp1 + zaei_slp1) * zdyt * zbv * ze3wr_jp1 
    439435                     ! round brackets added to fix the order of floating point operations 
    440436                     ! needed to ensure halo 1 - halo 2 compatibility 
    … …  
    451447            ENDIF 
    452448            !                             !==  horizontal divergence and add to the general trend  ==! 
    453             DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     449            DO_2D( iij-1, iij-1, iij-1, iij-1 ) 
    454450               ! round brackets added to fix the order of floating point operations 
    455451               ! needed to ensure halo 1 - halo 2 compatibility 
    … …  
    466462         !                                !==  add the vertical 33 flux  ==! 
    467463         IF( ln_traldf_lap ) THEN               ! laplacian case: eddy coef = ah_wslp2 - akz 
    468             DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
     464            DO_3D( iij-1, iij-1, iij-1, iij-1, 2, jpkm1 ) 
    469465               ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk)   & 
    470466                  &                            * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) )             & 
    … …  
    474470            SELECT CASE( kpass ) 
    475471            CASE(  1  )                            ! 1st pass : eddy coef = ah_wslp2 
    476                DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
     472               DO_3D( iij-1, iij-1, iij-1, iij-1, 2, jpkm1 ) 
    477473                  ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk)             & 
    478474                     &                            * ah_wslp2(ji,jj,jk) * ( pt(ji,jj,jk-1,jn) - pt(ji,jj,jk,jn) ) 
    479475               END_3D 
    480476            CASE(  2  )                            ! 2nd pass : eddy flux = ah_wslp2 and akz applied on pt  and pt2 gradients, resp. 
    481                DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
     477               DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    482478                  ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk)                      & 
    483479                     &                            * (  ah_wslp2(ji,jj,jk) * ( pt (ji,jj,jk-1,jn) - pt (ji,jj,jk,jn) )   & 
    … …  
    487483         ENDIF 
    488484         ! 
    489          DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )      !==  Divergence of vertical fluxes added to pta  ==! 
     485         DO_3D( iij-1, iij-1, iij-1, iij-1, 1, jpkm1 )      !==  Divergence of vertical fluxes added to pta  ==! 
    490486            pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn)    & 
    491487            &                                  + zsign * (  ztfw(ji,jj,jk+1) - ztfw(ji,jj,jk)  )   & 

  • NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/tramle.F90

    r14776 r14805  
    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      ! 
    … …  
    253251      !                                      !==  transport increased by the MLE induced transport ==! 
    254252      DO jk = 1, ikmax 
    255          DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
     253         DO_2D_OVR( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    256254            pu(ji,jj,jk) = pu(ji,jj,jk) + ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji,jj,jk+1) ) 
    257255            pv(ji,jj,jk) = pv(ji,jj,jk) + ( zpsi_vw(ji,jj,jk) - zpsi_vw(ji,jj,jk+1) ) 
    258256         END_2D 
    259          DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     257         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    260258            pw(ji,jj,jk) = pw(ji,jj,jk) - ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji-1,jj,jk)   & 
    261259               &                          + zpsi_vw(ji,jj,jk) - zpsi_vw(ji,jj-1,jk) ) * wmask(ji,jj,1) 
    … …  
    263261      END DO 
    264262 
    265       ! TEMP: [tiling] These changes not necessary if using XIOS (subdomain support) 
    266263      IF( cdtype == 'TRA') THEN              !==  outputs  ==! 
    267          IF( ntile == 0 .OR. ntile == 1 ) THEN                             ! Do only on the first tile 
    268             ALLOCATE( zLf_NH(jpi,jpj), zpsiu_mle(jpi,jpj,jpk), zpsiv_mle(jpi,jpj,jpk) ) 
    269             zpsiu_mle(:,:,:) = 0._wp ; zpsiv_mle(:,:,:) = 0._wp 
    270          ENDIF 
    271264         ! 
    272265         IF (ln_osm_mle.and.ln_zdfosm) THEN 
    273             DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     266            DO_2D( 0, 0, 0, 0 ) 
    274267               zLf_NH(ji,jj) = SQRT( rb_c * hmle(ji,jj) ) * r1_ft(ji,jj)      ! Lf = N H / f 
    275268            END_2D 
    276269         ELSE 
    277             DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     270            DO_2D( 0, 0, 0, 0 ) 
    278271               zLf_NH(ji,jj) = SQRT( rb_c * zmld(ji,jj) ) * r1_ft(ji,jj)      ! Lf = N H / f 
    279272            END_2D 
    280273         ENDIF 
    281274         ! 
     275         CALL iom_put( "Lf_NHpf" , zLf_NH  )    ! Lf = N H / f 
     276         ! 
    282277         ! divide by cross distance to give streamfunction with dimensions m^2/s 
    283          DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, ikmax+1 ) 
    284             zpsiu_mle(ji,jj,jk) = zpsi_uw(ji,jj,jk) * r1_e2u(ji,jj) 
    285             zpsiv_mle(ji,jj,jk) = zpsi_vw(ji,jj,jk) * r1_e1v(ji,jj) 
     278         DO_3D( 0, 0, 0, 0, 1, ikmax+1 ) 
     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) 
    286281         END_3D 
    287  
    288          IF( ntile == 0 .OR. ntile == nijtile ) THEN                       ! Do only on the last tile 
    289             CALL iom_put( "Lf_NHpf" , zLf_NH  )    ! Lf = N H / f 
    290             CALL iom_put( "psiu_mle", zpsiu_mle )    ! i-mle streamfunction 
    291             CALL iom_put( "psiv_mle", zpsiv_mle )    ! j-mle streamfunction 
    292             DEALLOCATE( zLf_NH, zpsiu_mle, zpsiv_mle ) 
    293          ENDIF 
     282         CALL iom_put( "psiu_mle", zpsi_uw )    ! i-mle streamfunction 
     283         CALL iom_put( "psiv_mle", zpsi_vw )    ! j-mle streamfunction 
    294284      ENDIF 
    295285      ! 
    … …  
    376366         r1_ft(:,:) = 1._wp / SQRT(  ff_t(:,:) * ff_t(:,:) + z1_t2  ) 
    377367         ! 
     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 
    378372      ENDIF 
    379373      ! 

  • NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/tranpc.F90

    r14776 r14805  
    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_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/traqsr.F90

    r14776 r14805  
    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_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/trasbc.F90

    r14776 r14805  
    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_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/trazdf.F90

    r14776 r14805  
    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_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/zpshde.F90

    r14776 r14805  
    174174         pgru(:,:) = 0._wp 
    175175         pgrv(:,:) = 0._wp                ! depth of the partial step level 
    176          DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
     176         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    177177            iku = mbku(ji,jj) 
    178178            ikv = mbkv(ji,jj) 
    … …  
    190190         CALL eos( ztj, zhj, zrj )        ! at the partial step depth output in  zri, zrj 
    191191         ! 
    192          DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )              ! Gradient of density at the last level 
     192         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )              ! Gradient of density at the last level 
    193193            iku = mbku(ji,jj) 
    194194            ikv = mbkv(ji,jj) 
    … …  
    310310      DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==! 
    311311         ! 
    312          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 ) 
    313313 
    314314            iku = mbku(ji,jj); ikum1 = MAX( iku - 1 , 1 )    ! last and before last ocean level at u- & v-points 
    … …  
    399399      ! 
    400400      DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==!            ! 
    401          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 ) 
    402402            iku = miku(ji,jj); ikup1 = miku(ji,jj) + 1 
    403403            ikv = mikv(ji,jj); ikvp1 = mikv(ji,jj) + 1 

  • NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/TRD/trdini.F90

    r14776 r14805  
    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_r14273_HPC-02_Daley_Tiling/src/OCE/ZDF/zdfddm.F90

    r14776 r14805  
    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( nn_hls, nn_hls, nn_hls, nn_hls )           !==  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( nn_hls, nn_hls, nn_hls, nn_hls )           !==  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( nn_hls, nn_hls, nn_hls, nn_hls ) 
     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_r14273_HPC-02_Daley_Tiling/src/OCE/ZDF/zdfdrg.F90

    r14776 r14805  
    117117      ! 
    118118      IF( l_log_not_linssh ) THEN     !==  "log layer"  ==!   compute Cd and -Cd*|U| 
    119          DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     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( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     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 
    … …  
    176176      ENDIF 
    177177 
    178       DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     178      DO_2D( 0, 0, 0, 0 ) 
    179179         ikbu = mbku(ji,jj)          ! deepest wet ocean u- & v-levels 
    180180         ikbv = mbkv(ji,jj) 
    … …  
    189189      ! 
    190190      IF( ln_isfcav ) THEN        ! ocean cavities 
    191          DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     191         DO_2D( 0, 0, 0, 0 ) 
    192192            ikbu = miku(ji,jj)          ! first wet ocean u- & v-levels 
    193193            ikbv = mikv(ji,jj) 

  • NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/ZDF/zdfevd.F90

    r14776 r14805  
    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( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 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( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 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_r14273_HPC-02_Daley_Tiling/src/OCE/ZDF/zdfgls.F90

    r14776 r14805  
    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( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )          !==  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( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )          ! 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( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )      ! 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 
     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 
    221228      ! 
    222229      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )  !==  Compute dissipation rate  ==! 
    … …  
    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( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 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( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 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( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )   ! 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( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     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( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     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( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     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( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     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 
    … …  
    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( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpkm1, 2, -1 )           ! Third 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      !!----------------------------------------!! 
    … …  
    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( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )   ! 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 
    … …  
    658677      ! Limit dissipation rate under stable stratification 
    659678      ! -------------------------------------------------- 
    660       DO_3D( 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 
     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      ! 
    … …  
    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( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 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_r14273_HPC-02_Daley_Tiling/src/OCE/ZDF/zdfiwm.F90

    r14776 r14805  
    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     -      -    -     - 
    … …  
    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.... 
    312          DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 
     313         DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 
    313314            zztmp = zztmp + e3w(ji,jj,jk,Kmm) * e1e2t(ji,jj)   & 
    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 
    … …  
    341345         END_3D 
    342346         CALL iom_put( "av_ratio", zav_ratio ) 
    343          DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 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( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 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) ) 
    364368         ! Initialisation for iom_put 
    365369         DO_2D( 0, 0, 0, 0 ) 
    366370            z3d(ji,jj,1) = 0._wp   ;   z3d(ji,jj,jpk) = 0._wp 
    367371         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 
    372372 
    373373         DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 

  • NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/ZDF/zdfmfc.F90

    r14776 r14805  
    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(:,:) 
    219225 
    220          DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     226         DO_2D( 0, 0, 0, 0 ) 
    221227 
    222228            ! Compute Environment of Plume. Interpolation T/S (before time step) on W-points 
    … …  
    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       IF (nn_hls==1) 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_r14273_HPC-02_Daley_Tiling/src/OCE/ZDF/zdfmxl.F90

    r14776 r14805  
    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( nn_hls, nn_hls, nn_hls, nn_hls, 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( nn_hls, nn_hls, nn_hls, nn_hls, 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( nn_hls, nn_hls, nn_hls, nn_hls ) 
    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_r14273_HPC-02_Daley_Tiling/src/OCE/ZDF/zdfphy.F90

    r14776 r14805  
    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. 
    … …  
    5658   LOGICAL, PUBLIC ::   l_zdfsh2   ! shear production term flag (=F for CST, =T otherwise (i.e. TKE, GLS, RIC)) 
    5759 
     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(nn_hls==1) THEN  
     371      IF(nn_hls==1) THEN 
    325372         IF( l_zdfsh2 ) THEN 
    326373            CALL lbc_lnk( 'zdfphy', avm_k, 'W', 1.0_wp , avt_k, 'W', 1.0_wp,   & 
    327                &                    avm  , 'W', 1.0_wp , avt  , 'W', 1.0_wp , avs , 'W', 1.0_wp ) 
     374                  &                 avm  , 'W', 1.0_wp , avt  , 'W', 1.0_wp , avs , 'W', 1.0_wp ) 
    328375         ELSE 
    329376            CALL lbc_lnk( 'zdfphy', avm  , 'W', 1.0_wp , avt  , 'W', 1.0_wp , avs , 'W', 1.0_wp ) 
    330377         ENDIF 
    331       ! 
     378         ! 
    332379         IF( l_zdfdrg ) THEN     ! drag  have been updated (non-linear cases) 
    333380            IF( ln_isfcav ) THEN   ;  CALL lbc_lnk( 'zdfphy', rCdU_top, 'T', 1.0_wp , rCdU_bot, 'T', 1.0_wp )   ! top & bot drag 
    334             ELSE                   ;  CALL lbc_lnk( 'zdfphy', rCdU_bot, 'T', 1.0_wp )                       ! bottom drag only 
     381            ELSE                   ;  CALL lbc_lnk( 'zdfphy', rCdU_bot, 'T', 1.0_wp )                           ! bottom drag only 
    335382            ENDIF 
    336383         ENDIF 
    337384      ENDIF 
    338385      ! 
    339       CALL zdf_mxl( kt, Kmm )                        !* mixed layer depth, and level 
    340       ! 
    341       IF( lrst_oce ) THEN                       !* write TKE, GLS or RIC fields in the restart file 
    342          IF( ln_zdftke )   CALL tke_rst( kt, 'WRITE' ) 
    343          IF( ln_zdfgls )   CALL gls_rst( kt, 'WRITE' ) 
    344          IF( ln_zdfric )   CALL ric_rst( kt, 'WRITE' ) 
    345          ! NB. OSMOSIS restart (osm_rst) will be called in step.F90 after ww has been updated 
     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 
    346395      ENDIF 
    347396      ! 

  • NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/ZDF/zdfric.F90

    r14776 r14805  
    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( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 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 
    … …  
    174174            zh_ekm(ji,jj) = MAX(  rn_mldmin , MIN( zhek , rn_mldmax )  )   ! set allowed range 
    175175         END_2D 
    176          DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 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_r14273_HPC-02_Daley_Tiling/src/OCE/ZDF/zdfsh2.F90

    r14776 r14805  
    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      ! 

  • NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/ZDF/zdfswm.F90

    r14776 r14805  
    6363      ! 
    6464      zcoef = 1._wp * 0.353553_wp 
    65       DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 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_r14273_HPC-02_Daley_Tiling/src/OCE/ZDF/zdftke.F90

    r14776 r14805  
    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( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     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( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )        ! 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( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )     ! 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)) ) 
    … …  
    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             IF (nn_hls==1) 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( nn_hls, nn_hls, nn_hls, nn_hls ) 
     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( nn_hls, nn_hls, nn_hls, nn_hls, 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( nn_hls, nn_hls, nn_hls, nn_hls ) 
     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 
    … …  
    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( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 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( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 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( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 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( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )    ! 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( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     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) 
    … …  
    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( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )                          ! 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( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 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( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 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( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 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( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     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( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 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      ! 
    … …  
    660660      !                     !  Vertical eddy viscosity and diffusivity  (avm and avt) 
    661661      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    662       DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 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( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 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_r14273_HPC-02_Daley_Tiling/src/OCE/do_loop_substitute.h90

    r14776 r14805  
    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_r14273_HPC-02_Daley_Tiling/src/OCE/module_example.F90

    r14776 r14805  
    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'  ) 

  • NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/nemogcm.F90

    r14776 r14805  
    390390      CALL mpp_init 
    391391 
    392 #if ! defined key_qco && ! defined key_linssh 
    393       IF( nn_hls == 2 ) THEN 
    394          CALL ctl_stop( 'STOP', 'nemogcm : Extra-halo can not be used if key_qco is not defined' ) 
    395       ENDIF 
    396 #endif 
    397392#if defined key_loop_fusion 
    398393      IF( nn_hls == 1 ) THEN 

  • NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/par_oce.F90

    r14776 r14805  
    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_r14273_HPC-02_Daley_Tiling/src/OCE/step.F90

    r14776 r14805  
    169169 
    170170      !  VERTICAL PHYSICS 
     171      ! lbc_lnk needed for zdf_sh2 when using nn_hls = 2, moved here to allow tiling in zdf_phy 
     172      IF( nn_hls == 2 .AND. l_zdfsh2 ) CALL lbc_lnk( 'stp', avm_k, 'W', 1.0_wp ) 
     173 
     174      IF( ln_tile ) CALL dom_tile_start         ! [tiling] ZDF tiling loop 
     175      DO jtile = 1, nijtile 
     176         IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile ) 
     177 
    171178                         CALL zdf_phy( kstp, Nbb, Nnn, Nrhs )   ! vertical physics update (top/bot drag, avt, avs, avm + MLD) 
     179      END DO 
     180      IF( ln_tile ) CALL dom_tile_stop 
    172181 
    173182      !  LATERAL  PHYSICS 
    … …  
    176185                         CALL eos( ts(:,:,:,:,Nbb), rhd, gdept_0(:,:,:) )               ! before in situ density 
    177186 
    178          IF( ln_zps .AND. .NOT. ln_isfcav)                                    & 
     187      IF( ln_zps .AND. .NOT. ln_isfcav)                                    & 
    179188            &            CALL zps_hde    ( kstp, Nnn, jpts, ts(:,:,:,:,Nbb), gtsu, gtsv,  &  ! Partial steps: before horizontal gradient 
    180189            &                                          rhd, gru , grv    )       ! of t, s, rd at the last ocean level 
    181190 
    182          IF( ln_zps .AND.       ln_isfcav)                                                & 
     191      IF( ln_zps .AND.       ln_isfcav)                                                & 
    183192            &            CALL zps_hde_isf( kstp, Nnn, jpts, ts(:,:,:,:,Nbb), gtsu, gtsv, gtui, gtvi,  &  ! Partial steps for top cell (ISF) 
    184193            &                                          rhd, gru , grv , grui, grvi   )       ! of t, s, rd at the first ocean level 
    … …  
    208217                         vv(:,:,:,Nrhs) = 0._wp 
    209218 
    210       IF(  lk_asminc .AND. ln_asmiau .AND. ln_dyninc )   & 
    211                &         CALL dyn_asm_inc   ( kstp, Nbb, Nnn, uu, vv, Nrhs )  ! apply dynamics assimilation increment 
    212       IF( ln_bdy     )   CALL bdy_dyn3d_dmp ( kstp, Nbb,      uu, vv, Nrhs )  ! bdy damping trends 
    213 #if defined key_agrif 
     219      IF( ln_tile ) CALL dom_tile_start         ! [tiling] DYN tiling loop (1) 
     220      DO jtile = 1, nijtile 
     221         IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile ) 
     222 
     223         IF(  lk_asminc .AND. ln_asmiau .AND. ln_dyninc )   & 
     224                  &         CALL dyn_asm_inc   ( kstp, Nbb, Nnn, uu, vv, Nrhs )  ! apply dynamics assimilation increment 
     225         IF( ln_bdy     )   CALL bdy_dyn3d_dmp ( kstp, Nbb,      uu, vv, Nrhs )  ! bdy damping trends 
     226#if defined key_agrif 
     227      END DO 
     228      IF( ln_tile ) CALL dom_tile_stop 
     229 
    214230      IF(.NOT. Agrif_Root())  & 
    215231               &         CALL Agrif_Sponge_dyn        ! momentum sponge 
    216 #endif 
    217                          CALL dyn_adv( kstp, Nbb, Nnn      , uu, vv, Nrhs )  ! advection (VF or FF)   ==> RHS 
    218                          CALL dyn_vor( kstp,      Nnn      , uu, vv, Nrhs )  ! vorticity              ==> RHS 
    219                          CALL dyn_ldf( kstp, Nbb, Nnn      , uu, vv, Nrhs )  ! lateral mixing 
    220       IF( ln_zdfosm  )   CALL dyn_osm( kstp,      Nnn      , uu, vv, Nrhs )  ! OSMOSIS non-local velocity fluxes ==> RHS 
    221                          CALL dyn_hpg( kstp,      Nnn      , uu, vv, Nrhs )  ! horizontal gradient of Hydrostatic pressure 
    222                          CALL dyn_spg( kstp, Nbb, Nnn, Nrhs, uu, vv, ssh, uu_b, vv_b, Naa )  ! surface pressure gradient 
     232 
     233      IF( ln_tile ) CALL dom_tile_start         ! [tiling] DYN tiling loop (1, continued) 
     234      DO jtile = 1, nijtile 
     235         IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile ) 
     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      END DO 
     243      IF( ln_tile ) CALL dom_tile_stop 
     244 
     245                            CALL dyn_spg( kstp, Nbb, Nnn, Nrhs, uu, vv, ssh, uu_b, vv_b, Naa )  ! surface pressure gradient 
    223246 
    224247                                                      ! With split-explicit free surface, since now transports have been updated and ssh(:,:,Nrhs) as well 
    225248      IF( ln_dynspg_ts ) THEN                         ! vertical scale factors and vertical velocity need to be updated 
    226                             CALL div_hor       ( kstp, Nbb, Nnn )                ! Horizontal divergence  (2nd call in time-split case) 
    227          IF(.NOT.ln_linssh) CALL dom_vvl_sf_nxt( kstp, Nbb, Nnn, Naa, kcall=2 )  ! after vertical scale factors (update depth average component) 
    228       ENDIF 
    229                             CALL dyn_zdf    ( kstp, Nbb, Nnn, Nrhs, uu, vv, Naa  )  ! vertical diffusion 
     249         IF( ln_tile ) CALL dom_tile_start      ! [tiling] DYN tiling loop (2- div_hor only) 
     250         DO jtile = 1, nijtile 
     251            IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile ) 
     252 
     253                             CALL div_hor       ( kstp, Nbb, Nnn )               ! Horizontal divergence  (2nd call in time-split case) 
     254         END DO 
     255         IF( ln_tile ) CALL dom_tile_stop 
     256 
     257         IF(.NOT. ln_linssh) CALL dom_vvl_sf_nxt( kstp, Nbb, Nnn, Naa, kcall=2 )  ! after vertical scale factors (update depth average component) 
     258      ENDIF 
     259 
     260      IF( ln_tile ) CALL dom_tile_start         ! [tiling] DYN tiling loop (3- dyn_zdf only) 
     261      DO jtile = 1, nijtile 
     262         IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile ) 
     263 
     264                               CALL dyn_zdf    ( kstp, Nbb, Nnn, Nrhs, uu, vv, Naa  )  ! vertical diffusion 
     265      END DO 
     266      IF( ln_tile ) CALL dom_tile_stop 
     267 
    230268      IF( ln_dynspg_ts ) THEN                                                       ! vertical scale factors and vertical velocity need to be updated 
    231269                            CALL wzv        ( kstp, Nbb, Nnn, Naa, ww )             ! Nnn cross-level velocity 
    … …  
    263301      ! Active tracers 
    264302      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    265       ! Loop over tile domains 
    266       DO jtile = 1, nijtile 
    267          IF( ln_tile    )   CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile ) 
    268  
    269          DO_3D( 0, 0, 0, 0, 1, jpk ) 
    270             ts(ji,jj,jk,:,Nrhs) = 0._wp                                   ! set tracer trends to zero 
    271          END_3D 
     303                         ts(:,:,:,:,Nrhs) = 0._wp         ! set tracer trends to zero 
     304 
     305      IF( ln_tile ) CALL dom_tile_start         ! [tiling] TRA tiling loop (1) 
     306      DO jtile = 1, nijtile 
     307         IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile ) 
    272308 
    273309         IF(  lk_asminc .AND. ln_asmiau .AND. & 
    … …  
    281317         IF( ln_bdy     )   CALL bdy_tra_dmp( kstp, Nbb,      ts, Nrhs )  ! bdy damping trends 
    282318      END DO 
     319      IF( ln_tile ) CALL dom_tile_stop 
    283320 
    284321#if defined key_agrif 
    285322      IF(.NOT. Agrif_Root() )   THEN 
    286          IF( ln_tile    )   CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) 
    287323                            CALL Agrif_Sponge_tra        ! tracers sponge 
    288324      ENDIF 
    … …  
    290326 
    291327      ! TEMP: [tiling] Separate loop over tile domains (due to tra_adv workarounds for tiling) 
    292       DO jtile = 1, nijtile 
    293          IF( ln_tile    )   CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile ) 
     328      IF( ln_tile ) CALL dom_tile_start         ! [tiling] TRA tiling loop (2) 
     329      DO jtile = 1, nijtile 
     330         IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile ) 
    294331 
    295332                            CALL tra_adv    ( kstp, Nbb, Nnn, ts, Nrhs )  ! hor. + vert. advection ==> RHS 
    … …  
    304341         IF( ln_zdfnpc  )   CALL tra_npc    ( kstp,      Nnn, Nrhs, ts, Naa  )  ! update after fields by non-penetrative convection 
    305342      END DO 
    306  
    307       IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) ! Revert to tile over full domain 
     343      IF( ln_tile ) CALL dom_tile_stop 
     344 
    308345      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    309346      ! Set boundary conditions, time filter and swap time levels 

  • NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/stpmlf.F90

    r14776 r14805  
    176176 
    177177      !  VERTICAL PHYSICS 
     178      IF( ln_tile ) CALL dom_tile_start         ! [tiling] ZDF tiling loop 
     179      DO jtile = 1, nijtile 
     180         IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile ) 
    178181                         CALL zdf_phy( kstp, Nbb, Nnn, Nrhs )   ! vertical physics update (top/bot drag, avt, avs, avm + MLD) 
     182      END DO 
     183      IF( ln_tile ) CALL dom_tile_stop 
    179184 
    180185      !  LATERAL  PHYSICS 
    … …  
    183188                         CALL eos( ts(:,:,:,:,Nbb), rhd, gdept_0(:,:,:) )               ! before in situ density 
    184189 
    185          IF( ln_zps .AND. .NOT. ln_isfcav)                                    & 
     190      IF( ln_zps .AND. .NOT. ln_isfcav)                                    & 
    186191            &            CALL zps_hde    ( kstp, Nnn, jpts, ts(:,:,:,:,Nbb), gtsu, gtsv,  &  ! Partial steps: before horizontal gradient 
    187192            &                                          rhd, gru , grv    )       ! of t, s, rd at the last ocean level 
    188193 
    189          IF( ln_zps .AND.       ln_isfcav)                                                & 
     194      IF( ln_zps .AND.       ln_isfcav)                                                & 
    190195            &            CALL zps_hde_isf( kstp, Nnn, jpts, ts(:,:,:,:,Nbb), gtsu, gtsv, gtui, gtvi,  &  ! Partial steps for top cell (ISF) 
    191196            &                                          rhd, gru , grv , grui, grvi   )       ! of t, s, rd at the first ocean level 
    … …  
    222227                         vv(:,:,:,Nrhs) = 0._wp 
    223228 
    224       IF(  lk_asminc .AND. ln_asmiau .AND. ln_dyninc )   & 
    225                &         CALL dyn_asm_inc   ( kstp, Nbb, Nnn, uu, vv, Nrhs )  ! apply dynamics assimilation increment 
    226       IF( ln_bdy     )   CALL bdy_dyn3d_dmp ( kstp, Nbb,      uu, vv, Nrhs )  ! bdy damping trends 
    227 #if defined key_agrif 
     229      IF( ln_tile ) CALL dom_tile_start         ! [tiling] DYN tiling loop (1) 
     230      DO jtile = 1, nijtile 
     231         IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile ) 
     232 
     233         IF(  lk_asminc .AND. ln_asmiau .AND. ln_dyninc )   & 
     234                  &         CALL dyn_asm_inc   ( kstp, Nbb, Nnn, uu, vv, Nrhs )  ! apply dynamics assimilation increment 
     235         IF( ln_bdy     )   CALL bdy_dyn3d_dmp ( kstp, Nbb,      uu, vv, Nrhs )  ! bdy damping trends 
     236#if defined key_agrif 
     237      END DO 
     238      IF( ln_tile ) CALL dom_tile_stop 
     239 
    228240      IF(.NOT. Agrif_Root())  & 
    229241               &         CALL Agrif_Sponge_dyn        ! momentum sponge 
    230 #endif 
    231                          CALL dyn_adv( kstp, Nbb, Nnn      , uu, vv, Nrhs )  ! advection (VF or FF)   ==> RHS 
    232                          CALL dyn_vor( kstp,      Nnn      , uu, vv, Nrhs )  ! vorticity              ==> RHS 
    233                          CALL dyn_ldf( kstp, Nbb, Nnn      , uu, vv, Nrhs )  ! lateral mixing 
    234       IF( ln_zdfosm  )   CALL dyn_osm( kstp,      Nnn      , uu, vv, Nrhs )  ! OSMOSIS non-local velocity fluxes ==> RHS 
    235  
    236                          CALL dyn_hpg( kstp,      Nnn      , uu, vv, Nrhs )  ! horizontal gradient of Hydrostatic pressure 
    237                          CALL dyn_spg( kstp, Nbb, Nnn, Nrhs, uu, vv, ssh, uu_b, vv_b, Naa )  ! surface pressure gradient 
    238                           
    239       IF( ln_dynspg_ts ) THEN      ! With split-explicit free surface, since now transports have been updated and ssh(:,:,Nrhs) 
    240                                    ! as well as vertical scale factors and vertical velocity need to be updated 
    241                             CALL div_hor    ( kstp, Nbb, Nnn )                ! Horizontal divergence  (2nd call in time-split case) 
    242          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  
    243       ENDIF 
     242 
     243      IF( ln_tile ) CALL dom_tile_start         ! [tiling] DYN tiling loop (1, continued) 
     244      DO jtile = 1, nijtile 
     245         IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile ) 
     246#endif 
     247                            CALL dyn_adv( kstp, Nbb, Nnn      , uu, vv, Nrhs )  ! advection (VF or FF)   ==> RHS 
     248                            CALL dyn_vor( kstp,      Nnn      , uu, vv, Nrhs )  ! vorticity              ==> RHS 
     249                            CALL dyn_ldf( kstp, Nbb, Nnn      , uu, vv, Nrhs )  ! lateral mixing 
     250         IF( ln_zdfosm  )   CALL dyn_osm( kstp,      Nnn      , uu, vv, Nrhs )  ! OSMOSIS non-local velocity fluxes ==> RHS 
     251                            CALL dyn_hpg( kstp,      Nnn      , uu, vv, Nrhs )  ! horizontal gradient of Hydrostatic pressure 
     252      END DO 
     253      IF( ln_tile ) CALL dom_tile_stop 
     254 
     255                            CALL dyn_spg( kstp, Nbb, Nnn, Nrhs, uu, vv, ssh, uu_b, vv_b, Naa )  ! surface pressure gradient 
     256 
     257      IF( ln_tile ) CALL dom_tile_start         ! [tiling] DYN tiling loop (2) 
     258      DO jtile = 1, nijtile 
     259         IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile ) 
     260 
     261         IF( ln_dynspg_ts ) THEN      ! With split-explicit free surface, since now transports have been updated and ssh(:,:,Nrhs) 
     262                                      ! as well as vertical scale factors and vertical velocity need to be updated 
     263                            CALL div_hor    ( kstp, Nbb, Nnn )                  ! Horizontal divergence  (2nd call in time-split case) 
     264            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 
     265         ENDIF 
    244266                            CALL dyn_zdf    ( kstp, Nbb, Nnn, Nrhs, uu, vv, Naa  )  ! vertical diffusion 
     267      END DO 
     268      IF( ln_tile ) CALL dom_tile_stop 
     269 
    245270      IF( ln_dynspg_ts ) THEN                                                       ! vertical scale factors and vertical velocity need to be updated 
    246271                            CALL wzv        ( kstp, Nbb, Nnn, Naa, ww )             ! Nnn cross-level velocity 
    … …  
    248273      ENDIF 
    249274 
    250       IF(nn_hls==2.AND..NOT.lk_linssh) CALL lbc_lnk( 'stp_MLF', r3u(:,:,Naa), 'U', 1.0_wp, r3v(:,:,Naa), 'V', 1.0_wp ) 
    251275 
    252276      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    … …  
    274298                         CALL ssh_atf    ( kstp, Nbb, Nnn, Naa, ssh )            ! time filtering of "now" sea surface height 
    275299      IF(.NOT.lk_linssh) CALL dom_qco_r3c( ssh(:,:,Nnn), r3t_f, r3u_f, r3v_f )   ! "now" ssh/h_0 ratio from filtrered ssh 
    276       ! 
    277       IF(nn_hls==2.AND..NOT.lk_linssh) CALL lbc_lnk( 'stp_MLF', r3u_f, 'U', 1.0_wp, r3v_f, 'V', 1.0_wp, r3t_f, 'T', 1.0_wp ) 
    278300#if defined key_top 
    279301      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    … …  
    286308      ! Active tracers 
    287309      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    288       ! Loop over tile domains 
     310                         ts(:,:,:,:,Nrhs) = 0._wp         ! set tracer trends to zero 
     311 
     312      IF( ln_tile ) CALL dom_tile_start         ! [tiling] TRA tiling loop (1) 
    289313      DO jtile = 1, nijtile 
    290          IF( ln_tile    )   CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile ) 
    291  
    292          DO_3D( 0, 0, 0, 0, 1, jpk ) 
    293             ts(ji,jj,jk,:,Nrhs) = 0._wp                                   ! set tracer trends to zero 
    294          END_3D 
     314         IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile ) 
    295315 
    296316         IF(  lk_asminc .AND. ln_asmiau .AND. & 
    … …  
    304324         IF( ln_bdy     )   CALL bdy_tra_dmp( kstp, Nbb,      ts, Nrhs )  ! bdy damping trends 
    305325      END DO 
     326      IF( ln_tile ) CALL dom_tile_stop 
    306327 
    307328#if defined key_agrif 
    308329      IF(.NOT. Agrif_Root() ) THEN 
    309          IF( ln_tile    )   CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) 
    310330                            CALL Agrif_Sponge_tra        ! tracers sponge 
    311331      ENDIF 
    … …  
    313333 
    314334      ! TEMP: [tiling] Separate loop over tile domains (due to tra_adv workarounds for tiling) 
     335      IF( ln_tile ) CALL dom_tile_start         ! [tiling] TRA tiling loop (2) 
    315336      DO jtile = 1, nijtile 
    316          IF( ln_tile    )  CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile ) 
     337         IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = jtile ) 
    317338 
    318339                            CALL tra_adv    ( kstp, Nbb, Nnn, ts, Nrhs )  ! hor. + vert. advection ==> RHS 
    … …  
    327348         IF( ln_zdfnpc  )   CALL tra_npc    ( kstp,      Nnn, Nrhs, ts, Naa  )  ! update after fields by non-penetrative convection 
    328349      END DO 
    329  
    330       IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) ! Revert to tile over full domain 
     350      IF( ln_tile ) CALL dom_tile_stop 
     351 
    331352      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    332353      ! Set boundary conditions, time filter and swap time levels 
    … …  
    349370                         CALL tra_atf_qco   ( kstp, Nbb, Nnn, Naa        , ts )   ! time filtering of "now" tracer arrays 
    350371                         CALL dyn_atf_qco   ( kstp, Nbb, Nnn, Naa, uu, vv     )   ! time filtering of "now" velocities 
    351  
    352       IF( nn_hls==2)   CALL lbc_lnk( 'stp_MLF', ts(:,:,:,jp_tem,Nnn), 'T', 1._wp, ts(:,:,:,jp_sal,Nnn), 'T', 1._wp) 
    353  
    354372      IF(.NOT.lk_linssh) THEN 
    355373                         r3t(:,:,Nnn) = r3t_f(:,:)                                ! update now ssh/h_0 with time filtered values 
    … …  
    517535                       &          , pts(:,:,:,jp_tem,Kaa), 'T',  1., pts(:,:,:,jp_sal,Kaa), 'T',  1. ) 
    518536      ! 
    519       IF (nn_hls==2) THEN 
    520          IF( l_zdfsh2 ) THEN 
    521             CALL lbc_lnk( 'stp_MLF', avm_k, 'W', 1.0_wp)  
    522          ENDIF 
     537      ! lbc_lnk needed for zdf_sh2 when using nn_hls = 2, moved here to allow tiling in zdf_phy 
     538      IF( nn_hls == 2 .AND. l_zdfsh2 ) CALL lbc_lnk( 'stp', avm_k, 'W', 1.0_wp ) 
     539 
     540      ! dom_qco_r3c defines over [nn_hls, nn_hls-1, nn_hls, nn_hls-1] 
     541      IF( nn_hls == 2 .AND. .NOT. lk_linssh ) THEN 
     542         CALL lbc_lnk( 'finalize_lbc', r3u(:,:,Kaa), 'U', 1._wp, r3v(:,:,Kaa), 'V', 1._wp, & 
     543            &                          r3u_f(:,:),   'U', 1._wp, r3v_f(:,:),   'V', 1._wp ) 
    523544      ENDIF 
    524545      !                                        !* BDY open boundaries 

  • NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/timing.F90

    r14776 r14805  
    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. 
Note: See TracChangeset for help on using the changeset viewer.