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@14787 – NEMO

Ignore:
Location:
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE
Files:
77 edited

Legend:

Unmodified
Added
Removed

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

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

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

    r14776 r14787  
    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 r14787  
    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 r14787  
    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 r14787  
    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 r14787  
    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 r14787  
    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 r14787  
    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 r14787  
    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 r14787  
    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 r14787  
    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 r14787  
    3636 
    3737   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   !  -      - 
    4138 
    4239   !! * Substitutions 
    … …  
    5451      !!                  ***  ROUTINE dyn_ldf_iso_alloc  *** 
    5552      !!---------------------------------------------------------------------- 
    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.') 
     53      dyn_ldf_iso_alloc = 0 
     54      IF( .NOT. ALLOCATED( akzu ) ) THEN 
     55         ALLOCATE( akzu(jpi,jpj,jpk), akzv(jpi,jpj,jpk), STAT=dyn_ldf_iso_alloc ) 
     56            ! 
     57         IF( dyn_ldf_iso_alloc /= 0 )   CALL ctl_warn('dyn_ldf_iso_alloc: array allocate failed.') 
     58      ENDIF 
    6059   END FUNCTION dyn_ldf_iso_alloc 
    6160 
    … …  
    112111      REAL(wp) ::   zabe2, zmskf, zmkf, zvav, zvwslpi, zvwslpj   !   -      - 
    113112      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  !  -      - 
     113      REAL(wp), DIMENSION(A2D(nn_hls))      ::   ziut, zivf, zdku, zdk1u  ! 2D workspace 
     114      REAL(wp), DIMENSION(A2D(nn_hls))      ::   zjuf, zjvt, zdkv, zdk1v  !  -      - 
     115      REAL(wp), DIMENSION(A1Di(nn_hls),jpk) ::   zfuw, zdiu, zdju, zdj1u  !  -      - 
     116      REAL(wp), DIMENSION(A1Di(nn_hls),jpk) ::   zfvw, zdiv, zdjv, zdj1v  !  -      - 
    116117      !!---------------------------------------------------------------------- 
    117118      ! 
    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') 
     119      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     120         IF( kt == nit000 ) THEN 
     121            IF(lwp) WRITE(numout,*) 
     122            IF(lwp) WRITE(numout,*) 'dyn_ldf_iso : iso-neutral laplacian diffusive operator or ' 
     123            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   s-coordinate horizontal diffusive operator' 
     124            !                                      ! allocate dyn_ldf_iso arrays 
     125            IF( dyn_ldf_iso_alloc() /= 0 )   CALL ctl_stop('STOP', 'dyn_ldf_iso: failed to allocate arrays') 
     126         ENDIF 
    124127      ENDIF 
    125128 
    … …  
    128131      IF( ln_dynldf_hor .AND. ln_traldf_iso ) THEN 
    129132         ! 
    130          DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk )      ! set the slopes of iso-level  
     133         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk )      ! set the slopes of iso-level 
    131134            uslp (ji,jj,jk) = - ( gdept(ji+1,jj,jk,Kbb) - gdept(ji ,jj ,jk,Kbb) ) * r1_e1u(ji,jj) * umask(ji,jj,jk) 
    132135            vslp (ji,jj,jk) = - ( gdept(ji,jj+1,jk,Kbb) - gdept(ji ,jj ,jk,Kbb) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk) 
    … …  
    135138         END_3D 
    136139         ! 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 ) 
     140         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 ) 
    138141         ! 
    139        ENDIF 
     142      ENDIF 
    140143          
    141144      zaht_0 = 0.5_wp * rn_Ud * rn_Ld                  ! aht_0 from namtra_ldf = zaht_max 
    … …  
    150153         !                             zdkv(jk=1)=zdkv(jk=2) 
    151154 
    152          zdk1u(:,:) = ( puu(:,:,jk,Kbb) -puu(:,:,jk+1,Kbb) ) * umask(:,:,jk+1) 
    153          zdk1v(:,:) = ( pvv(:,:,jk,Kbb) -pvv(:,:,jk+1,Kbb) ) * vmask(:,:,jk+1) 
     155         DO_2D( 1, 1, 1, 1 ) 
     156            zdk1u(ji,jj) = ( puu(ji,jj,jk,Kbb) -puu(ji,jj,jk+1,Kbb) ) * umask(ji,jj,jk+1) 
     157            zdk1v(ji,jj) = ( pvv(ji,jj,jk,Kbb) -pvv(ji,jj,jk+1,Kbb) ) * vmask(ji,jj,jk+1) 
     158         END_2D 
    154159 
    155160         IF( jk == 1 ) THEN 
    … …  
    157162            zdkv(:,:) = zdk1v(:,:) 
    158163         ELSE 
    159             zdku(:,:) = ( puu(:,:,jk-1,Kbb) - puu(:,:,jk,Kbb) ) * umask(:,:,jk) 
    160             zdkv(:,:) = ( pvv(:,:,jk-1,Kbb) - pvv(:,:,jk,Kbb) ) * vmask(:,:,jk) 
     164            DO_2D( 1, 1, 1, 1 ) 
     165               zdku(ji,jj) = ( puu(ji,jj,jk-1,Kbb) - puu(ji,jj,jk,Kbb) ) * umask(ji,jj,jk) 
     166               zdkv(ji,jj) = ( pvv(ji,jj,jk-1,Kbb) - pvv(ji,jj,jk,Kbb) ) * vmask(ji,jj,jk) 
     167            END_2D 
    161168         ENDIF 
    162169 
    … …  
    286293 
    287294      !                                                ! =============== 
    288       DO jj = 2, jpjm1                                 !  Vertical slab 
     295      DO jj = ntsj, ntej                               !  Vertical slab 
    289296         !                                             ! =============== 
    290297 
    … …  
    299306 
    300307         DO jk = 1, jpk 
    301             DO ji = 2, jpi 
     308            DO ji = ntsi, ntei + nn_hls 
    302309               ! i-gradient of u at jj 
    303310               zdiu (ji,jk) = tmask(ji,jj  ,jk) * ( puu(ji,jj  ,jk,Kbb) - puu(ji-1,jj  ,jk,Kbb) ) 
    … …  
    311318         END DO 
    312319         DO jk = 1, jpk 
    313             DO ji = 1, jpim1 
     320            DO ji = ntsi - nn_hls, ntei 
    314321               ! i-gradient of v at jj 
    315322               zdiv (ji,jk) = fmask(ji,jj  ,jk) * ( pvv(ji+1,jj,jk,Kbb) - pvv(ji  ,jj  ,jk,Kbb) ) 
    … …  
    322329 
    323330         ! Surface and bottom vertical fluxes set to zero 
    324          DO ji = 1, jpi 
     331         DO ji = ntsi - nn_hls, ntei + nn_hls 
    325332            zfuw(ji, 1 ) = 0.e0 
    326333            zfvw(ji, 1 ) = 0.e0 
    … …  
    331338         ! interior (2=<jk=<jpk-1) on U field 
    332339         DO jk = 2, jpkm1 
    333             DO ji = 2, jpim1 
     340            DO ji = ntsi, ntei 
    334341               zcof0 = 0.5_wp * zaht_0 * umask(ji,jj,jk) 
    335342               ! 
    … …  
    357364         ! interior (2=<jk=<jpk-1) on V field 
    358365         DO jk = 2, jpkm1 
    359             DO ji = 2, jpim1 
     366            DO ji = ntsi, ntei 
    360367               zcof0 = 0.5_wp * zaht_0 * vmask(ji,jj,jk) 
    361368               ! 
    … …  
    385392         ! ------------------------------------------------------------------- 
    386393         DO jk = 1, jpkm1 
    387             DO ji = 2, jpim1 
     394            DO ji = ntsi, ntei 
    388395               puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + ( zfuw(ji,jk) - zfuw(ji,jk+1) ) * r1_e1e2u(ji,jj)   & 
    389396                  &               / e3u(ji,jj,jk,Kmm) 

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

    r14776 r14787  
    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  
    … …  
    3940 
    4041   SUBROUTINE dyn_ldf_lap( kt, Kbb, Kmm, pu, pv, pu_rhs, pv_rhs, kpass ) 
     42      !! 
     43      INTEGER                   , INTENT(in   ) ::   kt               ! ocean time-step index 
     44      INTEGER                   , INTENT(in   ) ::   Kbb, Kmm         ! ocean time level indices 
     45      INTEGER                   , INTENT(in   ) ::   kpass            ! =1/2 first or second passage 
     46      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pu, pv           ! before velocity  [m/s] 
     47      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pu_rhs, pv_rhs   ! velocity trend   [m/s2] 
     48      !! 
     49      CALL dyn_ldf_lap_t( kt, Kbb, Kmm, pu, pv, is_tile(pu), pu_rhs, pv_rhs, is_tile(pu_rhs), kpass ) 
     50   END SUBROUTINE dyn_ldf_lap 
     51 
     52 
     53   SUBROUTINE dyn_ldf_lap_t( kt, Kbb, Kmm, pu, pv, ktuv, pu_rhs, pv_rhs, ktuv_rhs, kpass ) 
    4154      !!---------------------------------------------------------------------- 
    4255      !!                     ***  ROUTINE dyn_ldf_lap  *** 
    … …  
    5265      !! Reference : S.Griffies, R.Hallberg 2000 Mon.Wea.Rev., DOI:/  
    5366      !!---------------------------------------------------------------------- 
    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] 
     67      INTEGER                                 , INTENT(in   ) ::   kt               ! ocean time-step index 
     68      INTEGER                                 , INTENT(in   ) ::   Kbb, Kmm         ! ocean time level indices 
     69      INTEGER                                 , INTENT(in   ) ::   kpass            ! =1/2 first or second passage 
     70      INTEGER                                 , INTENT(in   ) ::   ktuv, ktuv_rhs 
     71      REAL(wp), DIMENSION(A2D_T(ktuv)    ,JPK), INTENT(in   ) ::   pu, pv           ! before velocity  [m/s] 
     72      REAL(wp), DIMENSION(A2D_T(ktuv_rhs),JPK), INTENT(inout) ::   pu_rhs, pv_rhs   ! velocity trend   [m/s2] 
    5973      ! 
    6074      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     75      INTEGER  ::   iij 
    6176      REAL(wp) ::   zsign        ! local scalars 
    6277      REAL(wp) ::   zua, zva     ! local scalars 
    … …  
    6580      !!---------------------------------------------------------------------- 
    6681      ! 
    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,*) '~~~~~~~ ' 
     82      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     83         IF( kt == nit000 .AND. lwp ) THEN 
     84            WRITE(numout,*) 
     85            WRITE(numout,*) 'dyn_ldf : iso-level harmonic (laplacian) operator, pass=', kpass 
     86            WRITE(numout,*) '~~~~~~~ ' 
     87         ENDIF 
     88      ENDIF 
     89      ! 
     90      ! Define pu_rhs/pv_rhs halo points for multi-point haloes in bilaplacian case 
     91      IF( nldf_dyn == np_blp .AND. kpass == 1 ) THEN ; iij = nn_hls 
     92      ELSE                                           ; iij = 1 
    7193      ENDIF 
    7294      ! 
    … …  
    79101      CASE ( np_typ_rot )       !==  Vorticity-Divergence operator  ==! 
    80102         ! 
    81          ALLOCATE( zcur(jpi,jpj) , zdiv(jpi,jpj) ) 
     103         ALLOCATE( zcur(A2D(nn_hls)) , zdiv(A2D(nn_hls)) ) 
    82104         ! 
    83105         DO jk = 1, jpkm1                                 ! Horizontal slab 
    84106            ! 
    85             DO_2D( nn_hls-1, nn_hls, nn_hls-1, nn_hls ) 
     107            DO_2D( iij-1, iij, iij-1, iij ) 
    86108               !                                      ! ahm * e3 * curl  (computed from 1 to jpim1/jpjm1) 
    87109               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 
    … …  
    94116            END_2D 
    95117            ! 
    96             DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )                       ! - curl( curl) + grad( div ) 
     118            DO_2D( iij-1, iij-1, iij-1, iij-1 )   ! - curl( curl) + grad( div ) 
    97119               pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * umask(ji,jj,jk) * (    &    ! * by umask is mandatory for dyn_ldf_blp use 
    98120                  &              - ( zcur(ji  ,jj) - zcur(ji,jj-1) ) * r1_e2u(ji,jj) / e3u(ji,jj,jk,Kmm)   & 
    … …  
    110132      CASE ( np_typ_sym )       !==  Symmetric operator  ==! 
    111133         ! 
    112          ALLOCATE( zten(jpi,jpj) , zshe(jpi,jpj) ) 
     134         ALLOCATE( zten(A2D(nn_hls)) , zshe(A2D(nn_hls)) ) 
    113135         ! 
    114136         DO jk = 1, jpkm1                                 ! Horizontal slab 
    115137            ! 
    116             DO_2D( nn_hls-1, nn_hls, nn_hls-1, nn_hls ) 
     138            DO_2D( iij-1, iij, iij-1, iij ) 
    117139               !                                      ! shearing stress component (F-point)   NB : ahmf has already been multiplied by fmask 
    118140               zshe(ji-1,jj-1) = ahmf(ji-1,jj-1,jk)                                                              & 
    … …  
    129151            END_2D 
    130152            ! 
    131             DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     153            DO_2D( iij-1, iij-1, iij-1, iij-1 ) 
    132154               pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm)                               & 
    133155                  &    * (   (   zten(ji+1,jj  ) * e2t(ji+1,jj  )*e2t(ji+1,jj  ) * e3t(ji+1,jj  ,jk,Kmm)                       & 
    … …  
    150172      END SELECT 
    151173      ! 
    152    END SUBROUTINE dyn_ldf_lap 
     174   END SUBROUTINE dyn_ldf_lap_t 
    153175 
    154176 
    … …  
    171193      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu_rhs, pv_rhs   ! momentum trend 
    172194      ! 
    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,*) '~~~~~~~~~~~~' 
     195      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zulap, zvlap   ! laplacian at u- and v-point 
     196      !!---------------------------------------------------------------------- 
     197      ! 
     198      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     199         IF( kt == nit000 )  THEN 
     200            IF(lwp) WRITE(numout,*) 
     201            IF(lwp) WRITE(numout,*) 'dyn_ldf_blp : bilaplacian operator momentum ' 
     202            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 
     203         ENDIF 
    180204      ENDIF 
    181205      ! 

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

    r14776 r14787  
    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))       ::   zwx , zwy , z1_e3f 
     628      REAL(wp), DIMENSION(A2D(nn_hls))       ::   ztnw, ztne, ztsw, ztse 
     629      REAL(wp), DIMENSION(A2D(nn_hls),jpkm1) ::   zwz   ! 3D workspace, jpkm1 -> jpkm1 -> avoid lbc_lnk on jpk that is not defined 
     630      !!---------------------------------------------------------------------- 
     631      ! 
     632      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     633         IF( kt == nit000 ) THEN 
     634            IF(lwp) WRITE(numout,*) 
     635            IF(lwp) WRITE(numout,*) 'dyn:vor_een : vorticity term: energy and enstrophy conserving scheme' 
     636            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
     637         ENDIF 
    620638      ENDIF 
    621639      ! 
    … …  
    632650         CASE ( 0 )                                   ! original formulation  (masked averaging of e3t divided by 4) 
    633651            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)  ) 
     652               ! NOTE: [halo1-halo2] brackets added to make results independent of nn_hls 
     653               ze3f = (  (e3t(ji  ,jj+1,jk,Kmm)*tmask(ji  ,jj+1,jk)    & 
     654                  &    +  e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk))   & 
     655                  &    + (e3t(ji  ,jj  ,jk,Kmm)*tmask(ji  ,jj  ,jk)    & 
     656                  &    +  e3t(ji+1,jj  ,jk,Kmm)*tmask(ji+1,jj  ,jk))  ) 
    638657               IF( ze3f /= 0._wp ) THEN   ;   z1_e3f(ji,jj) = 4._wp / ze3f 
    639658               ELSE                       ;   z1_e3f(ji,jj) = 0._wp 
    … …  
    642661         CASE ( 1 )                                   ! new formulation  (masked averaging of e3t divided by the sum of mask) 
    643662            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)  ) 
     663               ! NOTE: [halo1-halo2] brackets added to make results independent of nn_hls 
     664               ze3f = (  (e3t(ji  ,jj+1,jk,Kmm)*tmask(ji  ,jj+1,jk)    & 
     665                  &    +  e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk))   & 
     666                  &    + (e3t(ji  ,jj  ,jk,Kmm)*tmask(ji  ,jj  ,jk)    & 
     667                  &    +  e3t(ji+1,jj  ,jk,Kmm)*tmask(ji+1,jj  ,jk))  ) 
    648668               zmsk = (                    tmask(ji,jj+1,jk) +                     tmask(ji+1,jj+1,jk)   & 
    649669                  &                      + tmask(ji,jj  ,jk) +                     tmask(ji+1,jj  ,jk)  ) 
    … …  
    710730         ! 
    711731         !                                   !==  horizontal fluxes  ==! 
    712          zwx(:,:) = e2u(:,:) * e3u(:,:,jk,Kmm) * pu(:,:,jk) 
    713          zwy(:,:) = e1v(:,:) * e3v(:,:,jk,Kmm) * pv(:,:,jk) 
     732         DO_2D( 1, 1, 1, 1 ) 
     733            zwx(ji,jj) = e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * pu(ji,jj,jk) 
     734            zwy(ji,jj) = e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * pv(ji,jj,jk) 
     735         END_2D 
    714736         ! 
    715737         !                                   !==  compute and add the vorticity term trend  =! 
    … …  
    762784      REAL(wp) ::   zua, zva       ! local scalars 
    763785      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,*) '~~~~~~~~~~~' 
     786      REAL(wp), DIMENSION(A2D(nn_hls))       ::   zwx , zwy 
     787      REAL(wp), DIMENSION(A2D(nn_hls))       ::   ztnw, ztne, ztsw, ztse 
     788      REAL(wp), DIMENSION(A2D(nn_hls),jpkm1) ::   zwz   ! 3D workspace, avoid lbc_lnk on jpk that is not defined 
     789      !!---------------------------------------------------------------------- 
     790      ! 
     791      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     792         IF( kt == nit000 ) THEN 
     793            IF(lwp) WRITE(numout,*) 
     794            IF(lwp) WRITE(numout,*) 'dyn:vor_eeT : vorticity term: energy and enstrophy conserving scheme' 
     795            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
     796         ENDIF 
    773797      ENDIF 
    774798      ! 
    … …  
    785809         CASE ( np_RVO )                           !* relative vorticity 
    786810            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)  ) & 
     811               ! NOTE: [halo1-halo2] brackets added to make results independent of nn_hls 
     812               zwz(ji,jj,jk) = (  (e2v(ji+1,jj  ) * pv(ji+1,jj  ,jk) - e2v(ji,jj) * pv(ji,jj,jk))    & 
     813                  &             - (e1u(ji  ,jj+1) * pu(ji  ,jj+1,jk) - e1u(ji,jj) * pu(ji,jj,jk))  ) & 
    789814                  &          * r1_e1e2f(ji,jj) 
    790815            END_2D 
    … …  
    801826         CASE ( np_CRV )                           !* Coriolis + relative vorticity 
    802827            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)    ) 
     828               ! NOTE: [halo1-halo2] brackets added to make results independent of nn_hls 
     829               zwz(ji,jj,jk) = (  ff_f(ji,jj) + (  (e2v(ji+1,jj  ) * pv(ji+1,jj  ,jk) - e2v(ji,jj) * pv(ji,jj,jk))    & 
     830                  &                              - (e1u(ji  ,jj+1) * pu(ji  ,jj+1,jk) - e1u(ji,jj) * pu(ji,jj,jk))  ) & 
     831                  &                           * r1_e1e2f(ji,jj)    ) 
    806832            END_2D 
    807833            IF( ln_dynvor_msk ) THEN                     ! mask the relative vorticity 
    … …  
    830856         ! 
    831857         !                                   !==  horizontal fluxes  ==! 
    832          zwx(:,:) = e2u(:,:) * e3u(:,:,jk,Kmm) * pu(:,:,jk) 
    833          zwy(:,:) = e1v(:,:) * e3v(:,:,jk,Kmm) * pv(:,:,jk) 
     858         DO_2D( 1, 1, 1, 1 ) 
     859            zwx(ji,jj) = e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * pu(ji,jj,jk) 
     860            zwy(ji,jj) = e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * pv(ji,jj,jk) 
     861         END_2D 
    834862         ! 
    835863         !                                   !==  compute and add the vorticity term trend  =! 

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

    r14776 r14787  
    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 r14787  
    7878      REAL(wp) ::   zWui, zWvi         !   -      - 
    7979      REAL(wp) ::   zWus, zWvs         !   -      - 
    80       REAL(wp), DIMENSION(jpi,jpj,jpk)        ::  zwi, zwd, zws   ! 3D workspace  
     80      REAL(wp), DIMENSION(A2D(nn_hls),jpk)        ::  zwi, zwd, zws   ! 3D workspace 
    8181      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdu, ztrdv   !  -      - 
    8282      !!--------------------------------------------------------------------- 
    … …  
    8484      IF( ln_timing )   CALL timing_start('dyn_zdf') 
    8585      ! 
    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 
     86      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     87         IF( kt == nit000 ) THEN       !* initialization 
     88            IF(lwp) WRITE(numout,*) 
     89            IF(lwp) WRITE(numout,*) 'dyn_zdf_imp : vertical momentum diffusion implicit operator' 
     90            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ ' 
     91            ! 
     92            If( ln_linssh ) THEN   ;    r_vvl = 0._wp    ! non-linear free surface indicator 
     93            ELSE                   ;    r_vvl = 1._wp 
     94            ENDIF 
    9395         ENDIF 
    9496      ENDIF 

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

    r14776 r14787  
    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 r14787  
    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 r14787  
    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 r14787  
    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 r14787  
    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/LBC/lbc_lnk_neicoll_generic.h90

    r14776 r14787  
    2626      INTEGER, DIMENSION(8)  ::   isizej, ishtSj, ishtRj, ishtPj 
    2727      INTEGER, DIMENSION(8)  ::   ifill, iszall 
    28       INTEGER, DIMENSION(8)  ::   jnf 
    2928      INTEGER, DIMENSION(:), ALLOCATABLE  ::   iScnt, iRcnt    ! number of elements to be sent/received 
    3029      INTEGER, DIMENSION(:), ALLOCATABLE  ::   iSdpl, iRdpl    ! displacement in halos arrays 
    … …  
    193192      ! 
    194193      idx = 1 
    195       ! MPI3 bug fix when domain decomposition has 2 columns/rows 
    196       IF (jpni .eq. 2) THEN 
    197          IF (jpnj .eq. 2) THEN 
    198             jnf(1:8) = (/ 2, 1, 4, 3, 8, 7, 6, 5 /) 
    199          ELSE 
    200             jnf(1:8) = (/ 2, 1, 3, 4, 6, 5, 8, 7 /) 
    201          ENDIF 
    202       ELSE 
    203          IF (jpnj .eq. 2) THEN 
    204             jnf(1:8) = (/ 1, 2, 4, 3, 7, 8, 5, 6 /) 
    205          ELSE 
    206             jnf(1:8) = (/ 1, 2, 3, 4, 5, 6, 7, 8 /) 
    207          ENDIF 
    208       ENDIF 
    209  
    210194      DO jn = 1, 8 
    211          ishti = ishtRi(jnf(jn)) 
    212          ishtj = ishtRj(jnf(jn)) 
    213          SELECT CASE ( ifill(jnf(jn)) ) 
     195         ishti = ishtRi(jn) 
     196         ishtj = ishtRj(jn) 
     197         SELECT CASE ( ifill(jn) ) 
    214198         CASE ( jpfillnothing )               ! no filling  
    215199         CASE ( jpfillmpi   )                 ! fill with data received by MPI 
    216             DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jnf(jn))  ;  DO ji = 1,isizei(jnf(jn)) 
     200            DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn) 
    217201               ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = BUFFRCV(idx) 
    218202               idx = idx + 1 
    219203            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    220204         CASE ( jpfillperio )                 ! use periodicity 
    221             ishti2 = ishtPi(jnf(jn)) 
    222             ishtj2 = ishtPj(jnf(jn)) 
    223             DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jnf(jn))  ;  DO ji = 1,isizei(jnf(jn)) 
     205            ishti2 = ishtPi(jn) 
     206            ishtj2 = ishtPj(jn) 
     207            DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn) 
    224208               ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl) 
    225209            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    226210         CASE ( jpfillcopy  )                 ! filling with inner domain values 
    227             ishti2 = ishtSi(jnf(jn)) 
    228             ishtj2 = ishtSj(jnf(jn)) 
    229             DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jnf(jn))  ;  DO ji = 1,isizei(jnf(jn)) 
     211            ishti2 = ishtSi(jn) 
     212            ishtj2 = ishtSj(jn) 
     213            DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn) 
    230214               ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl) 
    231215            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    232216         CASE ( jpfillcst   )                 ! filling with constant value 
    233             DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jnf(jn))  ;  DO ji = 1,isizei(jnf(jn)) 
     217            DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn) 
    234218               ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = zland 
    235219            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 

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

    r14776 r14787  
    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 r14787  
    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 r14787  
    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 r14787  
    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 r14787  
    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 r14787  
    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 r14787  
    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 
    … …  
    9393      ! 
    9494      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) 
     95      ! 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 
    9696      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: zuu, zvv, zww   ! 3D workspace 
    9797      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdt, ztrds 
    98       ! TEMP: [tiling] This change not necessary after extra haloes development 
     98      ! TEMP: [tiling] This change not necessary after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct 
    9999      LOGICAL :: lskip 
    100100      !!---------------------------------------------------------------------- 
    … …  
    104104      lskip = .FALSE. 
    105105 
    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 
     106      ! TEMP: [tiling] These changes not necessary after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct 
     107      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
    108108         ALLOCATE( zuu(jpi,jpj,jpk), zvv(jpi,jpj,jpk), zww(jpi,jpj,jpk) ) 
    109109      ENDIF 
    110110 
    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 
     111      ! TEMP: [tiling] These changes not necessary after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct 
     112      IF( ln_tile .AND. nadv == np_FCT )  THEN 
     113         IF( ntile == 1 ) THEN 
     114            CALL dom_tile_stop( ldhold=.TRUE. ) 
     115         ELSE 
     116            lskip = .TRUE. 
    119117         ENDIF 
    120118      ENDIF 
    … …  
    122120         !                                         !==  effective transport  ==! 
    123121         IF( ln_wave .AND. ln_sdw )  THEN 
    124             DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
     122            DO_3D_OVR( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) 
    125123               zuu(ji,jj,jk) = e2u  (ji,jj) * e3u(ji,jj,jk,Kmm) * ( uu(ji,jj,jk,Kmm) + usd(ji,jj,jk) ) 
    126124               zvv(ji,jj,jk) = e1v  (ji,jj) * e3v(ji,jj,jk,Kmm) * ( vv(ji,jj,jk,Kmm) + vsd(ji,jj,jk) ) 
    … …  
    128126            END_3D 
    129127         ELSE 
    130             DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
     128            DO_3D_OVR( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) 
    131129               zuu(ji,jj,jk) = e2u  (ji,jj) * e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm)               ! eulerian transport only 
    132130               zvv(ji,jj,jk) = e1v  (ji,jj) * e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) 
    … …  
    136134         ! 
    137135         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 ) 
     136            DO_3D_OVR( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) 
    139137               zuu(ji,jj,jk) = zuu(ji,jj,jk) + un_td(ji,jj,jk) 
    140138               zvv(ji,jj,jk) = zvv(ji,jj,jk) + vn_td(ji,jj,jk) 
    … …  
    142140         ENDIF 
    143141         ! 
    144          DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     142         DO_2D_OVR( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    145143            zuu(ji,jj,jpk) = 0._wp                                                      ! no transport trough the bottom 
    146144            zvv(ji,jj,jpk) = 0._wp 
    … …  
    148146         END_2D 
    149147         ! 
    150          ! TEMP: [tiling] These changes not necessary if using XIOS (subdomain support) 
    151148         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 
     149            &              CALL ldf_eiv_trp( kt, nit000, zuu, zvv, zww, 'TRA', Kmm, Krhs )   ! add the eiv transport (if necessary) 
     150         ! 
     151         IF( ln_mle    )   CALL tra_mle_trp( kt, nit000, zuu, zvv, zww, 'TRA', Kmm       )   ! add the mle transport (if necessary) 
     152         ! 
     153         ! TEMP: [tiling] This change not necessary after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct 
     154         IF( .NOT. l_istiled .OR. ntile == nijtile )  THEN                ! Do only on the last tile 
    160155            CALL iom_put( "uocetr_eff", zuu )                                        ! output effective transport 
    161156            CALL iom_put( "vocetr_eff", zvv ) 
    … …  
    163158         ENDIF 
    164159         ! 
    165    !!gm ??? 
    166          ! TEMP: [tiling] This change not necessary if using XIOS (subdomain support) 
     160!!gm ??? 
     161         ! TEMP: [tiling] This copy-in not necessary after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct 
    167162         CALL dia_ptr( kt, Kmm, zvv(A2D(nn_hls),:) )                                    ! diagnose the effective MSF 
    168    !!gm ??? 
     163!!gm ??? 
    169164         ! 
    170165 
    … …  
    216211         ENDIF 
    217212 
    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  
     213         ! TEMP: [tiling] This change not necessary after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct 
     214         IF( ln_tile .AND. .NOT. l_istiled ) CALL dom_tile_start( ldhold=.TRUE. ) 
    221215      ENDIF 
    222216      !                                              ! print mean trends (used for debugging) 
    … …  
    224218         &                                  tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    225219 
    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 
     220      ! TEMP: [tiling] This change not necessary after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct 
     221      IF( .NOT. l_istiled .OR. ntile == nijtile )  THEN                ! Do only for the full domain 
    228222         DEALLOCATE( zuu, zvv, zww ) 
    229223      ENDIF 
    … …  
    297291        CALL ctl_stop( 'tra_adv_init: FCT scheme, choose 2nd or 4th order' ) 
    298292      ENDIF 
     293      ! TEMP: [tiling] This change not necessary after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct 
     294      IF( ln_traadv_fct .AND. ln_tile ) THEN 
     295         CALL ctl_warn( 'tra_adv_init: FCT scheme does not yet work with tiling' ) 
     296      ENDIF 
    299297      IF( ln_traadv_ubs .AND. ( nn_ubs_v /= 2 .AND. nn_ubs_v /= 4 )   ) THEN     ! UBS 
    300298        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 r14787  
    7171      INTEGER                                  , INTENT(in   ) ::   kn_cen_h        ! =2/4 (2nd or 4th order scheme) 
    7272      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) 
     73      ! TEMP: [tiling] This can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct 
    7474      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume flux components 
    7575      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation 
    … …  
    8282      !!---------------------------------------------------------------------- 
    8383      ! 
    84       IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     84      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
    8585         IF( kt == kit000 )  THEN 
    8686            IF(lwp) WRITE(numout,*) 
    … …  
    119119               ztv(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) 
    120120            END_3D 
    121             IF (nn_hls==1) CALL lbc_lnk( 'traadv_cen', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp, ld4only= .TRUE. )   ! Lateral boundary cond. 
     121            IF (nn_hls==1) CALL lbc_lnk( 'traadv_cen', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp )   ! Lateral boundary cond. 
    122122            ! 
    123123            DO_3D( nn_hls-1, 0, nn_hls-1, 0, 1, jpkm1 )           ! Horizontal advective fluxes 

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

    r14776 r14787  
    8181      INTEGER                                  , INTENT(in   ) ::   kn_fct_v        ! order of the FCT scheme (=2 or 4) 
    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 
    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 
    … …  
    9595      !!---------------------------------------------------------------------- 
    9696      ! 
    97       IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     97      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
    9898         IF( kt == kit000 )  THEN 
    9999            IF(lwp) WRITE(numout,*) 
    … …  
    136136      ! If adaptive vertical advection, check if it is needed on this PE at this time 
    137137      IF( ln_zad_Aimp ) THEN 
    138          IF( MAXVAL( ABS( wi(A2D(nn_hls),:) ) ) > 0._wp ) ll_zAimp = .TRUE. 
     138         IF( MAXVAL( ABS( wi(A2D(1),:) ) ) > 0._wp ) ll_zAimp = .TRUE. 
    139139      END IF 
    140140      ! If active adaptive vertical advection, build tridiagonal matrix 
    … …  
    239239            END DO 
    240240            ! NOTE [ comm_cleanup ] : need to change sign to ensure halo 1 - halo 2 compatibility 
    241             CALL lbc_lnk( 'traadv_fct', zltu, 'T', -1.0_wp , zltv, 'T', -1.0_wp, ld4only= .TRUE. )   ! Lateral boundary cond. (unchanged sgn) 
     241            CALL lbc_lnk( 'traadv_fct', zltu, 'T', -1.0_wp , zltv, 'T', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
    242242            ! 
    243243            DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) 
    … …  
    262262               ztv(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) 
    263263            END_3D 
    264             IF (nn_hls==1) CALL lbc_lnk( 'traadv_fct', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp, ld4only= .TRUE. )   ! Lateral boundary cond. (unchanged sgn) 
     264            IF (nn_hls==1) CALL lbc_lnk( 'traadv_fct', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
    265265            ! 
    266266            DO_3D( 0, 0, 0, 0, 1, jpkm1 )    ! Horizontal advective fluxes 
    … …  
    455455         END_2D 
    456456      END DO 
    457       IF (nn_hls==1) CALL lbc_lnk( 'traadv_fct', zbetup, 'T', 1.0_wp , zbetdo, 'T', 1.0_wp, ld4only= .TRUE. )   ! lateral boundary cond. (unchanged sign) 
     457      IF (nn_hls==1) CALL lbc_lnk( 'traadv_fct', zbetup, 'T', 1.0_wp , zbetdo, 'T', 1.0_wp )   ! lateral boundary cond. (unchanged sign) 
    458458 
    459459      ! 3. monotonic flux in the i & j direction (paa & pbb) 

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

    r14776 r14787  
    270270               END_2D 
    271271            END DO 
    272             IF(nn_hls .EQ. 1) THEN 
    273                CALL lbc_lnk( 'traadv_fct', zltu_3d, 'T', 1.0_wp , zltv_3d, 'T', 1.0_wp, ld4only= .TRUE. )   ! Lateral boundary cond. (unchanged sgn) 
    274             ELSE 
    275                CALL lbc_lnk( 'traadv_fct', zltu_3d, 'T', 1.0_wp , zltv_3d, 'T', 1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
    276             ENDIF 
     272            CALL lbc_lnk( 'traadv_fct', zltu_3d, 'T', 1.0_wp , zltv_3d, 'T', 1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
    277273!            ! 
    278274            DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) 

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

    r14776 r14787  
    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 r14787  
    9191      INTEGER                                  , INTENT(in   ) ::   kjpt            ! number of tracers 
    9292      REAL(wp)                                 , INTENT(in   ) ::   p2dt            ! tracer time-step 
    93       ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support) 
     93      ! TEMP: [tiling] This can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct 
    9494      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume transport components 
    9595      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation 
    9696      !!---------------------------------------------------------------------- 
    9797      ! 
    98       IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     98      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
    9999         IF( kt == kit000 )  THEN 
    100100            IF(lwp) WRITE(numout,*) 
    … …  
    129129      INTEGER                                  , INTENT(in   ) ::   kjpt       ! number of tracers 
    130130      REAL(wp)                                 , INTENT(in   ) ::   p2dt       ! tracer time-step 
    131       ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support) 
     131      ! TEMP: [tiling] This can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct 
    132132      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU        ! i-velocity components 
    133133      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! active tracers and RHS of tracer equation 
    … …  
    149149            zfd(ji,jj,jk) = pt(ji+1,jj,jk,jn,Kbb)        ! Downstream in the x-direction for the tracer 
    150150         END_3D 
    151          IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, ld4only= .TRUE. )   ! Lateral boundary conditions 
     151         IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp )   ! Lateral boundary conditions 
    152152 
    153153         ! 
    … …  
    176176            zfu(ji,jj,jk) = tmask(ji-1,jj,jk) + tmask(ji,jj,jk) + tmask(ji+1,jj,jk) - 2. 
    177177         END_3D 
    178          IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp, ld4only= .TRUE. )      ! Lateral boundary conditions 
     178         IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp )      ! Lateral boundary conditions 
    179179 
    180180         ! 
    … …  
    214214      INTEGER                                  , INTENT(in   ) ::   kjpt       ! number of tracers 
    215215      REAL(wp)                                 , INTENT(in   ) ::   p2dt       ! tracer time-step 
    216       ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support) 
     216      ! TEMP: [tiling] This can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct 
    217217      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pV        ! j-velocity components 
    218218      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! active tracers and RHS of tracer equation 
    … …  
    229229         zfd(:,:,:) = 0.0     ;   zwy(:,:,:) = 0.0 
    230230         ! 
    231          DO jk = 1, jpkm1 
    232             ! 
    233             !--- Computation of the ustream and downstream value of the tracer and the mask 
    234             DO_2D( 0, 0, nn_hls-1, nn_hls-1 ) 
    235                ! Upstream in the x-direction for the tracer 
    236                zfc(ji,jj,jk) = pt(ji,jj-1,jk,jn,Kbb) 
    237                ! Downstream in the x-direction for the tracer 
    238                zfd(ji,jj,jk) = pt(ji,jj+1,jk,jn,Kbb) 
    239             END_2D 
    240          END DO 
    241          IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, ld4only= .TRUE. )   ! Lateral boundary conditions 
     231         !--- Computation of the ustream and downstream value of the tracer and the mask 
     232         DO_3D( 0, 0, nn_hls-1, nn_hls-1, 1, jpkm1 ) 
     233            ! Upstream in the x-direction for the tracer 
     234            zfc(ji,jj,jk) = pt(ji,jj-1,jk,jn,Kbb) 
     235            ! Downstream in the x-direction for the tracer 
     236            zfd(ji,jj,jk) = pt(ji,jj+1,jk,jn,Kbb) 
     237         END_3D 
     238 
     239         IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp )   ! Lateral boundary conditions 
    242240 
    243241         ! 
    … …  
    268266            zfu(ji,jj,jk) = tmask(ji,jj-1,jk) + tmask(ji,jj,jk) + tmask(ji,jj+1,jk) - 2. 
    269267         END_3D 
    270          IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp, ld4only= .TRUE. )    !--- Lateral boundary conditions 
     268         IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp )    !--- Lateral boundary conditions 
    271269         ! 
    272270         ! Tracer flux on the x-direction 
    … …  
    306304      CHARACTER(len=3)                         , INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator) 
    307305      INTEGER                                  , INTENT(in   ) ::   kjpt     ! number of tracers 
    308       ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support) 
     306      ! TEMP: [tiling] This can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct 
    309307      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pW      ! vertical velocity 
    310308      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! active tracers and RHS of tracer equation 
    … …  
    365363      !---------------------------------------------------------------------- 
    366364      ! 
    367       DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
     365      DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 
    368366         zc     = puc(ji,jj,jk)                         ! Courant number 
    369367         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 r14787  
    9292      INTEGER                                  , INTENT(in   ) ::   kn_ubs_v        ! number of tracers 
    9393      REAL(wp)                                 , INTENT(in   ) ::   p2dt            ! tracer time-step 
    94       ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support) 
     94      ! TEMP: [tiling] This can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct 
    9595      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume transport components 
    9696      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation 
    … …  
    103103      !!---------------------------------------------------------------------- 
    104104      ! 
    105       IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     105      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
    106106         IF( kt == kit000 )  THEN 
    107107            IF(lwp) WRITE(numout,*) 
    … …  
    140140            ! 
    141141         END DO 
    142          IF (nn_hls==1) CALL lbc_lnk( 'traadv_ubs', zltu, 'T', 1.0_wp, zltv, 'T', 1.0_wp, ld4only= .TRUE. )   ! Lateral boundary cond. (unchanged sgn) 
     142         IF (nn_hls==1) CALL lbc_lnk( 'traadv_ubs', zltu, 'T', 1.0_wp, zltv, 'T', 1.0_wp )   ! Lateral boundary cond. (unchanged sgn) 
    143143         ! 
    144144         DO_3D( 1, 0, 1, 0, 1, jpkm1 )   !==  Horizontal advective fluxes  ==!     (UBS) 

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

    r14776 r14787  
    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 r14787  
    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 r14787  
    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 r14787  
    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 r14787  
    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 r14787  
    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 r14787  
    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 r14787  
    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 r14787  
    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 r14787  
    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 r14787  
    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 r14787  
    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 r14787  
    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 r14787  
    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 r14787  
    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 r14787  
    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 r14787  
    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 r14787  
    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 r14787  
    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 r14787  
    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 r14787  
    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 r14787  
    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 r14787  
    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 r14787  
    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 r14787  
    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 r14787  
    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 r14787  
    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 r14787  
    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 r14787  
    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 r14787  
    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 r14787  
    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 r14787  
    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 r14787  
    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 r14787  
    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.