From e0e6ed971cbd344bb592973ee166334cda03ae57 Mon Sep 17 00:00:00 2001
From: Sebastien Masson <sebastien.masson@locean.ipsl.fr>
Date: Tue, 26 Jul 2022 08:12:51 +0000
Subject: [PATCH] Resolve "summer 2022 work- LBC halo cleanup"
---
src/ICE/icectl.F90 | 4 +-
src/NST/agrif_oce_interp.F90 | 116 ++---
src/NST/agrif_oce_sponge.F90 | 56 +--
src/NST/agrif_oce_update.F90 | 4 +-
src/NST/agrif_user.F90 | 12 +-
src/OCE/BDY/bdyini.F90 | 34 +-
src/OCE/DIA/diadct.F90 | 6 +-
src/OCE/DOM/dom_oce.F90 | 116 +++--
src/OCE/DOM/domvvl.F90 | 4 +-
src/OCE/DOM/domzgr.F90 | 8 +-
src/OCE/DOM/dtatsd.F90 | 14 +-
src/OCE/DYN/sshwzv.F90 | 16 +-
src/OCE/FLO/floblk.F90 | 8 +-
src/OCE/FLO/flodom.F90 | 4 +-
src/OCE/FLO/florst.F90 | 8 +-
src/OCE/FLO/flowri.F90 | 4 +-
src/OCE/ICB/icbclv.F90 | 4 +-
src/OCE/ICB/icbdyn.F90 | 8 +-
src/OCE/ICB/icbini.F90 | 10 +-
src/OCE/ICB/icblbc.F90 | 34 +-
src/OCE/ICB/icbrst.F90 | 24 +-
src/OCE/ICB/icbthm.F90 | 4 +-
src/OCE/ICB/icbutl.F90 | 28 +-
src/OCE/IOM/iom.F90 | 20 +-
src/OCE/IOM/iom_nf90.F90 | 20 +-
src/OCE/IOM/prtctl.F90 | 10 +-
src/OCE/ISF/isfcpl.F90 | 7 +-
src/OCE/LBC/lbc_lnk_call_generic.h90 | 11 +-
src/OCE/LBC/lbc_lnk_neicoll_generic.h90 | 412 ++++++++++--------
src/OCE/LBC/lbc_lnk_pt2pt_generic.h90 | 378 +++++++++--------
src/OCE/LBC/lbc_nfd_generic.h90 | 375 ++++++++---------
src/OCE/LBC/lbclnk.F90 | 14 +-
src/OCE/LBC/lbcnfd.F90 | 17 +-
src/OCE/LBC/lib_mpp.F90 | 15 +-
src/OCE/LBC/mpp_lbc_north_icb_generic.h90 | 2 +-
src/OCE/LBC/mpp_lnk_icb_generic.h90 | 2 +-
src/OCE/LBC/mpp_loc_generic.h90 | 24 +-
src/OCE/LBC/mpp_nfd_generic.h90 | 491 ++++++++++------------
src/OCE/LBC/mppini.F90 | 197 ++++++---
src/OCE/OBS/mpp_map.F90 | 6 +-
src/OCE/OBS/obs_grd_bruteforce.h90 | 6 +-
src/OCE/OBS/obs_grid.F90 | 6 +-
src/OCE/OBS/obs_inter_sup.F90 | 4 +-
src/OCE/OBS/obs_write.F90 | 8 +-
src/OCE/SBC/cpl_oasis3.F90 | 10 +-
src/OCE/SBC/sbccpl.F90 | 2 +-
src/OCE/USR/usrdef_fmask.F90 | 28 +-
src/OCE/USR/usrdef_hgr.F90 | 4 +-
src/OCE/lib_fortran.F90 | 64 +--
src/OCE/stpctl.F90 | 2 +-
src/SAS/stpctl.F90 | 2 +-
src/SWE/stpctl.F90 | 2 +-
src/TOP/TRP/trcdmp.F90 | 8 +-
tests/ADIAB_WAVE/MY_SRC/usrdef_hgr.F90 | 8 +-
tests/ADIAB_WAVE/MY_SRC/usrdef_zgr.F90 | 7 +-
tests/BENCH/MY_SRC/usrdef_hgr.F90 | 6 +-
tests/BENCH/MY_SRC/usrdef_istate.F90 | 4 +-
tests/BENCH/MY_SRC/usrdef_sbc.F90 | 2 +-
tests/BENCH/MY_SRC/usrdef_zgr.F90 | 10 +-
tests/C1D_ASICS/MY_SRC/usrdef_nam.F90 | 1 -
tests/CANAL/MY_SRC/usrdef_hgr.F90 | 4 +-
tests/DIA_GPU/MY_SRC/stpctl.F90 | 2 +-
tests/DOME/MY_SRC/usrdef_hgr.F90 | 4 +-
tests/DOME/MY_SRC/usrdef_istate.F90 | 4 +-
tests/DOME/MY_SRC/usrdef_zgr.F90 | 3 +-
tests/ICB/MY_SRC/usrdef_nam.F90 | 1 -
tests/ICE_ADV1D/MY_SRC/usrdef_hgr.F90 | 4 +-
tests/ICE_ADV2D/MY_SRC/usrdef_hgr.F90 | 16 +-
tests/ICE_AGRIF/MY_SRC/usrdef_hgr.F90 | 16 +-
tests/ICE_RHEO/MY_SRC/icedyn_rhg_eap.F90 | 10 +-
tests/ICE_RHEO/MY_SRC/icedyn_rhg_evp.F90 | 10 +-
tests/ICE_RHEO/MY_SRC/usrdef_hgr.F90 | 12 +-
tests/ICE_RHEO/MY_SRC/usrdef_nam.F90 | 1 -
tests/ICE_RHEO/MY_SRC/usrdef_sbc.F90 | 10 +-
tests/ISOMIP/MY_SRC/usrdef_hgr.F90 | 8 +-
tests/ISOMIP/MY_SRC/usrdef_zgr.F90 | 5 +-
tests/LOCK_EXCHANGE/MY_SRC/usrdef_hgr.F90 | 8 +-
tests/OVERFLOW/MY_SRC/usrdef_hgr.F90 | 8 +-
tests/OVERFLOW/MY_SRC/usrdef_zgr.F90 | 7 +-
tests/STATION_ASF/MY_SRC/icesbc.F90 | 4 +-
tests/STATION_ASF/MY_SRC/stpctl.F90 | 2 +-
tests/STATION_ASF/MY_SRC/usrdef_hgr.F90 | 1 -
tests/STATION_ASF/MY_SRC/usrdef_nam.F90 | 1 -
tests/SWG/MY_SRC/usrdef_fmask.F90 | 28 +-
tests/SWG/MY_SRC/usrdef_nam.F90 | 1 -
tests/TSUNAMI/MY_SRC/usrdef_hgr.F90 | 4 +-
tests/VORTEX/MY_SRC/usrdef_hgr.F90 | 4 +-
tests/WAD/MY_SRC/usrdef_hgr.F90 | 8 +-
tests/WAD/MY_SRC/usrdef_istate.F90 | 9 +-
tests/WAD/MY_SRC/usrdef_zgr.F90 | 64 +--
90 files changed, 1534 insertions(+), 1436 deletions(-)
diff --git a/src/ICE/icectl.F90 b/src/ICE/icectl.F90
index 9593be4f8..78fb1563e 100644
--- a/src/ICE/icectl.F90
+++ b/src/ICE/icectl.F90
@@ -528,8 +528,8 @@ CONTAINS
INTEGER :: jl, ji, jj
!!-------------------------------------------------------------------
- DO ji = mi0(ki), mi1(ki)
- DO jj = mj0(kj), mj1(kj)
+ DO ji = mi0(ki,nn_hls), mi1(ki,nn_hls)
+ DO jj = mj0(kj,nn_hls), mj1(kj,nn_hls)
WRITE(numout,*) ' time step ',kt,' ',cd1 ! print title
diff --git a/src/NST/agrif_oce_interp.F90 b/src/NST/agrif_oce_interp.F90
index 326ecbbd0..6649f60b4 100644
--- a/src/NST/agrif_oce_interp.F90
+++ b/src/NST/agrif_oce_interp.F90
@@ -270,7 +270,7 @@ CONTAINS
ibdy2 = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhox() ! halo + land + nbghostcells
!
IF( .NOT.ln_dynspg_ts ) THEN ! Store transport
- DO ji = mi0(ibdy1), mi1(ibdy2)
+ DO ji = mi0(ibdy1,nn_hls), mi1(ibdy2,nn_hls)
DO jj = 1, jpj
uu_b(ji,jj,Krhs_a) = ubdy(ji,jj) * r1_hu(ji,jj,Krhs_a)
vv_b(ji,jj,Krhs_a) = vbdy(ji,jj) * r1_hv(ji,jj,Krhs_a)
@@ -278,7 +278,7 @@ CONTAINS
END DO
ENDIF
!
- DO ji = mi0(ibdy1), mi1(ibdy2)
+ DO ji = mi0(ibdy1,nn_hls), mi1(ibdy2,nn_hls)
zub(ji,:) = 0._wp
zhub(ji,:) = 0._wp
DO jk = 1, jpkm1
@@ -300,7 +300,7 @@ CONTAINS
END DO
END DO
!
- DO ji = mi0(ibdy1), mi1(ibdy2)
+ DO ji = mi0(ibdy1,nn_hls), mi1(ibdy2,nn_hls)
zvb(ji,:) = 0._wp
zhvb(ji,:) = 0._wp
DO jk = 1, jpkm1
@@ -330,14 +330,14 @@ CONTAINS
ibdy2 = jpiglo - ( nn_hls + 2 )
!
IF( .NOT.ln_dynspg_ts ) THEN
- DO ji = mi0(ibdy1), mi1(ibdy2)
+ DO ji = mi0(ibdy1,nn_hls), mi1(ibdy2,nn_hls)
DO jj = 1, jpj
uu_b(ji,jj,Krhs_a) = ubdy(ji,jj) * r1_hu(ji,jj,Krhs_a)
END DO
END DO
ENDIF
!
- DO ji = mi0(ibdy1), mi1(ibdy2)
+ DO ji = mi0(ibdy1,nn_hls), mi1(ibdy2,nn_hls)
zub(ji,:) = 0._wp
zhub(ji,:) = 0._wp
DO jk = 1, jpkm1
@@ -363,14 +363,14 @@ CONTAINS
ibdy2 = jpiglo - ( nn_hls + 1 )
!
IF( .NOT.ln_dynspg_ts ) THEN
- DO ji = mi0(ibdy1), mi1(ibdy2)
+ DO ji = mi0(ibdy1,nn_hls), mi1(ibdy2,nn_hls)
DO jj = 1, jpj
vv_b(ji,jj,Krhs_a) = vbdy(ji,jj) * r1_hv(ji,jj,Krhs_a)
END DO
END DO
ENDIF
!
- DO ji = mi0(ibdy1), mi1(ibdy2)
+ DO ji = mi0(ibdy1,nn_hls), mi1(ibdy2,nn_hls)
zvb(ji,:) = 0._wp
zhvb(ji,:) = 0._wp
DO jk = 1, jpkm1
@@ -400,7 +400,7 @@ CONTAINS
jbdy2 = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhoy()
!
IF( .NOT.ln_dynspg_ts ) THEN
- DO jj = mj0(jbdy1), mj1(jbdy2)
+ DO jj = mj0(jbdy1,nn_hls), mj1(jbdy2,nn_hls)
DO ji = 1, jpi
uu_b(ji,jj,Krhs_a) = ubdy(ji,jj) * r1_hu(ji,jj,Krhs_a)
vv_b(ji,jj,Krhs_a) = vbdy(ji,jj) * r1_hv(ji,jj,Krhs_a)
@@ -408,7 +408,7 @@ CONTAINS
END DO
ENDIF
!
- DO jj = mj0(jbdy1), mj1(jbdy2)
+ DO jj = mj0(jbdy1,nn_hls), mj1(jbdy2,nn_hls)
zvb(:,jj) = 0._wp
zhvb(:,jj) = 0._wp
DO jk=1,jpkm1
@@ -430,7 +430,7 @@ CONTAINS
END DO
END DO
!
- DO jj = mj0(jbdy1), mj1(jbdy2)
+ DO jj = mj0(jbdy1,nn_hls), mj1(jbdy2,nn_hls)
zub(:,jj) = 0._wp
zhub(:,jj) = 0._wp
DO jk = 1, jpkm1
@@ -460,14 +460,14 @@ CONTAINS
jbdy2 = jpjglo - ( nn_hls + 2 )
!
IF( .NOT.ln_dynspg_ts ) THEN
- DO jj = mj0(jbdy1), mj1(jbdy2)
+ DO jj = mj0(jbdy1,nn_hls), mj1(jbdy2,nn_hls)
DO ji = 1, jpi
vv_b(ji,jj,Krhs_a) = vbdy(ji,jj) * r1_hv(ji,jj,Krhs_a)
END DO
END DO
ENDIF
!
- DO jj = mj0(jbdy1), mj1(jbdy2)
+ DO jj = mj0(jbdy1,nn_hls), mj1(jbdy2,nn_hls)
zvb(:,jj) = 0._wp
zhvb(:,jj) = 0._wp
DO jk=1,jpkm1
@@ -493,14 +493,14 @@ CONTAINS
jbdy2 = jpjglo - ( nn_hls + 1 )
!
IF( .NOT.ln_dynspg_ts ) THEN
- DO jj = mj0(jbdy1), mj1(jbdy2)
+ DO jj = mj0(jbdy1,nn_hls), mj1(jbdy2,nn_hls)
DO ji = 1, jpi
uu_b(ji,jj,Krhs_a) = ubdy(ji,jj) * r1_hu(ji,jj,Krhs_a)
END DO
END DO
ENDIF
!
- DO jj = mj0(jbdy1), mj1(jbdy2)
+ DO jj = mj0(jbdy1,nn_hls), mj1(jbdy2,nn_hls)
zub(:,jj) = 0._wp
zhub(:,jj) = 0._wp
DO jk = 1, jpkm1
@@ -553,7 +553,7 @@ CONTAINS
IF( lk_west ) THEN
istart = nn_hls + 2 ! halo + land + 1
iend = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhox() ! halo + land + nbghostcells
- DO ji = mi0(istart), mi1(iend)
+ DO ji = mi0(istart,nn_hls), mi1(iend,nn_hls)
DO jj=1,jpj
va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj)
ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj)
@@ -565,7 +565,7 @@ CONTAINS
IF( lk_east ) THEN
istart = jpiglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhox()
iend = jpiglo - ( nn_hls + 1 )
- DO ji = mi0(istart), mi1(iend)
+ DO ji = mi0(istart,nn_hls), mi1(iend,nn_hls)
DO jj=1,jpj
va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj)
@@ -573,7 +573,7 @@ CONTAINS
END DO
istart = jpiglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhox()
iend = jpiglo - ( nn_hls + 2 )
- DO ji = mi0(istart), mi1(iend)
+ DO ji = mi0(istart,nn_hls), mi1(iend,nn_hls)
DO jj=1,jpj
ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj)
END DO
@@ -584,7 +584,7 @@ CONTAINS
IF( lk_south ) THEN
jstart = nn_hls + 2
jend = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhoy()
- DO jj = mj0(jstart), mj1(jend)
+ DO jj = mj0(jstart,nn_hls), mj1(jend,nn_hls)
DO ji=1,jpi
ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj)
@@ -597,14 +597,14 @@ CONTAINS
IF( lk_north ) THEN
jstart = jpjglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhoy()
jend = jpjglo - ( nn_hls + 1 )
- DO jj = mj0(jstart), mj1(jend)
+ DO jj = mj0(jstart,nn_hls), mj1(jend,nn_hls)
DO ji=1,jpi
ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj)
END DO
END DO
jstart = jpjglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhoy()
jend = jpjglo - ( nn_hls + 2 )
- DO jj = mj0(jstart), mj1(jend)
+ DO jj = mj0(jstart,nn_hls), mj1(jend,nn_hls)
DO ji=1,jpi
va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj)
END DO
@@ -642,7 +642,7 @@ CONTAINS
IF( lk_west ) THEN
istart = nn_hls + 2
iend = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhox()
- DO ji = mi0(istart), mi1(iend)
+ DO ji = mi0(istart,nn_hls), mi1(iend,nn_hls)
DO jj=1,jpj
zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj)
zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj)
@@ -654,14 +654,14 @@ CONTAINS
IF( lk_east ) THEN
istart = jpiglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhox()
iend = jpiglo - ( nn_hls + 1 )
- DO ji = mi0(istart), mi1(iend)
+ DO ji = mi0(istart,nn_hls), mi1(iend,nn_hls)
DO jj=1,jpj
zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj)
END DO
END DO
istart = jpiglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhox()
iend = jpiglo - ( nn_hls + 2 )
- DO ji = mi0(istart), mi1(iend)
+ DO ji = mi0(istart,nn_hls), mi1(iend,nn_hls)
DO jj=1,jpj
zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj)
END DO
@@ -672,7 +672,7 @@ CONTAINS
IF( lk_south ) THEN
jstart = nn_hls + 2
jend = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhoy()
- DO jj = mj0(jstart), mj1(jend)
+ DO jj = mj0(jstart,nn_hls), mj1(jend,nn_hls)
DO ji=1,jpi
zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj)
zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj)
@@ -684,14 +684,14 @@ CONTAINS
IF( lk_north ) THEN
jstart = jpjglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhoy()
jend = jpjglo - ( nn_hls + 1 )
- DO jj = mj0(jstart), mj1(jend)
+ DO jj = mj0(jstart,nn_hls), mj1(jend,nn_hls)
DO ji=1,jpi
zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj)
END DO
END DO
jstart = jpjglo - ( nn_hls + nbghostcells ) - nn_shift_bar*Agrif_Rhoy()
jend = jpjglo - ( nn_hls + 2 )
- DO jj = mj0(jstart), mj1(jend)
+ DO jj = mj0(jstart,nn_hls), mj1(jend,nn_hls)
DO ji=1,jpi
zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj)
END DO
@@ -801,7 +801,7 @@ CONTAINS
istart = nn_hls + 2 ! halo + land + 1
iend = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhox() ! halo + land + nbghostcells
IF (lk_div_cons) iend = istart
- DO ji = mi0(istart), mi1(iend)
+ DO ji = mi0(istart,nn_hls), mi1(iend,nn_hls)
DO jj = 1, jpj
ssh(ji,jj,Krhs_a) = hbdy(ji,jj)
END DO
@@ -813,7 +813,7 @@ CONTAINS
istart = jpiglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhox() ! halo + land + nbghostcells - 1
iend = jpiglo - ( nn_hls + 1 ) ! halo + land + 1 - 1
IF (lk_div_cons) istart = iend
- DO ji = mi0(istart), mi1(iend)
+ DO ji = mi0(istart,nn_hls), mi1(iend,nn_hls)
DO jj = 1, jpj
ssh(ji,jj,Krhs_a) = hbdy(ji,jj)
END DO
@@ -825,7 +825,7 @@ CONTAINS
jstart = nn_hls + 2 ! halo + land + 1
jend = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhoy() ! halo + land + nbghostcells
IF (lk_div_cons) jend = jstart
- DO jj = mj0(jstart), mj1(jend)
+ DO jj = mj0(jstart,nn_hls), mj1(jend,nn_hls)
DO ji = 1, jpi
ssh(ji,jj,Krhs_a) = hbdy(ji,jj)
END DO
@@ -837,7 +837,7 @@ CONTAINS
jstart = jpjglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhoy() ! halo + land + nbghostcells - 1
jend = jpjglo - ( nn_hls + 1 ) ! halo + land + 1 - 1
IF (lk_div_cons) jstart = jend
- DO jj = mj0(jstart), mj1(jend)
+ DO jj = mj0(jstart,nn_hls), mj1(jend,nn_hls)
DO ji = 1, jpi
ssh(ji,jj,Krhs_a) = hbdy(ji,jj)
END DO
@@ -870,7 +870,7 @@ CONTAINS
istart = nn_hls + 2 ! halo + land + 1
iend = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhox() ! halo + land + nbghostcells
IF (lk_div_cons) iend = istart
- DO ji = mi0(istart), mi1(iend)
+ DO ji = mi0(istart,nn_hls), mi1(iend,nn_hls)
DO jj = 1, jpj
ssha_e(ji,jj) = hbdy(ji,jj)
END DO
@@ -882,7 +882,7 @@ CONTAINS
istart = jpiglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhox() ! halo + land + nbghostcells - 1
iend = jpiglo - ( nn_hls + 1 ) ! halo + land + 1 - 1
IF (lk_div_cons) istart = iend
- DO ji = mi0(istart), mi1(iend)
+ DO ji = mi0(istart,nn_hls), mi1(iend,nn_hls)
DO jj = 1, jpj
ssha_e(ji,jj) = hbdy(ji,jj)
END DO
@@ -894,7 +894,7 @@ CONTAINS
jstart = nn_hls + 2 ! halo + land + 1
jend = nn_hls + nbghostcells + nn_shift_bar*Agrif_Rhoy() ! halo + land + nbghostcells
IF (lk_div_cons) jend = jstart
- DO jj = mj0(jstart), mj1(jend)
+ DO jj = mj0(jstart,nn_hls), mj1(jend,nn_hls)
DO ji = 1, jpi
ssha_e(ji,jj) = hbdy(ji,jj)
END DO
@@ -906,7 +906,7 @@ CONTAINS
jstart = jpjglo - ( nn_hls + nbghostcells -1 ) - nn_shift_bar*Agrif_Rhoy() ! halo + land + nbghostcells - 1
jend = jpjglo - ( nn_hls + 1 ) ! halo + land + 1 - 1
IF (lk_div_cons) jstart = jend
- DO jj = mj0(jstart), mj1(jend)
+ DO jj = mj0(jstart,nn_hls), mj1(jend,nn_hls)
DO ji = 1, jpi
ssha_e(ji,jj) = hbdy(ji,jj)
END DO
@@ -1551,7 +1551,7 @@ CONTAINS
DO ji=i1,i2
DO jj=j1,j2
IF (utint_stage(ji,jj)==0) THEN
- zx = 2._wp*MOD(ABS(mig0(ji)-nbghostcells_x_w), INT(Agrif_Rhox()))/zrhox - 1._wp
+ zx = 2._wp*MOD(ABS(mig(ji,0)-nbghostcells_x_w), INT(Agrif_Rhox()))/zrhox - 1._wp
ubdy(ji,jj) = ubdy(ji,jj) + 0.25_wp*(1._wp-zx*zx) * ptab(ji,jj) &
& / zrhoy *r1_e2u(ji,jj) * umask(ji,jj,1)
utint_stage(ji,jj) = 1
@@ -1671,7 +1671,7 @@ CONTAINS
DO ji=i1,i2
DO jj=j1,j2
IF (vtint_stage(ji,jj)==0) THEN
- zy = 2._wp*MOD(ABS(mjg0(jj)-nbghostcells_y_s), INT(Agrif_Rhoy()))/zrhoy - 1._wp
+ zy = 2._wp*MOD(ABS(mjg(jj,0)-nbghostcells_y_s), INT(Agrif_Rhoy()))/zrhoy - 1._wp
vbdy(ji,jj) = vbdy(ji,jj) + 0.25_wp*(1._wp-zy*zy) * ptab(ji,jj) &
& / zrhox * r1_e1v(ji,jj) * vmask(ji,jj,1)
vtint_stage(ji,jj) = 1
@@ -1755,7 +1755,7 @@ CONTAINS
DO jj = j1, j2
DO ji = i1, i2
IF( ABS( ptab(ji,jj) - glamt(ji,jj) ) > ztst ) THEN
- WRITE(numout,*) ' Agrif error for glamt: parent, child, i, j ', ptab(ji,jj), glamt(ji,jj), mig0(ji), mig0(jj)
+ WRITE(numout,*) ' Agrif error for glamt: parent, child, i, j ', ptab(ji,jj), glamt(ji,jj), mig(ji,0), mjg(jj,0)
! kindic_agr = kindic_agr + 1
ENDIF
END DO
@@ -1784,7 +1784,7 @@ CONTAINS
DO jj = j1, j2
DO ji = i1, i2
IF( ABS( ptab(ji,jj) - gphit(ji,jj) ) > ztst ) THEN
- WRITE(numout,*) ' Agrif error for gphit: parent, child, i, j ', ptab(ji,jj), gphit(ji,jj), mig0(ji), mig0(jj)
+ WRITE(numout,*) ' Agrif error for gphit: parent, child, i, j ', ptab(ji,jj), gphit(ji,jj), mig(ji,0), mjg(jj,0)
! kindic_agr = kindic_agr + 1
ENDIF
END DO
@@ -1999,8 +1999,8 @@ CONTAINS
iend = nn_hls + nbghostcells + ispon ! halo + land + nbghostcells + sponge
jstart = nn_hls + 2
jend = jpjglo - nn_hls - 1
- DO ji = mi0(istart), mi1(iend)
- DO jj = mj0(jstart), mj1(jend)
+ DO ji = mi0(istart,nn_hls), mi1(iend,nn_hls)
+ DO jj = mj0(jstart,nn_hls), mj1(jend,nn_hls)
IF ( ABS(ht0_parent(ji,jj)-ht_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
IF ( .NOT.ln_vert_remap) THEN
DO jk = 1, jpkm1
@@ -2008,7 +2008,7 @@ CONTAINS
END DO
ENDIF
END DO
- DO jj = mj0(jstart), mj1(jend-1)
+ DO jj = mj0(jstart,nn_hls), mj1(jend-1,nn_hls)
IF ( ABS(hv0_parent(ji,jj)-hv_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
IF ( .NOT.ln_vert_remap) THEN
DO jk = 1, jpkm1
@@ -2017,8 +2017,8 @@ CONTAINS
ENDIF
END DO
END DO
- DO ji = mi0(istart), mi1(iend-1)
- DO jj = mj0(jstart), mj1(jend)
+ DO ji = mi0(istart,nn_hls), mi1(iend-1,nn_hls)
+ DO jj = mj0(jstart,nn_hls), mj1(jend,nn_hls)
IF ( ABS(hu0_parent(ji,jj)-hu_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
IF ( .NOT.ln_vert_remap) THEN
DO jk = 1, jpkm1
@@ -2036,8 +2036,8 @@ CONTAINS
iend = jpiglo - nn_hls - 1 ! halo + land + 1 - 1
jstart = nn_hls + 2
jend = jpjglo - nn_hls - 1
- DO ji = mi0(istart), mi1(iend)
- DO jj = mj0(jstart), mj1(jend)
+ DO ji = mi0(istart,nn_hls), mi1(iend,nn_hls)
+ DO jj = mj0(jstart,nn_hls), mj1(jend,nn_hls)
IF ( ABS(ht0_parent(ji,jj)-ht_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
IF ( .NOT.ln_vert_remap) THEN
DO jk = 1, jpkm1
@@ -2045,7 +2045,7 @@ CONTAINS
END DO
ENDIF
END DO
- DO jj = mj0(jstart), mj1(jend-1)
+ DO jj = mj0(jstart,nn_hls), mj1(jend-1,nn_hls)
IF ( ABS(hv0_parent(ji,jj)-hv_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
IF ( .NOT.ln_vert_remap) THEN
DO jk = 1, jpkm1
@@ -2054,8 +2054,8 @@ CONTAINS
ENDIF
END DO
END DO
- DO ji = mi0(istart), mi1(iend-1)
- DO jj = mj0(jstart), mj1(jend)
+ DO ji = mi0(istart,nn_hls), mi1(iend-1,nn_hls)
+ DO jj = mj0(jstart,nn_hls), mj1(jend,nn_hls)
IF ( ABS(hu0_parent(ji,jj)-hu_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
IF ( .NOT.ln_vert_remap) THEN
DO jk = 1, jpkm1
@@ -2073,8 +2073,8 @@ CONTAINS
jend = nn_hls + nbghostcells + ispon ! halo + land + nbghostcells + sponge
istart = nn_hls + 2
iend = jpiglo - nn_hls - 1
- DO jj = mj0(jstart), mj1(jend)
- DO ji = mi0(istart), mi1(iend)
+ DO jj = mj0(jstart,nn_hls), mj1(jend,nn_hls)
+ DO ji = mi0(istart,nn_hls), mi1(iend,nn_hls)
IF ( ABS(ht0_parent(ji,jj)-ht_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
IF ( .NOT.ln_vert_remap) THEN
DO jk = 1, jpkm1
@@ -2082,7 +2082,7 @@ CONTAINS
END DO
ENDIF
END DO
- DO ji = mi0(istart), mi1(iend-1)
+ DO ji = mi0(istart,nn_hls), mi1(iend-1,nn_hls)
IF ( ABS(hu0_parent(ji,jj)-hu_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
IF ( .NOT.ln_vert_remap) THEN
DO jk = 1, jpkm1
@@ -2091,8 +2091,8 @@ CONTAINS
ENDIF
END DO
END DO
- DO jj = mj0(jstart), mj1(jend-1)
- DO ji = mi0(istart), mi1(iend)
+ DO jj = mj0(jstart,nn_hls), mj1(jend-1,nn_hls)
+ DO ji = mi0(istart,nn_hls), mi1(iend,nn_hls)
IF ( ABS(hv0_parent(ji,jj)-hv_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
IF ( .NOT.ln_vert_remap) THEN
DO jk = 1, jpkm1
@@ -2110,8 +2110,8 @@ CONTAINS
jend = jpjglo - nn_hls - 1 ! halo + land + 1 - 1
istart = nn_hls + 2
iend = jpiglo - nn_hls - 1
- DO jj = mj0(jstart), mj1(jend)
- DO ji = mi0(istart), mi1(iend)
+ DO jj = mj0(jstart,nn_hls), mj1(jend,nn_hls)
+ DO ji = mi0(istart,nn_hls), mi1(iend,nn_hls)
IF ( ABS(ht0_parent(ji,jj)-ht_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
IF ( .NOT.ln_vert_remap) THEN
DO jk = 1, jpkm1
@@ -2119,7 +2119,7 @@ CONTAINS
END DO
ENDIF
END DO
- DO ji = mi0(istart), mi1(iend-1)
+ DO ji = mi0(istart,nn_hls), mi1(iend-1,nn_hls)
IF ( ABS(hu0_parent(ji,jj)-hu_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
IF ( .NOT.ln_vert_remap) THEN
DO jk = 1, jpkm1
@@ -2128,8 +2128,8 @@ CONTAINS
ENDIF
END DO
END DO
- DO jj = mj0(jstart), mj1(jend-1)
- DO ji = mi0(istart), mi1(iend)
+ DO jj = mj0(jstart,nn_hls), mj1(jend-1,nn_hls)
+ DO ji = mi0(istart,nn_hls), mi1(iend,nn_hls)
IF ( ABS(hv0_parent(ji,jj)-hv_0(ji,jj)) > 1.e-3 ) iindic = iindic + 1
IF ( .NOT.ln_vert_remap) THEN
DO jk = 1, jpkm1
diff --git a/src/NST/agrif_oce_sponge.F90 b/src/NST/agrif_oce_sponge.F90
index d077f7b88..7d9e58852 100644
--- a/src/NST/agrif_oce_sponge.F90
+++ b/src/NST/agrif_oce_sponge.F90
@@ -161,15 +161,15 @@ CONTAINS
IF( lk_west ) THEN ! --- West --- !
ind1 = nn_hls + nbghostcells ! halo + nbghostcells
ind2 = nn_hls + nbghostcells + ispongearea
- DO ji = mi0(ind1), mi1(ind2)
+ DO ji = mi0(ind1,nn_hls), mi1(ind2,nn_hls)
DO jj = 1, jpj
- ztabramp(ji,jj) = REAL(ind2 - mig(ji), wp) * z1_ispongearea
+ ztabramp(ji,jj) = REAL(ind2 - mig(ji,nn_hls), wp) * z1_ispongearea
END DO
END DO
! ghost cells:
ind1 = 1
ind2 = nn_hls + nbghostcells ! halo + nbghostcells
- DO ji = mi0(ind1), mi1(ind2)
+ DO ji = mi0(ind1,nn_hls), mi1(ind2,nn_hls)
DO jj = 1, jpj
ztabramp(ji,jj) = 1._wp
END DO
@@ -178,15 +178,15 @@ CONTAINS
IF( lk_east ) THEN ! --- East --- !
ind1 = jpiglo - ( nn_hls + nbghostcells -1 ) - ispongearea - 1
ind2 = jpiglo - ( nn_hls + nbghostcells -1 ) - 1 ! halo + land + nbghostcells - 1
- DO ji = mi0(ind1), mi1(ind2)
+ DO ji = mi0(ind1,nn_hls), mi1(ind2,nn_hls)
DO jj = 1, jpj
- ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mig(ji) - ind1, wp) * z1_ispongearea )
+ ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mig(ji,nn_hls) - ind1, wp) * z1_ispongearea )
END DO
END DO
! ghost cells:
ind1 = jpiglo - ( nn_hls + nbghostcells -1 ) - 1 ! halo + land + nbghostcells - 1
ind2 = jpiglo - 1
- DO ji = mi0(ind1), mi1(ind2)
+ DO ji = mi0(ind1,nn_hls), mi1(ind2,nn_hls)
DO jj = 1, jpj
ztabramp(ji,jj) = 1._wp
END DO
@@ -195,15 +195,15 @@ CONTAINS
IF( lk_south ) THEN ! --- South --- !
ind1 = nn_hls + nbghostcells ! halo + nbghostcells
ind2 = nn_hls + nbghostcells + jspongearea
- DO jj = mj0(ind1), mj1(ind2)
+ DO jj = mj0(ind1,nn_hls), mj1(ind2,nn_hls)
DO ji = 1, jpi
- ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(ind2 - mjg(jj), wp) * z1_jspongearea )
+ ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(ind2 - mjg(jj,nn_hls), wp) * z1_jspongearea )
END DO
END DO
! ghost cells:
ind1 = 1
ind2 = nn_hls + nbghostcells ! halo + nbghostcells
- DO jj = mj0(ind1), mj1(ind2)
+ DO jj = mj0(ind1,nn_hls), mj1(ind2,nn_hls)
DO ji = 1, jpi
ztabramp(ji,jj) = 1._wp
END DO
@@ -212,15 +212,15 @@ CONTAINS
IF( lk_north ) THEN ! --- North --- !
ind1 = jpjglo - ( nn_hls + nbghostcells -1 ) - jspongearea - 1
ind2 = jpjglo - ( nn_hls + nbghostcells -1 ) - 1 ! halo + nbghostcells - 1
- DO jj = mj0(ind1), mj1(ind2)
+ DO jj = mj0(ind1,nn_hls), mj1(ind2,nn_hls)
DO ji = 1, jpi
- ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mjg(jj) - ind1, wp) * z1_jspongearea )
+ ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mjg(jj,nn_hls) - ind1, wp) * z1_jspongearea )
END DO
END DO
! ghost cells:
ind1 = jpjglo - ( nn_hls + nbghostcells -1 ) ! halo + land + nbghostcells - 1
ind2 = jpjglo
- DO jj = mj0(ind1), mj1(ind2)
+ DO jj = mj0(ind1,nn_hls), mj1(ind2,nn_hls)
DO ji = 1, jpi
ztabramp(ji,jj) = 1._wp
END DO
@@ -294,15 +294,15 @@ CONTAINS
IF( lk_west ) THEN ! --- West --- !
ind1 = nn_hls + nbghostcells + ishift
ind2 = nn_hls + nbghostcells + ishift + ispongearea
- DO ji = mi0(ind1), mi1(ind2)
+ DO ji = mi0(ind1,nn_hls), mi1(ind2,nn_hls)
DO jj = 1, jpj
- ztabramp(ji,jj) = REAL(ind2 - mig(ji), wp) * z1_ispongearea
+ ztabramp(ji,jj) = REAL(ind2 - mig(ji,nn_hls), wp) * z1_ispongearea
END DO
END DO
! ghost cells:
ind1 = 1
ind2 = nn_hls + nbghostcells + ishift ! halo + nbghostcells
- DO ji = mi0(ind1), mi1(ind2)
+ DO ji = mi0(ind1,nn_hls), mi1(ind2,nn_hls)
DO jj = 1, jpj
ztabramp(ji,jj) = 1._wp
END DO
@@ -311,15 +311,15 @@ CONTAINS
IF( lk_east ) THEN ! --- East --- !
ind1 = jpiglo - ( nn_hls + nbghostcells -1 + ishift) - ispongearea - 1
ind2 = jpiglo - ( nn_hls + nbghostcells -1 + ishift) - 1 ! halo + nbghostcells - 1
- DO ji = mi0(ind1), mi1(ind2)
+ DO ji = mi0(ind1,nn_hls), mi1(ind2,nn_hls)
DO jj = 1, jpj
- ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mig(ji) - ind1, wp) * z1_ispongearea )
+ ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mig(ji,nn_hls) - ind1, wp) * z1_ispongearea )
END DO
END DO
! ghost cells:
ind1 = jpiglo - ( nn_hls + nbghostcells -1 + ishift) - 1 ! halo + nbghostcells - 1
ind2 = jpiglo - 1
- DO ji = mi0(ind1), mi1(ind2)
+ DO ji = mi0(ind1,nn_hls), mi1(ind2,nn_hls)
DO jj = 1, jpj
ztabramp(ji,jj) = 1._wp
END DO
@@ -328,15 +328,15 @@ CONTAINS
IF( lk_south ) THEN ! --- South --- !
ind1 = nn_hls + nbghostcells + jshift ! halo + nbghostcells
ind2 = nn_hls + nbghostcells + jshift + jspongearea
- DO jj = mj0(ind1), mj1(ind2)
+ DO jj = mj0(ind1,nn_hls), mj1(ind2,nn_hls)
DO ji = 1, jpi
- ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(ind2 - mjg(jj), wp) * z1_jspongearea )
+ ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(ind2 - mjg(jj,nn_hls), wp) * z1_jspongearea )
END DO
END DO
! ghost cells:
ind1 = 1
ind2 = nn_hls + nbghostcells + jshift ! halo + land + nbghostcells
- DO jj = mj0(ind1), mj1(ind2)
+ DO jj = mj0(ind1,nn_hls), mj1(ind2,nn_hls)
DO ji = 1, jpi
ztabramp(ji,jj) = 1._wp
END DO
@@ -345,15 +345,15 @@ CONTAINS
IF( lk_north ) THEN ! --- North --- !
ind1 = jpjglo - ( nn_hls + nbghostcells -1 + jshift) - jspongearea - 1
ind2 = jpjglo - ( nn_hls + nbghostcells -1 + jshift) - 1 ! halo + land + nbghostcells - 1
- DO jj = mj0(ind1), mj1(ind2)
+ DO jj = mj0(ind1,nn_hls), mj1(ind2,nn_hls)
DO ji = 1, jpi
- ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mjg(jj) - ind1, wp) * z1_jspongearea )
+ ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mjg(jj,nn_hls) - ind1, wp) * z1_jspongearea )
END DO
END DO
! ghost cells:
ind1 = jpjglo - ( nn_hls + nbghostcells -1 + jshift) ! halo + land + nbghostcells - 1
ind2 = jpjglo
- DO jj = mj0(ind1), mj1(ind2)
+ DO jj = mj0(ind1,nn_hls), mj1(ind2,nn_hls)
DO ji = 1, jpi
ztabramp(ji,jj) = 1._wp
END DO
@@ -730,7 +730,7 @@ CONTAINS
jmax = j2-1
ind1 = jpjglo - ( nn_hls + nbghostcells + 1 ) ! North
- DO jj = mj0(ind1), mj1(ind1)
+ DO jj = mj0(ind1,nn_hls), mj1(ind1,nn_hls)
jmax = MIN(jmax,jj)
END DO
@@ -858,7 +858,7 @@ CONTAINS
imax = i2 - 1
ind1 = jpiglo - ( nn_hls + nbghostcells + 1 ) ! East
- DO ji = mi0(ind1), mi1(ind1)
+ DO ji = mi0(ind1,nn_hls), mi1(ind1,nn_hls)
imax = MIN(imax,ji)
END DO
@@ -958,7 +958,7 @@ CONTAINS
jmax = j2-1
ind1 = jpjglo - ( nn_hls + nbghostcells + 1 ) ! North
- DO jj = mj0(ind1), mj1(ind1)
+ DO jj = mj0(ind1,nn_hls), mj1(ind1,nn_hls)
jmax = MIN(jmax,jj)
END DO
@@ -1025,7 +1025,7 @@ CONTAINS
imax = i2 - 1
ind1 = jpiglo - ( nn_hls + nbghostcells + 1 ) ! East
- DO ji = mi0(ind1), mi1(ind1)
+ DO ji = mi0(ind1,nn_hls), mi1(ind1,nn_hls)
imax = MIN(imax,ji)
END DO
diff --git a/src/NST/agrif_oce_update.F90 b/src/NST/agrif_oce_update.F90
index 72fb2eca1..fed585975 100644
--- a/src/NST/agrif_oce_update.F90
+++ b/src/NST/agrif_oce_update.F90
@@ -1893,7 +1893,7 @@ CONTAINS
DO jk=k1,k2-1
IF (ABS((ptab(ji,jj,jk)-e3u_0(ji,jj,jk))*umask(ji,jj,jk)).GE.1.e-6) THEN
kindic_agr = kindic_agr + 1
- print *, 'erro u-pt', mig0(ji), mjg0(jj), jk, mbku(ji,jj), ikbot, ptab(ji,jj,jk), e3u_0(ji,jj,jk)
+ PRINT *, 'erro u-pt', mig(ji,0), mjg(jj,0), jk, mbku(ji,jj), ikbot, ptab(ji,jj,jk), e3u_0(ji,jj,jk)
ENDIF
END DO
ENDIF
@@ -1933,7 +1933,7 @@ CONTAINS
DO jk=k1,k2-1
IF (ABS((ptab(ji,jj,jk)-e3v_0(ji,jj,jk))*vmask(ji,jj,jk)).GE.1.e-6) THEN
kindic_agr = kindic_agr + 1
- print *, 'erro v-pt', mig0(ji), mjg0(jj), mbkv(ji,jj), ptab(ji,jj,jk), e3v_0(ji,jj,jk)
+ PRINT *, 'erro v-pt', mig(ji,0), mjg(jj,0), mbkv(ji,jj), ptab(ji,jj,jk), e3v_0(ji,jj,jk)
ENDIF
END DO
ENDIF
diff --git a/src/NST/agrif_user.F90 b/src/NST/agrif_user.F90
index 2bdc85c5d..76e583a4a 100644
--- a/src/NST/agrif_user.F90
+++ b/src/NST/agrif_user.F90
@@ -1095,8 +1095,8 @@
!!----------------------------------------------------------------------
!
SELECT CASE( i )
- CASE(1) ; indglob = mig(indloc)
- CASE(2) ; indglob = mjg(indloc)
+ CASE(1) ; indglob = mig(indloc,nn_hls)
+ CASE(2) ; indglob = mjg(indloc,nn_hls)
CASE DEFAULT ; indglob = indloc
END SELECT
!
@@ -1115,10 +1115,10 @@
INTEGER, INTENT(out) :: jmin, jmax
!!----------------------------------------------------------------------
!
- imin = mig( 1 )
- jmin = mjg( 1 )
- imax = mig(jpi)
- jmax = mjg(jpj)
+ imin = mig( 1 ,nn_hls)
+ jmin = mjg( 1 ,nn_hls)
+ imax = mig(jpi,nn_hls)
+ jmax = mjg(jpj,nn_hls)
!
END SUBROUTINE Agrif_get_proc_info
diff --git a/src/OCE/BDY/bdyini.F90 b/src/OCE/BDY/bdyini.F90
index 3de3150bc..e0b1fe6d8 100644
--- a/src/OCE/BDY/bdyini.F90
+++ b/src/OCE/BDY/bdyini.F90
@@ -491,10 +491,10 @@ CONTAINS
! Find lenght of boundaries and rim on local mpi domain
!------------------------------------------------------
!
- iwe = mig(1)
- ies = mig(jpi)
- iso = mjg(1)
- ino = mjg(jpj)
+ iwe = mig( 1,nn_hls)
+ ies = mig(jpi,nn_hls)
+ iso = mjg( 1,nn_hls)
+ ino = mjg(jpj,nn_hls)
!
DO ib_bdy = 1, nb_bdy
DO igrd = 1, jpbgrd
@@ -554,8 +554,8 @@ CONTAINS
& nbrdta(ib,igrd,ib_bdy) == ir ) THEN
!
icount = icount + 1
- idx_bdy(ib_bdy)%nbi(icount,igrd) = nbidta(ib,igrd,ib_bdy) - mig(1) + 1 ! global to local indexes
- idx_bdy(ib_bdy)%nbj(icount,igrd) = nbjdta(ib,igrd,ib_bdy) - mjg(1) + 1 ! global to local indexes
+ idx_bdy(ib_bdy)%nbi(icount,igrd) = nbidta(ib,igrd,ib_bdy) - mig(1,nn_hls) + 1 ! global to local indexes
+ idx_bdy(ib_bdy)%nbj(icount,igrd) = nbjdta(ib,igrd,ib_bdy) - mjg(1,nn_hls) + 1 ! global to local indexes
idx_bdy(ib_bdy)%nbr(icount,igrd) = nbrdta(ib,igrd,ib_bdy)
idx_bdy(ib_bdy)%nbmap(icount,igrd) = ib
ENDIF
@@ -1014,7 +1014,7 @@ CONTAINS
DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)
ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
- IF( mig0(ii) > 2 .AND. mig0(ii) < Ni0glo-2 .AND. mjg0(ij) > 2 .AND. mjg0(ij) < Nj0glo-2 ) THEN
+ IF( mig(ii,0) > 2 .AND. mig(ii,0) < Ni0glo-2 .AND. mjg(ij,0) > 2 .AND. mjg(ij,0) < Nj0glo-2 ) THEN
WRITE(ctmp1,*) ' Orlanski is not safe when the open boundaries are on the interior of the computational domain'
CALL ctl_stop( ctmp1 )
END IF
@@ -1090,7 +1090,7 @@ CONTAINS
! This error check only works if you are using the bdyXmask arrays (which are set to 0 on rims)
IF( i_offset == 1 .and. zefl + zwfl == 2._wp ) THEN
icount = icount + 1
- IF(lwp) WRITE(numout,*) 'Problem with igrd = ',igrd,' at (global) nbi, nbj : ',mig(ii),mjg(ij)
+ IF(lwp) WRITE(numout,*) 'Problem with igrd = ',igrd,' at (global) nbi, nbj : ',mig(ii,nn_hls),mjg(ij,nn_hls)
ELSE
ztmp(ii,ij) = -zwfl + zefl
ENDIF
@@ -1130,7 +1130,7 @@ CONTAINS
znfl = zmask(ii,ij+j_offset )
! This error check only works if you are using the bdyXmask arrays (which are set to 0 on rims)
IF( j_offset == 1 .and. znfl + zsfl == 2._wp ) THEN
- IF(lwp) WRITE(numout,*) 'Problem with igrd = ',igrd,' at (global) nbi, nbj : ',mig(ii),mjg(ij)
+ IF(lwp) WRITE(numout,*) 'Problem with igrd = ',igrd,' at (global) nbi, nbj : ',mig(ii,nn_hls),mjg(ij,nn_hls)
icount = icount + 1
ELSE
ztmp(ii,ij) = -zsfl + znfl
@@ -1594,8 +1594,8 @@ CONTAINS
ztestmask(1:2)=0.
DO ji = 1, jpi
DO jj = 1, jpj
- IF( mig0(ji) == jpiwob(ib) .AND. mjg0(jj) == jpjwdt(ib) ) ztestmask(1) = tmask(ji,jj,1)
- IF( mig0(ji) == jpiwob(ib) .AND. mjg0(jj) == jpjwft(ib) ) ztestmask(2) = tmask(ji,jj,1)
+ IF( mig(ji,0) == jpiwob(ib) .AND. mjg(jj,0) == jpjwdt(ib) ) ztestmask(1) = tmask(ji,jj,1)
+ IF( mig(ji,0) == jpiwob(ib) .AND. mjg(jj,0) == jpjwft(ib) ) ztestmask(2) = tmask(ji,jj,1)
END DO
END DO
CALL mpp_sum( 'bdyini', ztestmask, 2 ) ! sum over the global domain
@@ -1630,8 +1630,8 @@ CONTAINS
ztestmask(1:2)=0.
DO ji = 1, jpi
DO jj = 1, jpj
- IF( mig0(ji) == jpieob(ib)+1 .AND. mjg0(jj) == jpjedt(ib) ) ztestmask(1) = tmask(ji,jj,1)
- IF( mig0(ji) == jpieob(ib)+1 .AND. mjg0(jj) == jpjeft(ib) ) ztestmask(2) = tmask(ji,jj,1)
+ IF( mig(ji,0) == jpieob(ib)+1 .AND. mjg(jj,0) == jpjedt(ib) ) ztestmask(1) = tmask(ji,jj,1)
+ IF( mig(ji,0) == jpieob(ib)+1 .AND. mjg(jj,0) == jpjeft(ib) ) ztestmask(2) = tmask(ji,jj,1)
END DO
END DO
CALL mpp_sum( 'bdyini', ztestmask, 2 ) ! sum over the global domain
@@ -1666,8 +1666,8 @@ CONTAINS
ztestmask(1:2)=0.
DO ji = 1, jpi
DO jj = 1, jpj
- IF( mjg0(jj) == jpjsob(ib) .AND. mig0(ji) == jpisdt(ib) ) ztestmask(1) = tmask(ji,jj,1)
- IF( mjg0(jj) == jpjsob(ib) .AND. mig0(ji) == jpisft(ib) ) ztestmask(2) = tmask(ji,jj,1)
+ IF( mjg(jj,0) == jpjsob(ib) .AND. mig(ji,0) == jpisdt(ib) ) ztestmask(1) = tmask(ji,jj,1)
+ IF( mjg(jj,0) == jpjsob(ib) .AND. mig(ji,0) == jpisft(ib) ) ztestmask(2) = tmask(ji,jj,1)
END DO
END DO
CALL mpp_sum( 'bdyini', ztestmask, 2 ) ! sum over the global domain
@@ -1688,8 +1688,8 @@ CONTAINS
ztestmask(1:2)=0.
DO ji = 1, jpi
DO jj = 1, jpj
- IF( mjg0(jj) == jpjnob(ib)+1 .AND. mig0(ji) == jpindt(ib) ) ztestmask(1) = tmask(ji,jj,1)
- IF( mjg0(jj) == jpjnob(ib)+1 .AND. mig0(ji) == jpinft(ib) ) ztestmask(2) = tmask(ji,jj,1)
+ IF( mjg(jj,0) == jpjnob(ib)+1 .AND. mig(ji,0) == jpindt(ib) ) ztestmask(1) = tmask(ji,jj,1)
+ IF( mjg(jj,0) == jpjnob(ib)+1 .AND. mig(ji,0) == jpinft(ib) ) ztestmask(2) = tmask(ji,jj,1)
END DO
END DO
CALL mpp_sum( 'bdyini', ztestmask, 2 ) ! sum over the global domain
diff --git a/src/OCE/DIA/diadct.F90 b/src/OCE/DIA/diadct.F90
index 4fa5479f4..ffc50f370 100644
--- a/src/OCE/DIA/diadct.F90
+++ b/src/OCE/DIA/diadct.F90
@@ -414,9 +414,9 @@ CONTAINS
!verify if the point is on the local domain:(1,Nie0)*(1,Nje0)
IF( iiloc >= 1 .AND. iiloc <= Nie0 .AND. &
ijloc >= 1 .AND. ijloc <= Nje0 )THEN
- iptloc = iptloc + 1 ! count local points
- secs(jsec)%listPoint(iptloc) = POINT_SECTION(mi0(iiglo),mj0(ijglo)) ! store local coordinates
- secs(jsec)%direction(iptloc) = directemp(jpt) ! store local direction
+ iptloc = iptloc + 1 ! count local points
+ secs(jsec)%listPoint(iptloc) = POINT_SECTION(mi0(iiglo,nn_hls),mj0(ijglo,nn_hls)) ! store local coordinates
+ secs(jsec)%direction(iptloc) = directemp(jpt) ! store local direction
ENDIF
!
END DO
diff --git a/src/OCE/DOM/dom_oce.F90 b/src/OCE/DOM/dom_oce.F90
index 71a085f23..480d3d2fb 100644
--- a/src/OCE/DOM/dom_oce.F90
+++ b/src/OCE/DOM/dom_oce.F90
@@ -76,10 +76,10 @@ MODULE dom_oce
INTEGER :: nn_ltile_i, nn_ltile_j
! Domain tiling
- INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ntsi_a !: start of internal part of tile domain
- INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ntsj_a !
- INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ntei_a !: end of internal part of tile domain
- INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ntej_a !
+ INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:) :: ntsi_a !: start of internal part of tile domain
+ INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:) :: ntsj_a !
+ INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:) :: ntei_a !: end of internal part of tile domain
+ INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:) :: ntej_a !
LOGICAL, PUBLIC :: l_istiled ! whether tiling is currently active or not
! !: domain MPP decomposition parameters
@@ -87,32 +87,30 @@ MODULE dom_oce
INTEGER , PUBLIC :: narea !: number for local area (starting at 1) = MPI rank + 1
INTEGER, PUBLIC :: nidom !: IOIPSL things...
- INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: mig !: local ==> global domain, including halos (jpiglo), i-index
- INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: mjg !: local ==> global domain, including halos (jpjglo), j-index
- INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: mig0 !: local ==> global domain, excluding halos (Ni0glo), i-index
- INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: mjg0 !: local ==> global domain, excluding halos (Nj0glo), j-index
- INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: mi0, mi1 !: global, including halos (jpiglo) ==> local domain i-index
+ INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: mig !: local ==> global domain, i-index
+ INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: mjg !: local ==> global domain, j-index
+ INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: mi0, mi1 !: global ==> local domain, i-index
! !: (mi0=1 and mi1=0 if global index not in local domain)
- INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: mj0, mj1 !: global, including halos (jpjglo) ==> local domain j-index
+ INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: mj0, mj1 !: global ==> local domain, j-index
! !: (mj0=1 and mj1=0 if global index not in local domain)
- INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: nfimpp, nfproc, nfjpi
+ INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:) :: nfimpp, nfproc, nfjpi, nfni_0
!!----------------------------------------------------------------------
!! horizontal curvilinear coordinate and scale factors
!! ---------------------------------------------------------------------
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: glamt , glamu, glamv , glamf !: longitude at t, u, v, f-points [degree]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: gphit , gphiu, gphiv , gphif !: latitude at t, u, v, f-points [degree]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1t , e2t , r1_e1t, r1_e2t !: t-point horizontal scale factors [m]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1u , e2u , r1_e1u, r1_e2u !: horizontal scale factors at u-point [m]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1v , e2v , r1_e1v, r1_e2v !: horizontal scale factors at v-point [m]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1f , e2f , r1_e1f, r1_e2f !: horizontal scale factors at f-point [m]
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: glamt , glamu, glamv , glamf !: longitude at t, u, v, f-points [degree]
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: gphit , gphiu, gphiv , gphif !: latitude at t, u, v, f-points [degree]
+ REAL(wp), PUBLIC, ALLOCATABLE, TARGET, DIMENSION(:,:) :: e1t , e2t , r1_e1t, r1_e2t !: t-point horizontal scale factors [m]
+ REAL(wp), PUBLIC, ALLOCATABLE, TARGET, DIMENSION(:,:) :: e1u , e2u , r1_e1u, r1_e2u !: horizontal scale factors at u-point [m]
+ REAL(wp), PUBLIC, ALLOCATABLE, TARGET, DIMENSION(:,:) :: e1v , e2v , r1_e1v, r1_e2v !: horizontal scale factors at v-point [m]
+ REAL(wp), PUBLIC, ALLOCATABLE, TARGET, DIMENSION(:,:) :: e1f , e2f , r1_e1f, r1_e2f !: horizontal scale factors at f-point [m]
!
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: e1e2t , r1_e1e2t !: associated metrics at t-point
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: e1e2u , r1_e1e2u , e2_e1u !: associated metrics at u-point
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: e1e2v , r1_e1e2v , e1_e2v !: associated metrics at v-point
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: e1e2f , r1_e1e2f !: associated metrics at f-point
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: e1e2t , r1_e1e2t !: associated metrics at t-point
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: e1e2u , r1_e1e2u , e2_e1u !: associated metrics at u-point
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: e1e2v , r1_e1e2v , e1_e2v !: associated metrics at v-point
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: e1e2f , r1_e1e2f !: associated metrics at f-point
!
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ff_f , ff_t !: Coriolis factor at f- & t-points [1/s]
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: ff_f , ff_t !: Coriolis factor at f- & t-points [1/s]
!!----------------------------------------------------------------------
!! vertical coordinate and scale factors
@@ -132,76 +130,76 @@ MODULE dom_oce
LOGICAL, PUBLIC :: ln_sco !: s-coordinate or hybrid z-s coordinate
LOGICAL, PUBLIC :: ln_isfcav !: presence of ISF
! ! reference scale factors
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3t_0 !: t- vert. scale factor [m]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3u_0 !: u- vert. scale factor [m]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3v_0 !: v- vert. scale factor [m]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3f_0 !: f- vert. scale factor [m]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3w_0 !: w- vert. scale factor [m]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3uw_0 !: uw-vert. scale factor [m]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3vw_0 !: vw-vert. scale factor [m]
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: e3t_0 !: t- vert. scale factor [m]
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: e3u_0 !: u- vert. scale factor [m]
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: e3v_0 !: v- vert. scale factor [m]
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: e3f_0 !: f- vert. scale factor [m]
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: e3w_0 !: w- vert. scale factor [m]
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: e3uw_0 !: uw-vert. scale factor [m]
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: e3vw_0 !: vw-vert. scale factor [m]
! ! time-dependent scale factors (domvvl)
#if defined key_qco || defined key_linssh
#else
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e3t, e3u, e3v, e3w, e3uw, e3vw !: vert. scale factor [m]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3f !: F-point vert. scale factor [m]
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:,:) :: e3t, e3u, e3v, e3w, e3uw, e3vw !: vert. scale factor [m]
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: e3f !: F-point vert. scale factor [m]
#endif
! ! time-dependent ratio ssh / h_0 (domqco)
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: r3t, r3u, r3v !: time-dependent ratio at t-, u- and v-point [-]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: r3f !: mid-time-level ratio at f-point [-]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: r3t_f, r3u_f, r3v_f !: now time-filtered ratio at t-, u- and v-point [-]
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: r3t, r3u, r3v !: time-dependent ratio at t-, u- and v-point [-]
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: r3f !: mid-time-level ratio at f-point [-]
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: r3t_f, r3u_f, r3v_f !: now time-filtered ratio at t-, u- and v-point [-]
! ! reference depths of cells
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gdept_0 !: t- depth [m]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gdepw_0 !: w- depth [m]
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: gdept_0 !: t- depth [m]
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: gdepw_0 !: w- depth [m]
! ! time-dependent depths of cells (domvvl)
#if defined key_qco || defined key_linssh
#else
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gde3w_0, gde3w !: w- depth (sum of e3w) [m]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: gdept, gdepw
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: gde3w_0, gde3w !: w- depth (sum of e3w) [m]
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:,:) :: gdept, gdepw
#endif
! ! reference heights of ocean water column and its inverse
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ht_0, r1_ht_0 !: t-depth [m] and [1/m]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu_0, r1_hu_0 !: u-depth [m] and [1/m]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hv_0, r1_hv_0 !: v-depth [m] and [1/m]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hf_0, r1_hf_0 !: f-depth [m] and [1/m]
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: ht_0, r1_ht_0 !: t-depth [m] and [1/m]
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: hu_0, r1_hu_0 !: u-depth [m] and [1/m]
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: hv_0, r1_hv_0 !: v-depth [m] and [1/m]
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: hf_0, r1_hf_0 !: f-depth [m] and [1/m]
! ! time-dependent heights of ocean water column (domvvl)
#if defined key_qco || defined key_linssh
#else
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ht !: t-points [m]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hu, r1_hu !: u-depth [m] and [1/m]
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hv, r1_hv !: v-depth [m] and [1/m]
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: ht !: t-points [m]
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: hu, r1_hu !: u-depth [m] and [1/m]
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: hv, r1_hv !: v-depth [m] and [1/m]
#endif
INTEGER, PUBLIC :: nla10 !: deepest W level Above ~10m (nlb10 - 1)
INTEGER, PUBLIC :: nlb10 !: shallowest W level Bellow ~10m (nla10 + 1)
!! 1D reference vertical coordinate
!! =-----------------====------
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: gdept_1d, gdepw_1d !: reference depth of t- and w-points (m)
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: e3t_1d , e3w_1d !: reference vertical scale factors at T- and W-pts (m)
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) :: gdept_1d, gdepw_1d !: reference depth of t- and w-points (m)
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) :: e3t_1d , e3w_1d !: reference vertical scale factors at T- and W-pts (m)
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: risfdep, bathy
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: risfdep, bathy
!!----------------------------------------------------------------------
!! masks, top and bottom ocean point position
!! ---------------------------------------------------------------------
!!gm Proposition of new name for top/bottom vertical indices
-! INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mtk_t, mtk_u, mtk_v !: top first wet T-, U-, and V-level (ISF)
-! INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mbk_t, mbk_u, mbk_v !: bottom last wet T-, U-, and V-level
+! INTEGER , PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: mtk_t, mtk_u, mtk_v !: top first wet T-, U-, and V-level (ISF)
+! INTEGER , PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: mbk_t, mbk_u, mbk_v !: bottom last wet T-, U-, and V-level
!!gm
- INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mbkt, mbku, mbkv, mbkf !: bottom last wet T-, U-, V- and F-level
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmask_i !: interior (excluding halos+duplicated points) domain T-point mask
+ INTEGER , PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: mbkt, mbku, mbkv, mbkf !: bottom last wet T-, U-, V- and F-level
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: tmask_i !: interior (excluding halos+duplicated points) domain T-point mask
- INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mikt, miku, mikv, mikf !: top first wet T-, U-, V-, F-level (ISF)
+ INTEGER , PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: mikt, miku, mikv, mikf !: top first wet T-, U-, V-, F-level (ISF)
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: smask0 !: surface mask at T-pts on inner domain
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ssmask, ssumask, ssvmask, ssfmask !: surface mask at T-,U-, V- and F-pts
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: tmask, umask, vmask, wmask, fmask !: land/ocean mask at T-, U-, V-, W- and F-pts
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: wumask, wvmask !: land/ocean mask at WU- and WV-pts
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: fe3mask !: land/ocean mask at F-pts
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmask_upd, umask_upd, vmask_upd !: land/ocean mask at F-pts
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: smask0 !: surface mask at T-pts on inner domain
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: ssmask, ssumask, ssvmask, ssfmask !: surface mask at T-,U-, V- and F-pts
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:), TARGET :: tmask, umask, vmask, wmask, fmask !: land/ocean mask at T-, U-, V-, W- and F-pts
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:), TARGET :: wumask, wvmask !: land/ocean mask at WU- and WV-pts
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:), TARGET :: fe3mask !: land/ocean mask at F-pts
+ REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: tmask_upd, umask_upd, vmask_upd !: land/ocean mask at F-pts
!!----------------------------------------------------------------------
!! calendar variables
diff --git a/src/OCE/DOM/domvvl.F90 b/src/OCE/DOM/domvvl.F90
index 94bf1ce8b..2de0762a7 100644
--- a/src/OCE/DOM/domvvl.F90
+++ b/src/OCE/DOM/domvvl.F90
@@ -282,8 +282,8 @@ CONTAINS
IF( nn_cfg == 3 ) THEN ! ORCA2: Suppress ztilde in the Foxe Basin for ORCA2
ii0 = 103 + nn_hls - 1 ; ii1 = 111 + nn_hls - 1
ij0 = 128 + nn_hls ; ij1 = 135 + nn_hls
- frq_rst_e3t( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.0_wp
- frq_rst_hdv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0_wp / rn_Dt
+ frq_rst_e3t( mi0(ii0,nn_hls):mi1(ii1,nn_hls) , mj0(ij0,nn_hls):mj1(ij1,nn_hls) ) = 0.0_wp
+ frq_rst_hdv( mi0(ii0,nn_hls):mi1(ii1,nn_hls) , mj0(ij0,nn_hls):mj1(ij1,nn_hls) ) = 1.e0_wp / rn_Dt
ENDIF
ENDIF
ENDIF
diff --git a/src/OCE/DOM/domzgr.F90 b/src/OCE/DOM/domzgr.F90
index 85f89ed2c..e6bfeaf33 100644
--- a/src/OCE/DOM/domzgr.F90
+++ b/src/OCE/DOM/domzgr.F90
@@ -130,14 +130,14 @@ CONTAINS
!
zmsk(:,:) = 1._wp ! default: no closed boundaries
IF( .NOT. l_Iperio ) THEN ! E-W closed:
- zmsk( mi0( 1+nn_hls):mi1( 1+nn_hls),:) = 0._wp ! first column of inner global domain at 0
- zmsk( mi0(jpiglo-nn_hls):mi1(jpiglo-nn_hls),:) = 0._wp ! last column of inner global domain at 0
+ zmsk( mi0( 1+nn_hls,nn_hls):mi1( 1+nn_hls,nn_hls),:) = 0._wp ! first column of inner global domain at 0
+ zmsk( mi0(jpiglo-nn_hls,nn_hls):mi1(jpiglo-nn_hls,nn_hls),:) = 0._wp ! last column of inner global domain at 0
ENDIF
IF( .NOT. l_Jperio ) THEN ! S closed:
- zmsk(:,mj0( 1+nn_hls):mj1( 1+nn_hls) ) = 0._wp ! first line of inner global domain at 0
+ zmsk(:,mj0( 1+nn_hls,nn_hls):mj1( 1+nn_hls,nn_hls) ) = 0._wp ! first line of inner global domain at 0
ENDIF
IF( .NOT. ( l_Jperio .OR. l_NFold ) ) THEN ! N closed:
- zmsk(:,mj0(jpjglo-nn_hls):mj1(jpjglo-nn_hls) ) = 0._wp ! last line of inner global domain at 0
+ zmsk(:,mj0(jpjglo-nn_hls,nn_hls):mj1(jpjglo-nn_hls,nn_hls) ) = 0._wp ! last line of inner global domain at 0
ENDIF
CALL lbc_lnk( 'usrdef_zgr', zmsk, 'T', 1. ) ! set halos
k_top(:,:) = k_top(:,:) * NINT( zmsk(:,:) )
diff --git a/src/OCE/DOM/dtatsd.F90 b/src/OCE/DOM/dtatsd.F90
index 5863789cc..cf634beda 100644
--- a/src/OCE/DOM/dtatsd.F90
+++ b/src/OCE/DOM/dtatsd.F90
@@ -161,8 +161,8 @@ CONTAINS
ij0 = 101 + nn_hls ; ij1 = 109 + nn_hls ! Reduced T & S in the Alboran Sea
ii0 = 141 + nn_hls - 1 ; ii1 = 155 + nn_hls - 1
IF( sf_tsd(jp_tem)%ln_tint .OR. irec_n(jp_tem) /= irec_b(jp_tem) ) THEN
- DO jj = mj0(ij0), mj1(ij1)
- DO ji = mi0(ii0), mi1(ii1)
+ DO jj = mj0(ij0,nn_hls), mj1(ij1,nn_hls)
+ DO ji = mi0(ii0,nn_hls), mi1(ii1,nn_hls)
sf_tsd(jp_tem)%fnow(ji,jj,13:13) = sf_tsd(jp_tem)%fnow(ji,jj,13:13) - 0.20_wp
sf_tsd(jp_tem)%fnow(ji,jj,14:15) = sf_tsd(jp_tem)%fnow(ji,jj,14:15) - 0.35_wp
sf_tsd(jp_tem)%fnow(ji,jj,16:25) = sf_tsd(jp_tem)%fnow(ji,jj,16:25) - 0.40_wp
@@ -172,8 +172,8 @@ CONTAINS
ENDIF
!
IF( sf_tsd(jp_sal)%ln_tint .OR. irec_n(jp_sal) /= irec_b(jp_sal) ) THEN
- DO jj = mj0(ij0), mj1(ij1)
- DO ji = mi0(ii0), mi1(ii1)
+ DO jj = mj0(ij0,nn_hls), mj1(ij1,nn_hls)
+ DO ji = mi0(ii0,nn_hls), mi1(ii1,nn_hls)
sf_tsd(jp_sal)%fnow(ji,jj,13:13) = sf_tsd(jp_sal)%fnow(ji,jj,13:13) - 0.15_wp
sf_tsd(jp_sal)%fnow(ji,jj,14:15) = sf_tsd(jp_sal)%fnow(ji,jj,14:15) - 0.25_wp
sf_tsd(jp_sal)%fnow(ji,jj,16:17) = sf_tsd(jp_sal)%fnow(ji,jj,16:17) - 0.30_wp
@@ -185,9 +185,9 @@ CONTAINS
!
ij0 = 87 + nn_hls ; ij1 = 96 + nn_hls ! Reduced temperature in Red Sea
ii0 = 148 + nn_hls - 1 ; ii1 = 160 + nn_hls - 1
- sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 4:10 ) = 7.0_wp
- sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 ) = 6.5_wp
- sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 ) = 6.0_wp
+ sf_tsd(jp_tem)%fnow( mi0(ii0,nn_hls):mi1(ii1,nn_hls) , mj0(ij0,nn_hls):mj1(ij1,nn_hls) , 4:10 ) = 7.0_wp
+ sf_tsd(jp_tem)%fnow( mi0(ii0,nn_hls):mi1(ii1,nn_hls) , mj0(ij0,nn_hls):mj1(ij1,nn_hls) , 11:13 ) = 6.5_wp
+ sf_tsd(jp_tem)%fnow( mi0(ii0,nn_hls):mi1(ii1,nn_hls) , mj0(ij0,nn_hls):mj1(ij1,nn_hls) , 14:20 ) = 6.0_wp
ENDIF
ENDIF
!!gm end
diff --git a/src/OCE/DYN/sshwzv.F90 b/src/OCE/DYN/sshwzv.F90
index 0e2569708..4d2ca527f 100644
--- a/src/OCE/DYN/sshwzv.F90
+++ b/src/OCE/DYN/sshwzv.F90
@@ -244,28 +244,28 @@ CONTAINS
! inside computational domain (cosmetic)
DO jk = 1, jpkm1
IF( lk_west ) THEN ! --- West --- !
- DO ji = mi0(2+nn_hls), mi1(2+nn_hls)
+ DO ji = mi0(2+nn_hls,nn_hls), mi1(2+nn_hls,nn_hls)
DO jj = 1, jpj
pww(ji,jj,jk) = 0._wp
END DO
END DO
ENDIF
IF( lk_east ) THEN ! --- East --- !
- DO ji = mi0(jpiglo-1-nn_hls), mi1(jpiglo-1-nn_hls)
+ DO ji = mi0(jpiglo-1-nn_hls,nn_hls), mi1(jpiglo-1-nn_hls,nn_hls)
DO jj = 1, jpj
pww(ji,jj,jk) = 0._wp
END DO
END DO
ENDIF
IF( lk_south ) THEN ! --- South --- !
- DO jj = mj0(2+nn_hls), mj1(2+nn_hls)
+ DO jj = mj0(2+nn_hls,nn_hls), mj1(2+nn_hls,nn_hls)
DO ji = 1, jpi
pww(ji,jj,jk) = 0._wp
END DO
END DO
ENDIF
IF( lk_north ) THEN ! --- North --- !
- DO jj = mj0(jpjglo-1-nn_hls), mj1(jpjglo-1-nn_hls)
+ DO jj = mj0(jpjglo-1-nn_hls,nn_hls), mj1(jpjglo-1-nn_hls,nn_hls)
DO ji = 1, jpi
pww(ji,jj,jk) = 0._wp
END DO
@@ -375,28 +375,28 @@ CONTAINS
! inside computational domain (cosmetic)
DO jk = 1, jpkm1
IF( lk_west ) THEN ! --- West --- !
- DO ji = mi0(2+nn_hls), mi1(2+nn_hls)
+ DO ji = mi0(2+nn_hls,nn_hls), mi1(2+nn_hls,nn_hls)
DO jj = 1, jpj
pww(ji,jj,jk) = 0._wp
END DO
END DO
ENDIF
IF( lk_east ) THEN ! --- East --- !
- DO ji = mi0(jpiglo-1-nn_hls), mi1(jpiglo-1-nn_hls)
+ DO ji = mi0(jpiglo-1-nn_hls,nn_hls), mi1(jpiglo-1-nn_hls,nn_hls)
DO jj = 1, jpj
pww(ji,jj,jk) = 0._wp
END DO
END DO
ENDIF
IF( lk_south ) THEN ! --- South --- !
- DO jj = mj0(2+nn_hls), mj1(2+nn_hls)
+ DO jj = mj0(2+nn_hls,nn_hls), mj1(2+nn_hls,nn_hls)
DO ji = 1, jpi
pww(ji,jj,jk) = 0._wp
END DO
END DO
ENDIF
IF( lk_north ) THEN ! --- North --- !
- DO jj = mj0(jpjglo-1-nn_hls), mj1(jpjglo-1-nn_hls)
+ DO jj = mj0(jpjglo-1-nn_hls,nn_hls), mj1(jpjglo-1-nn_hls,nn_hls)
DO ji = 1, jpi
pww(ji,jj,jk) = 0._wp
END DO
diff --git a/src/OCE/FLO/floblk.F90 b/src/OCE/FLO/floblk.F90
index 4d7450719..95b0682aa 100644
--- a/src/OCE/FLO/floblk.F90
+++ b/src/OCE/FLO/floblk.F90
@@ -105,10 +105,10 @@ CONTAINS
iloop = 0
222 DO jfl = 1, jpnfl
# if ! defined key_mpi_off
- IF( iil(jfl) >= mig(Nis0) .AND. iil(jfl) <= mig(Nie0) .AND. &
- ijl(jfl) >= mjg(Njs0) .AND. ijl(jfl) <= mjg(Nje0) ) THEN
- iiloc(jfl) = iil(jfl) - mig(1) + 1
- ijloc(jfl) = ijl(jfl) - mjg(1) + 1
+ IF( iil(jfl) >= mig(Nis0,nn_hls) .AND. iil(jfl) <= mig(Nie0,nn_hls) .AND. &
+ ijl(jfl) >= mjg(Njs0,nn_hls) .AND. ijl(jfl) <= mjg(Nje0,nn_hls) ) THEN
+ iiloc(jfl) = iil(jfl) - mig(1,nn_hls) + 1
+ ijloc(jfl) = ijl(jfl) - mjg(1,nn_hls) + 1
# else
iiloc(jfl) = iil(jfl)
ijloc(jfl) = ijl(jfl)
diff --git a/src/OCE/FLO/flodom.F90 b/src/OCE/FLO/flodom.F90
index e6536bd9b..2a0210d4e 100644
--- a/src/OCE/FLO/flodom.F90
+++ b/src/OCE/FLO/flodom.F90
@@ -234,8 +234,8 @@ CONTAINS
zdyad = flo_dstnce( flxx(jfl), flyy(jfl), flxx(jfl), gphif(iimfl(jfl)-1,ijmfl(jfl)-1) )
! Translation of this distances (in meter) in indexes
- zgifl(jfl)= (iimfl(jfl)-0.5) + zdxab/e1u(iimfl(jfl)-1,ijmfl(jfl)) + (mig(1)-1)
- zgjfl(jfl)= (ijmfl(jfl)-0.5) + zdyad/e2v(iimfl(jfl),ijmfl(jfl)-1) + (mjg(1)-1)
+ zgifl(jfl)= (iimfl(jfl)-0.5) + zdxab/e1u(iimfl(jfl)-1,ijmfl(jfl)) + (mig(1,nn_hls)-1)
+ zgjfl(jfl)= (ijmfl(jfl)-0.5) + zdyad/e2v(iimfl(jfl),ijmfl(jfl)-1) + (mjg(1,nn_hls)-1)
zgkfl(jfl) = (( gdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1,Kmm) - flzz(jfl) )* ikmfl(jfl)) &
& / ( gdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1,Kmm) &
& - gdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl) ,Kmm) ) &
diff --git a/src/OCE/FLO/florst.F90 b/src/OCE/FLO/florst.F90
index 59817e085..c855b1b7a 100644
--- a/src/OCE/FLO/florst.F90
+++ b/src/OCE/FLO/florst.F90
@@ -97,10 +97,10 @@ CONTAINS
!
IF( lk_mpp ) THEN
DO jfl = 1, jpnfl
- IF( (INT(tpifl(jfl)) >= mig(Nis0)) .AND. &
- &(INT(tpifl(jfl)) <= mig(Nie0)) .AND. &
- &(INT(tpjfl(jfl)) >= mjg(Njs0)) .AND. &
- &(INT(tpjfl(jfl)) <= mjg(Nje0)) ) THEN
+ IF( (INT(tpifl(jfl)) >= mig(Nis0,nn_hls)) .AND. &
+ &(INT(tpifl(jfl)) <= mig(Nie0,nn_hls)) .AND. &
+ &(INT(tpjfl(jfl)) >= mjg(Njs0,nn_hls)) .AND. &
+ &(INT(tpjfl(jfl)) <= mjg(Nje0,nn_hls)) ) THEN
iperproc(narea) = iperproc(narea)+1
ENDIF
END DO
diff --git a/src/OCE/FLO/flowri.F90 b/src/OCE/FLO/flowri.F90
index 7451c1be5..9c3473ffb 100644
--- a/src/OCE/FLO/flowri.F90
+++ b/src/OCE/FLO/flowri.F90
@@ -103,8 +103,8 @@ CONTAINS
IF( lk_mpp ) THEN
- iafloc = mi1( iafl )
- ibfloc = mj1( ibfl )
+ iafloc = mi1( iafl, nn_hls )
+ ibfloc = mj1( ibfl, nn_hls )
IF( Nis0 <= iafloc .AND. iafloc <= Nie0 .AND. &
& Njs0 <= ibfloc .AND. ibfloc <= Nje0 ) THEN
diff --git a/src/OCE/ICB/icbclv.F90 b/src/OCE/ICB/icbclv.F90
index 0121cbb85..bb26759d0 100644
--- a/src/OCE/ICB/icbclv.F90
+++ b/src/OCE/ICB/icbclv.F90
@@ -132,8 +132,8 @@ CONTAINS
!
newpt%lon = glamt(ji,jj) ! at t-point (centre of the cell)
newpt%lat = gphit(ji,jj)
- newpt%xi = REAL( mig(ji), wp ) - ( nn_hls - 1 )
- newpt%yj = REAL( mjg(jj), wp ) - ( nn_hls - 1 )
+ newpt%xi = REAL( mig(ji,nn_hls), wp ) - ( nn_hls - 1 )
+ newpt%yj = REAL( mjg(jj,nn_hls), wp ) - ( nn_hls - 1 )
!
newpt%uvel = 0._wp ! initially at rest
newpt%vvel = 0._wp
diff --git a/src/OCE/ICB/icbdyn.F90 b/src/OCE/ICB/icbdyn.F90
index 323758f4f..0de3d453c 100644
--- a/src/OCE/ICB/icbdyn.F90
+++ b/src/OCE/ICB/icbdyn.F90
@@ -197,10 +197,10 @@ CONTAINS
IF( ii == ii0 .AND. ij == ij0 ) RETURN ! berg remains in the same cell
!
! map into current processor
- ii0 = mi1( ii0 )
- ij0 = mj1( ij0 )
- ii = mi1( ii )
- ij = mj1( ij )
+ ii0 = mi1( ii0, nn_hls )
+ ij0 = mj1( ij0, nn_hls )
+ ii = mi1( ii , nn_hls )
+ ij = mj1( ij , nn_hls )
!
! assume icb is grounded if tmask(ii,ij,1) or tmask(ii,ij,ikb), depending of the option is not 0
IF ( ln_M2016 .AND. ln_icb_grd ) THEN
diff --git a/src/OCE/ICB/icbini.F90 b/src/OCE/ICB/icbini.F90
index d7bd2624c..0fd183888 100644
--- a/src/OCE/ICB/icbini.F90
+++ b/src/OCE/ICB/icbini.F90
@@ -140,7 +140,7 @@ CONTAINS
DO_2D( 1, 1, 1, 1 )
src_calving_hflx(ji,jj) = narea
- src_calving (ji,jj) = nicbpack * mjg(jj) + mig(ji)
+ src_calving (ji,jj) = nicbpack * mjg(jj,nn_hls) + mig(ji,nn_hls)
END_2D
CALL lbc_lnk( 'icbini', src_calving_hflx, 'T', 1._wp )
CALL lbc_lnk( 'icbini', src_calving , 'T', 1._wp )
@@ -156,7 +156,7 @@ CONTAINS
i2 = INT( i3/nicbpack )
i1 = i3 - i2*nicbpack
i3 = INT( src_calving_hflx(ji,jj) )
- IF( i1 == mig(ji) .AND. i3 == narea ) THEN
+ IF( i1 == mig(ji,nn_hls) .AND. i3 == narea ) THEN
IF( nicbdi < 0 ) THEN ; nicbdi = ji
ELSE ; nicbei = ji
ENDIF
@@ -172,7 +172,7 @@ CONTAINS
i2 = INT( i3/nicbpack )
i1 = i3 - i2*nicbpack
i3 = INT( src_calving_hflx(ji,jj) )
- IF( i2 == mjg(jj) .AND. i3 == narea ) THEN
+ IF( i2 == mjg(jj,nn_hls) .AND. i3 == narea ) THEN
IF( nicbdj < 0 ) THEN ; nicbdj = jj
ELSE ; nicbej = jj
ENDIF
@@ -361,8 +361,8 @@ CONTAINS
rn_test_box(1) < glamt(ji,jj) .AND. glamt(ji,jj) < rn_test_box(2) .AND. &
rn_test_box(3) < gphit(ji,jj) .AND. gphit(ji,jj) < rn_test_box(4) ) THEN
localberg%mass_scaling = rn_mass_scaling(iberg)
- localpt%xi = REAL( mig(ji) - (nn_hls-1), wp )
- localpt%yj = REAL( mjg(jj) - (nn_hls-1), wp )
+ localpt%xi = REAL( mig(ji,nn_hls) - (nn_hls-1), wp )
+ localpt%yj = REAL( mjg(jj,nn_hls) - (nn_hls-1), wp )
CALL icb_utl_interp( localpt%xi, localpt%yj, plat=localpt%lat, plon=localpt%lon )
localpt%mass = rn_initial_mass (iberg)
localpt%thickness = rn_initial_thickness(iberg)
diff --git a/src/OCE/ICB/icblbc.F90 b/src/OCE/ICB/icblbc.F90
index fa901486a..6a8823f1a 100644
--- a/src/OCE/ICB/icblbc.F90
+++ b/src/OCE/ICB/icblbc.F90
@@ -90,9 +90,9 @@ CONTAINS
this => first_berg
DO WHILE( ASSOCIATED(this) )
pt => this%current_point
- IF( pt%xi > REAL(mig(nicbei),wp) + 0.5_wp ) THEN
+ IF( pt%xi > REAL(mig(nicbei,nn_hls),wp) + 0.5_wp ) THEN
pt%xi = ricb_right + MOD(pt%xi, 1._wp ) - 1._wp
- ELSE IF( pt%xi < REAL(mig(nicbdi),wp) - 0.5_wp ) THEN
+ ELSE IF( pt%xi < REAL(mig(nicbdi,nn_hls),wp) - 0.5_wp ) THEN
pt%xi = ricb_left + MOD(pt%xi, 1._wp )
ENDIF
this => this%next
@@ -125,10 +125,10 @@ CONTAINS
DO WHILE( ASSOCIATED(this) )
pt => this%current_point
ijne = INT( pt%yj + 0.5 )
- IF( pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp ) THEN
+ IF( pt%yj > REAL(mjg(nicbej,nn_hls),wp) + 0.5_wp ) THEN
!
iine = INT( pt%xi + 0.5 )
- ipts = nicbfldpts (mi1(iine))
+ ipts = nicbfldpts (mi1(iine,nn_hls))
!
! moving across the cut line means both position and
! velocity must change
@@ -228,7 +228,7 @@ CONTAINS
this => first_berg
DO WHILE (ASSOCIATED(this))
pt => this%current_point
- IF( ipe_E >= 0 .AND. pt%xi > REAL(mig(nicbei),wp) + 0.5_wp - (nn_hls-1) ) THEN
+ IF( ipe_E >= 0 .AND. pt%xi > REAL(mig(nicbei,nn_hls),wp) + 0.5_wp - (nn_hls-1) ) THEN
tmpberg => this
this => this%next
ibergs_to_send_e = ibergs_to_send_e + 1
@@ -241,7 +241,7 @@ CONTAINS
! now pack it into buffer and delete from list
CALL icb_pack_into_buffer( tmpberg, obuffer_e, ibergs_to_send_e)
CALL icb_utl_delete(first_berg, tmpberg)
- ELSE IF( ipe_W >= 0 .AND. pt%xi < REAL(mig(nicbdi),wp) - 0.5_wp - (nn_hls-1) ) THEN
+ ELSE IF( ipe_W >= 0 .AND. pt%xi < REAL(mig(nicbdi,nn_hls),wp) - 0.5_wp - (nn_hls-1) ) THEN
tmpberg => this
this => this%next
ibergs_to_send_w = ibergs_to_send_w + 1
@@ -320,7 +320,7 @@ CONTAINS
this => first_berg
DO WHILE (ASSOCIATED(this))
pt => this%current_point
- IF( ipe_N >= 0 .AND. pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp - (nn_hls-1) ) THEN
+ IF( ipe_N >= 0 .AND. pt%yj > REAL(mjg(nicbej,nn_hls),wp) + 0.5_wp - (nn_hls-1) ) THEN
tmpberg => this
this => this%next
ibergs_to_send_n = ibergs_to_send_n + 1
@@ -330,7 +330,7 @@ CONTAINS
ENDIF
CALL icb_pack_into_buffer( tmpberg, obuffer_n, ibergs_to_send_n)
CALL icb_utl_delete(first_berg, tmpberg)
- ELSE IF( ipe_S >= 0 .AND. pt%yj < REAL(mjg(nicbdj),wp) - 0.5_wp - (nn_hls-1) ) THEN
+ ELSE IF( ipe_S >= 0 .AND. pt%yj < REAL(mjg(nicbdj,nn_hls),wp) - 0.5_wp - (nn_hls-1) ) THEN
tmpberg => this
this => this%next
ibergs_to_send_s = ibergs_to_send_s + 1
@@ -441,10 +441,10 @@ CONTAINS
this => first_berg
DO WHILE (ASSOCIATED(this))
pt => this%current_point
- IF( pt%xi < REAL(mig(nicbdi),wp) - 0.5_wp - (nn_hls-1) .OR. &
- pt%xi > REAL(mig(nicbei),wp) + 0.5_wp - (nn_hls-1) .OR. &
- pt%yj < REAL(mjg(nicbdj),wp) - 0.5_wp - (nn_hls-1) .OR. &
- pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp - (nn_hls-1) ) THEN
+ IF( pt%xi < REAL(mig(nicbdi,nn_hls),wp) - 0.5_wp - (nn_hls-1) .OR. &
+ pt%xi > REAL(mig(nicbei,nn_hls),wp) + 0.5_wp - (nn_hls-1) .OR. &
+ pt%yj < REAL(mjg(nicbdj,nn_hls),wp) - 0.5_wp - (nn_hls-1) .OR. &
+ pt%yj > REAL(mjg(nicbej,nn_hls),wp) + 0.5_wp - (nn_hls-1) ) THEN
i = i + 1
WRITE(numicb,*) 'berg lost in halo: ', this%number(:)
WRITE(numicb,*) ' ', nimpp, njmpp
@@ -514,8 +514,8 @@ CONTAINS
DO WHILE (ASSOCIATED(this))
pt => this%current_point
iine = INT( pt%xi + 0.5 ) + (nn_hls-1)
- iproc = nicbflddest(mi1(iine))
- IF( pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp - (nn_hls-1) ) THEN
+ iproc = nicbflddest(mi1(iine,nn_hls))
+ IF( pt%yj > REAL(mjg(nicbej,nn_hls),wp) + 0.5_wp - (nn_hls-1) ) THEN
IF( iproc == ifldproc ) THEN
!
IF( iproc /= narea ) THEN
@@ -593,9 +593,9 @@ CONTAINS
pt => this%current_point
iine = INT( pt%xi + 0.5 ) + (nn_hls-1)
ijne = INT( pt%yj + 0.5 ) + (nn_hls-1)
- ipts = nicbfldpts (mi1(iine))
- iproc = nicbflddest(mi1(iine))
- IF( pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp - (nn_hls-1) ) THEN
+ ipts = nicbfldpts (mi1(iine,nn_hls))
+ iproc = nicbflddest(mi1(iine,nn_hls))
+ IF( pt%yj > REAL(mjg(nicbej,nn_hls),wp) + 0.5_wp - (nn_hls-1) ) THEN
IF( iproc == ifldproc ) THEN
!
! moving across the cut line means both position and
diff --git a/src/OCE/ICB/icbrst.F90 b/src/OCE/ICB/icbrst.F90
index 092b56e58..9e7560197 100644
--- a/src/OCE/ICB/icbrst.F90
+++ b/src/OCE/ICB/icbrst.F90
@@ -90,8 +90,8 @@ CONTAINS
ii = INT( localpt%xi + 0.5 ) + ( nn_hls-1 )
ij = INT( localpt%yj + 0.5 ) + ( nn_hls-1 )
! Only proceed if this iceberg is on the local processor (excluding halos).
- IF ( ii >= mig(Nis0) .AND. ii <= mig(Nie0) .AND. &
- & ij >= mjg(Njs0) .AND. ij <= mjg(Nje0) ) THEN
+ IF ( ii >= mig(Nis0,nn_hls) .AND. ii <= mig(Nie0,nn_hls) .AND. &
+ & ij >= mjg(Njs0,nn_hls) .AND. ij <= mjg(Nje0,nn_hls) ) THEN
CALL iom_get( ncid, jpdom_unknown, 'number', zdata(:) , ktime=jn, kstart=(/1/), kcount=(/nkounts/) )
localberg%number(:) = INT(zdata(:))
@@ -244,16 +244,16 @@ CONTAINS
! global attributes
IF( lk_mpp ) THEN
! Set domain parameters (assume jpdom_local_full)
- nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_number_total' , jpnij )
- nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_number' , narea-1 )
- nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_dimensions_ids' , (/ 1 , 2 /) )
- nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_size_global' , (/ Ni0glo , Nj0glo /) )
- nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_size_local' , (/ Ni_0 , Nj_0 /) )
- nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_position_first' , (/ mig0(Nis0), mjg0(Njs0) /) )
- nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_position_last' , (/ mig0(Nie0), mjg0(Nje0) /) )
- nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_halo_size_start', (/ 0 , 0 /) )
- nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_halo_size_end' , (/ 0 , 0 /) )
- nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_type' , 'BOX' )
+ nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_number_total' , jpnij )
+ nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_number' , narea-1 )
+ nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_dimensions_ids' , (/ 1 , 2 /) )
+ nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_size_global' , (/ Ni0glo , Nj0glo /) )
+ nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_size_local' , (/ Ni_0 , Nj_0 /) )
+ nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_position_first' , (/ mig(Nis0,0), mjg(Njs0,0) /) )
+ nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_position_last' , (/ mig(Nie0,0), mjg(Nje0,0) /) )
+ nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_halo_size_start', (/ 0 , 0 /) )
+ nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_halo_size_end' , (/ 0 , 0 /) )
+ nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_type' , 'BOX' )
ENDIF
IF (associated(first_berg)) then
diff --git a/src/OCE/ICB/icbthm.F90 b/src/OCE/ICB/icbthm.F90
index c39500dbe..89999acfd 100644
--- a/src/OCE/ICB/icbthm.F90
+++ b/src/OCE/ICB/icbthm.F90
@@ -112,9 +112,9 @@ CONTAINS
zxi = pt%xi ! position in (i,j) referential
zyj = pt%yj
ii = INT( zxi + 0.5 ) ! T-cell of the berg
- ii = mi1( ii + (nn_hls-1) )
+ ii = mi1( ii + (nn_hls-1), nn_hls )
ij = INT( zyj + 0.5 )
- ij = mj1( ij + (nn_hls-1) )
+ ij = mj1( ij + (nn_hls-1), nn_hls )
zVol = zT * zW * zL
! Environment
diff --git a/src/OCE/ICB/icbutl.F90 b/src/OCE/ICB/icbutl.F90
index 873245fcd..0666a6143 100644
--- a/src/OCE/ICB/icbutl.F90
+++ b/src/OCE/ICB/icbutl.F90
@@ -312,18 +312,18 @@ CONTAINS
!
IF (TRIM(cd_type) == 'T' ) THEN
ierr = 0
- IF ( kii < mig( 1 ) ) THEN ; ierr = ierr + 1
- ELSEIF( kii >= mig(jpi) ) THEN ; ierr = ierr + 1
+ IF ( kii < mig( 1 ,nn_hls) ) THEN ; ierr = ierr + 1
+ ELSEIF( kii >= mig(jpi,nn_hls) ) THEN ; ierr = ierr + 1
ENDIF
!
- IF ( kij < mjg( 1 ) ) THEN ; ierr = ierr + 1
- ELSEIF( kij >= mjg(jpj) ) THEN ; ierr = ierr + 1
+ IF ( kij < mjg( 1 ,nn_hls) ) THEN ; ierr = ierr + 1
+ ELSEIF( kij >= mjg(jpj,nn_hls) ) THEN ; ierr = ierr + 1
ENDIF
!
IF ( ierr > 0 ) THEN
WRITE(numicb,*) 'bottom left corner T point out of bound'
- WRITE(numicb,*) pi, kii, mig( 1 ), mig(jpi)
- WRITE(numicb,*) pj, kij, mjg( 1 ), mjg(jpj)
+ WRITE(numicb,*) pi, kii, mig( 1,nn_hls ), mig(jpi,nn_hls)
+ WRITE(numicb,*) pj, kij, mjg( 1,nn_hls ), mjg(jpj,nn_hls)
WRITE(numicb,*) pmsk
CALL FLUSH(numicb)
CALL ctl_stop('STOP','icb_utl_bilin_e: an icebergs coordinates is out of valid range (out of bound error).' , &
@@ -335,13 +335,13 @@ CONTAINS
! find position in this processor. Prevent near edge problems (see #1389)
! (PM) will be useless if extra halo is used in NEMO
!
- IF ( kii <= mig(1)-1 ) THEN ; kii = 0
- ELSEIF( kii > mig(jpi) ) THEN ; kii = jpi
- ELSE ; kii = mi1(kii)
+ IF ( kii <= mig(1,nn_hls)-1 ) THEN ; kii = 0
+ ELSEIF( kii > mig(jpi,nn_hls) ) THEN ; kii = jpi
+ ELSE ; kii = mi1(kii,nn_hls)
ENDIF
- IF ( kij <= mjg(1)-1 ) THEN ; kij = 0
- ELSEIF( kij > mjg(jpj) ) THEN ; kij = jpj
- ELSE ; kij = mj1(kij)
+ IF ( kij <= mjg(1,nn_hls)-1 ) THEN ; kij = 0
+ ELSEIF( kij > mjg(jpj,nn_hls) ) THEN ; kij = jpj
+ ELSE ; kij = mj1(kij,nn_hls)
ENDIF
!
! define mask array
@@ -462,8 +462,8 @@ CONTAINS
zj = pj - REAL(ij,wp)
! conversion to local domain (no need to do a sanity check already done in icbpos)
- ii = mi1(ii) + (nn_hls-1)
- ij = mj1(ij) + (nn_hls-1)
+ ii = mi1(ii,nn_hls) + (nn_hls-1)
+ ij = mj1(ij,nn_hls) + (nn_hls-1)
!
IF( 0.0_wp <= zi .AND. zi < 0.5_wp ) THEN
IF( 0.0_wp <= zj .AND. zj < 0.5_wp ) THEN ! NE quadrant
diff --git a/src/OCE/IOM/iom.F90 b/src/OCE/IOM/iom.F90
index 9a1f1c859..39a8b05a2 100644
--- a/src/OCE/IOM/iom.F90
+++ b/src/OCE/IOM/iom.F90
@@ -1202,7 +1202,6 @@ CONTAINS
CHARACTER(LEN=1) :: cl_type ! local value of cd_type
LOGICAL :: ll_only3rd ! T => if kstart, kcount present then *only* use values for 3rd spatial dimension.
INTEGER :: inlev ! number of levels for 3D data
- INTEGER :: ihls ! local value of the halo size
REAL(dp) :: gma, gmi
!---------------------------------------------------------------------
CHARACTER(LEN=lc) :: context
@@ -1299,7 +1298,7 @@ CONTAINS
ENDIF
ELSE ! not a 1D array as pv_r1d requires jpdom_unknown
! we do not read the overlap and the extra-halos -> from Nis0 to Nie0 and from Njs0 to Nje0
- IF( idom == jpdom_global ) istart(1:2) = (/ mig0(Nis0), mjg0(Njs0) /)
+ IF( idom == jpdom_global ) istart(1:2) = (/ mig(Nis0,0), mjg(Njs0,0) /)
icnt(1:2) = (/ Ni_0, Nj_0 /)
IF( PRESENT(pv_r3d) ) THEN
IF( idom == jpdom_auto_xy ) THEN
@@ -1334,15 +1333,12 @@ CONTAINS
IF( irankpv == 2 ) ishape(1:2) = SHAPE(pv_r2d)
IF( irankpv == 3 ) ishape(1:3) = SHAPE(pv_r3d)
IF( ishape(1) == Ni_0 .AND. ishape(2) == Nj_0 ) THEN ! array with 0 halo
- ihls = 0
ix1 = 1 ; ix2 = Ni_0 ; iy1 = 1 ; iy2 = Nj_0 ! index of the array to be read
ctmp1 = 'd(:,:'
ELSEIF( ishape(1) == jpi .AND. ishape(2) == jpj ) THEN ! array with nn_hls halos
- ihls = nn_hls
ix1 = Nis0 ; ix2 = Nie0 ; iy1 = Njs0 ; iy2 = Nje0 ! index of the array to be read
ctmp1 = 'd(Nis0:Nie0,Njs0:Nje0'
ELSEIF( ishape(1) == Ni_0+1 .AND. ishape(2) == Nj_0+1 ) THEN ! nn_hls = 2 and array with 1 halo
- ihls = 1
ix1 = 2 ; ix2 = Ni_0+1 ; iy1 = 2 ; iy2 = Nj_0+1 ! index of the array to be read
ctmp1 = 'd(2:Ni_0+1,2:Ni_0+1'
ELSE
@@ -1368,16 +1364,16 @@ CONTAINS
IF( istop == nstop ) THEN ! no additional errors until this point...
IF(lwp) WRITE(numout,"(10x,' read ',a,' (rec: ',i6,') in ',a,' ok')") TRIM(cdvar), itime, TRIM(iom_file(kiomid)%name)
+ cl_type = 'T'
+ IF( PRESENT(cd_type) ) cl_type = cd_type
!--- halos and NP folding (NP folding to be done even if no halos)
IF( idom /= jpdom_unknown .AND. cl_type /= 'Z' .AND. ( PRESENT(pv_r2d) .OR. PRESENT(pv_r3d) ) ) THEN
- cl_type = 'T'
- IF( PRESENT(cd_type) ) cl_type = cd_type
zsgn = 1._wp
IF( PRESENT(psgn ) ) zsgn = psgn
IF( PRESENT(pv_r2d) .AND. llok ) THEN
- CALL lbc_lnk( 'iom', pv_r2d, cl_type, zsgn, kfillmode = kfill, khls = ihls )
+ CALL lbc_lnk( 'iom', pv_r2d, cl_type, zsgn, kfillmode = kfill )
ELSEIF( PRESENT(pv_r3d) .AND. llok ) THEN
- CALL lbc_lnk( 'iom', pv_r3d, cl_type, zsgn, kfillmode = kfill, khls = ihls )
+ CALL lbc_lnk( 'iom', pv_r3d, cl_type, zsgn, kfillmode = kfill )
ENDIF
ENDIF
!
@@ -2335,11 +2331,11 @@ CONTAINS
LOGICAL, INTENT(IN) :: ldxios, ldrxios
!!----------------------------------------------------------------------
!
- 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)
+ CALL iom_set_domain_attr("grid_"//cdgrd,ni_glo=Ni0glo,nj_glo=Nj0glo,ibegin=mig(Nis0,0)-1,jbegin=mjg(Njs0,0)-1,ni=Ni_0,nj=Nj_0)
CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = -nn_hls, data_ni=jpi, data_jbegin = -nn_hls, data_nj=jpj)
CALL iom_set_domain_attr("grid_"//cdgrd//"_inner", ni_glo = Ni0glo, nj_glo = Nj0glo, &
- & ibegin = mig0(Nis0) - 1, jbegin = mjg0(Njs0) - 1, ni = Ni_0, nj = Nj_0)
+ & ibegin = mig(Nis0,0) - 1, jbegin = mjg(Njs0,0) - 1, ni = Ni_0, nj = Nj_0)
CALL iom_set_domain_attr("grid_"//cdgrd//"_inner", data_dim=2, data_ibegin = 0, data_ni=Ni_0, data_jbegin = 0, data_nj=Nj_0)
IF( ln_tile ) THEN
@@ -2465,7 +2461,7 @@ CONTAINS
!
! CALL dom_ngb( -168.53_wp, 65.03_wp, ix, iy, 'T' ) ! i-line that passes through Bering Strait: Reference latitude (used in plots)
CALL dom_ngb( 180.0_wp, 90.0_wp, ix, iy, 'T' ) ! i-line that passes near the North Pole : Reference latitude (used in plots)
- CALL iom_set_domain_attr("gznl", ni_glo=Ni0glo, nj_glo=Nj0glo, ibegin=mig0(Nis0)-1, jbegin=mjg0(Njs0)-1, ni=Ni_0, nj=Nj_0)
+ CALL iom_set_domain_attr("gznl", ni_glo=Ni0glo, nj_glo=Nj0glo, ibegin=mig(Nis0,0)-1, jbegin=mjg(Njs0,0)-1, ni=Ni_0, nj=Nj_0)
CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin=0, data_ni=Ni_0, data_jbegin=0, data_nj=Nj_0)
CALL iom_set_domain_attr("gznl", lonvalue = real(zlon, dp), &
& latvalue = real(RESHAPE(plat(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)),dp))
diff --git a/src/OCE/IOM/iom_nf90.F90 b/src/OCE/IOM/iom_nf90.F90
index 171ef53bf..6a95cdd39 100644
--- a/src/OCE/IOM/iom_nf90.F90
+++ b/src/OCE/IOM/iom_nf90.F90
@@ -146,16 +146,16 @@ CONTAINS
END SELECT
CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo)
! global attributes
- CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number_total' , jpnij ), clinfo)
- CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number' , narea-1 ), clinfo)
- CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_dimensions_ids' , (/ 1 , 2 /) ), clinfo)
- CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_size_global' , (/ Ni0glo , Nj0glo /) ), clinfo)
- CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_size_local' , (/ Ni_0 , Nj_0 /) ), clinfo)
- CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_position_first' , (/ mig0(Nis0), mjg0(Njs0) /) ), clinfo)
- CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_position_last' , (/ mig0(Nie0), mjg0(Nje0) /) ), clinfo)
- CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_halo_size_start', (/ 0 , 0 /) ), clinfo)
- CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_halo_size_end' , (/ 0 , 0 /) ), clinfo)
- CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_type' , 'BOX' ), clinfo)
+ CALL iom_nf90_check(NF90_PUT_ATT(if90id,NF90_GLOBAL, 'DOMAIN_number_total' , jpnij ), clinfo)
+ CALL iom_nf90_check(NF90_PUT_ATT(if90id,NF90_GLOBAL, 'DOMAIN_number' , narea-1 ), clinfo)
+ CALL iom_nf90_check(NF90_PUT_ATT(if90id,NF90_GLOBAL, 'DOMAIN_dimensions_ids' , (/ 1 , 2 /) ), clinfo)
+ CALL iom_nf90_check(NF90_PUT_ATT(if90id,NF90_GLOBAL, 'DOMAIN_size_global' , (/ Ni0glo , Nj0glo /) ), clinfo)
+ CALL iom_nf90_check(NF90_PUT_ATT(if90id,NF90_GLOBAL, 'DOMAIN_size_local' , (/ Ni_0 , Nj_0 /) ), clinfo)
+ CALL iom_nf90_check(NF90_PUT_ATT(if90id,NF90_GLOBAL, 'DOMAIN_position_first' , (/ mig(Nis0,0), mjg(Njs0,0) /) ), clinfo)
+ CALL iom_nf90_check(NF90_PUT_ATT(if90id,NF90_GLOBAL, 'DOMAIN_position_last' , (/ mig(Nie0,0), mjg(Nje0,0) /) ), clinfo)
+ CALL iom_nf90_check(NF90_PUT_ATT(if90id,NF90_GLOBAL, 'DOMAIN_halo_size_start', (/ 0 , 0 /) ), clinfo)
+ CALL iom_nf90_check(NF90_PUT_ATT(if90id,NF90_GLOBAL, 'DOMAIN_halo_size_end' , (/ 0 , 0 /) ), clinfo)
+ CALL iom_nf90_check(NF90_PUT_ATT(if90id,NF90_GLOBAL, 'DOMAIN_type' , 'BOX' ), clinfo)
ELSE !* the file should be open for read mode so it must exist...
CALL ctl_stop( TRIM(clinfo), ' should be impossible case...' )
ENDIF
diff --git a/src/OCE/IOM/prtctl.F90 b/src/OCE/IOM/prtctl.F90
index 6fcca35f9..863932c9e 100644
--- a/src/OCE/IOM/prtctl.F90
+++ b/src/OCE/IOM/prtctl.F90
@@ -472,22 +472,22 @@ CONTAINS
!
idg = MAXVAL( (/ nall_ictls(jl), nall_ictle(jl), nall_jctls(jl), nall_jctle(jl) /) ) ! temporary use of idg
idg = INT(LOG10(REAL(idg,wp))) + 1 ! how many digits do we use?
- idg2 = MAXVAL( (/ mig0(nall_ictls(jl)), mig0(nall_ictle(jl)), mjg0(nall_jctls(jl)), mjg0(nall_jctle(jl)) /) )
+ idg2 = MAXVAL( (/ mig(nall_ictls(jl),0), mig(nall_ictle(jl),0), mjg(nall_jctls(jl),0), mjg(nall_jctle(jl),0) /) )
idg2 = INT(LOG10(REAL(idg2,wp))) + 1 ! how many digits do we use?
WRITE(clfmt2, "('(18x, 13a1, a9, i', i1, ', a2, i',i1,', a2, 13a1)')") idg, idg2
WRITE(clfmt3, "('(18x, a1, ', i2,'x, a1)')") 13+9+idg+2+idg2+2+13 - 2
WRITE(clfmt4, "('(', i2,'x, a9, i', i1,', a2, i', i1,', a2, ', i2,'x, a9, i', i1,', a2, i', i1,', a2)')") &
& 18-7, idg, idg2, 13+9+idg+2+idg2+2+13 - (2+idg+2+idg2+2+8), idg, idg2
- WRITE(inum,clfmt2) ('-', ji=1,13), ' jctle = ', nall_jctle(jl), ' (', mjg0(nall_jctle(jl)), ') ', ('-', ji=1,13)
+ WRITE(inum,clfmt2) ('-', ji=1,13), ' jctle = ', nall_jctle(jl), ' (', mjg(nall_jctle(jl),0), ') ', ('-', ji=1,13)
WRITE(inum,clfmt3) '|', '|'
WRITE(inum,clfmt3) '|', '|'
WRITE(inum,clfmt3) '|', '|'
- WRITE(inum,clfmt4) ' ictls = ', nall_ictls(jl), ' (', mig0(nall_ictls(jl)), ') ', &
- & ' ictle = ', nall_ictle(jl), ' (', mig0(nall_ictle(jl)), ') '
+ WRITE(inum,clfmt4) ' ictls = ', nall_ictls(jl), ' (', mig(nall_ictls(jl),0), ') ', &
+ & ' ictle = ', nall_ictle(jl), ' (', mig(nall_ictle(jl),0), ') '
WRITE(inum,clfmt3) '|', '|'
WRITE(inum,clfmt3) '|', '|'
WRITE(inum,clfmt3) '|', '|'
- WRITE(inum,clfmt2) ('-', ji=1,13), ' jctls = ', nall_jctls(jl), ' (', mjg0(nall_jctls(jl)), ') ', ('-', ji=1,13)
+ WRITE(inum,clfmt2) ('-', ji=1,13), ' jctls = ', nall_jctls(jl), ' (', mjg(nall_jctls(jl),0), ') ', ('-', ji=1,13)
WRITE(inum,*)
WRITE(inum,*)
!
diff --git a/src/OCE/ISF/isfcpl.F90 b/src/OCE/ISF/isfcpl.F90
index b035cd5e6..4989dc850 100644
--- a/src/OCE/ISF/isfcpl.F90
+++ b/src/OCE/ISF/isfcpl.F90
@@ -736,7 +736,8 @@ CONTAINS
END IF
!
! update isfpts structure
- sisfpts(kpts) = isfcons(mig(ki), mjg(kj), kk, pratio * pdvol, pratio * pdsal, pratio * pdtem, glamt(ki,kj), gphit(ki,kj), ifind )
+ sisfpts(kpts) = isfcons(mig(ki,nn_hls), mjg(kj,nn_hls), kk, pratio * pdvol, pratio * pdsal, pratio * pdtem, &
+ & glamt(ki,kj), gphit(ki,kj), ifind )
!
END SUBROUTINE update_isfpts
!
@@ -761,8 +762,8 @@ CONTAINS
IF ( kfind == 1 ) CALL dom_ngb( plon, plat, iig, ijg,'T', kk)
!
! fill the correction array
- DO jj = mj0(ijg),mj1(ijg)
- DO ji = mi0(iig),mi1(iig)
+ DO jj = mj0(ijg,nn_hls),mj1(ijg,nn_hls)
+ DO ji = mi0(iig,nn_hls),mi1(iig,nn_hls)
! correct the vol_flx and corresponding heat/salt flx in the closest cell
risfcpl_cons_vol(ji,jj,kk) = risfcpl_cons_vol(ji,jj,kk ) + pvolinc
risfcpl_cons_tsc(ji,jj,kk,jp_sal) = risfcpl_cons_tsc(ji,jj,kk,jp_sal) + psalinc
diff --git a/src/OCE/LBC/lbc_lnk_call_generic.h90 b/src/OCE/LBC/lbc_lnk_call_generic.h90
index 0d2e2514b..f735ac909 100644
--- a/src/OCE/LBC/lbc_lnk_call_generic.h90
+++ b/src/OCE/LBC/lbc_lnk_call_generic.h90
@@ -27,7 +27,7 @@
& , pt21, cdna21, psgn21, pt22, cdna22, psgn22, pt23, cdna23, psgn23, pt24, cdna24, psgn24 &
& , pt25, cdna25, psgn25, pt26, cdna26, psgn26, pt27, cdna27, psgn27, pt28, cdna28, psgn28 &
& , pt29, cdna29, psgn29, pt30, cdna30, psgn30 &
- & , kfillmode, pfillval, khls, lsend, lrecv, ld4only )
+ & , kfillmode, pfillval, lsend, lrecv, ld4only )
!!---------------------------------------------------------------------
CHARACTER(len=*) , INTENT(in ) :: cdname ! name of the calling subroutine
REAL(PRECISION), DIMENSION(DIMS) , TARGET, CONTIGUOUS, INTENT(inout) :: pt1 ! arrays on which the lbc is applied
@@ -50,7 +50,6 @@
& psgn30
INTEGER , OPTIONAL , INTENT(in ) :: kfillmode ! filling method for halo over land (default = constant)
REAL(PRECISION) , OPTIONAL , INTENT(in ) :: pfillval ! background value (used at closed boundaries)
- INTEGER , OPTIONAL , INTENT(in ) :: khls ! halo size, default = nn_hls
LOGICAL, DIMENSION(8), OPTIONAL , INTENT(in ) :: lsend, lrecv ! indicate how communications are to be carried out
LOGICAL , OPTIONAL , INTENT(in ) :: ld4only ! if .T., do only 4-neighbour comm (ignore corners)
!!
@@ -96,15 +95,11 @@
IF( PRESENT(psgn29) ) CALL load_ptr_/**/XD/**/_/**/PRECISION( pt29, cdna29, psgn29, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
IF( PRESENT(psgn30) ) CALL load_ptr_/**/XD/**/_/**/PRECISION( pt30, cdna30, psgn30, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
!
-#if ! defined key_mpi2
IF( nn_comm == 1 ) THEN
- CALL lbc_lnk_pt2pt( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, khls, lsend, lrecv, ld4only )
+ CALL lbc_lnk_pt2pt( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, lsend, lrecv, ld4only )
ELSE
- CALL lbc_lnk_neicoll( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, khls, lsend, lrecv, ld4only )
+ CALL lbc_lnk_neicoll( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, lsend, lrecv, ld4only )
ENDIF
-#else
- CALL lbc_lnk_pt2pt( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, khls, lsend, lrecv, ld4only )
-#endif
!
END SUBROUTINE lbc_lnk_call_/**/XD/**/_/**/PRECISION
diff --git a/src/OCE/LBC/lbc_lnk_neicoll_generic.h90 b/src/OCE/LBC/lbc_lnk_neicoll_generic.h90
index 3ce416fe1..d6bd30380 100644
--- a/src/OCE/LBC/lbc_lnk_neicoll_generic.h90
+++ b/src/OCE/LBC/lbc_lnk_neicoll_generic.h90
@@ -1,5 +1,5 @@
- SUBROUTINE lbc_lnk_neicoll_/**/PRECISION( cdname, ptab, cd_nat, psgn, kfld, kfillmode, pfillval, khls, lsend, lrecv, ld4only )
+ SUBROUTINE lbc_lnk_neicoll_/**/PRECISION( cdname, ptab, cd_nat, psgn, kfld, kfillmode, pfillval, lsend, lrecv, ld4only )
CHARACTER(len=*) , INTENT(in ) :: cdname ! name of the calling subroutine
TYPE(PTR_4d_/**/PRECISION), DIMENSION(:), INTENT(inout) :: ptab ! pointer of arrays on which apply the b.c.
CHARACTER(len=1), DIMENSION(:), INTENT(in ) :: cd_nat ! nature of array grid-points
@@ -7,265 +7,311 @@
INTEGER , INTENT(in ) :: kfld ! number of pt3d arrays
INTEGER , OPTIONAL, INTENT(in ) :: kfillmode ! filling method for halo over land (default = constant)
REAL(PRECISION), OPTIONAL, INTENT(in ) :: pfillval ! background value (used at closed boundaries)
- INTEGER , OPTIONAL, INTENT(in ) :: khls ! halo size, default = nn_hls
LOGICAL, DIMENSION(8),OPTIONAL, INTENT(in ) :: lsend, lrecv ! communication with other 4 proc
LOGICAL, OPTIONAL, INTENT(in ) :: ld4only ! if .T., do only 4-neighbour comm (ignore corners)
!
INTEGER :: ji, jj, jk , jl, jf, jn ! dummy loop indices
- INTEGER :: ipi, ipj, ipk, ipl, ipf ! dimension of the input array
INTEGER :: ip0i, ip1i, im0i, im1i
INTEGER :: ip0j, ip1j, im0j, im1j
INTEGER :: ishti, ishtj, ishti2, ishtj2
- INTEGER :: iszS, iszR
+ INTEGER :: inbS, inbR, iszS, iszR
INTEGER :: ierr
- INTEGER :: ihls, idx
+ INTEGER :: ihls, ihlsmax, idx
INTEGER :: impi_nc
INTEGER :: ifill_nfd
INTEGER, DIMENSION(4) :: iwewe, issnn
- INTEGER, DIMENSION(8) :: isizei, ishtSi, ishtRi, ishtPi
- INTEGER, DIMENSION(8) :: isizej, ishtSj, ishtRj, ishtPj
- INTEGER, DIMENSION(8) :: ifill, iszall
- INTEGER, DIMENSION(8) :: jnf
+ INTEGER, DIMENSION( kfld) :: ipi, ipj, ipk, ipl ! dimension of the input array
+ INTEGER, DIMENSION(8,kfld) :: ifill
+ INTEGER, DIMENSION(8,kfld) :: isizei, ishtSi, ishtRi, ishtPi
+ INTEGER, DIMENSION(8,kfld) :: isizej, ishtSj, ishtRj, ishtPj
INTEGER, DIMENSION(:), ALLOCATABLE :: iScnt, iRcnt ! number of elements to be sent/received
INTEGER, DIMENSION(:), ALLOCATABLE :: iSdpl, iRdpl ! displacement in halos arrays
- LOGICAL, DIMENSION(8) :: llsend, llrecv
- REAL(PRECISION) :: zland
+ LOGICAL, DIMENSION(8,kfld) :: llsend, llrecv
LOGICAL :: ll4only ! default: 8 neighbourgs
+ REAL(PRECISION) :: zland
!!----------------------------------------------------------------------
!
! ----------------------------------------- !
! 1. local variables initialization !
! ----------------------------------------- !
!
- ipi = SIZE(ptab(1)%pt4d,1)
- ipj = SIZE(ptab(1)%pt4d,2)
- ipk = SIZE(ptab(1)%pt4d,3)
- ipl = SIZE(ptab(1)%pt4d,4)
- ipf = kfld
- !
- IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ipk, ipl, ipf, ld_lbc = .TRUE. )
- !
! take care of optional parameters
!
- ihls = nn_hls ! default definition
- IF( PRESENT( khls ) ) ihls = khls
- IF( ihls > n_hlsmax ) THEN
- WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk with khls > n_hlsmax : ', khls, '>', n_hlsmax
- CALL ctl_stop( 'STOP', ctmp1 )
- ENDIF
- IF( ipi /= Ni_0+2*ihls ) THEN
- WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk with an input array which does not match ihls along i: ', ipi, ihls, Ni_0
- CALL ctl_stop( 'STOP', ctmp1 )
- ENDIF
- IF( ipj /= Nj_0+2*ihls ) THEN
- WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk with an input array which does not match ihls along j:', ipj, ihls , Nj_0
- CALL ctl_stop( 'STOP', ctmp1 )
- ENDIF
- !
ll4only = .FALSE. ! default definition
IF( PRESENT(ld4only) ) ll4only = ld4only
!
- impi_nc = mpi_nc_com8(ihls) ! default
- IF( ll4only ) impi_nc = mpi_nc_com4(ihls)
- !
zland = 0._wp ! land filling value: zero by default
IF( PRESENT( pfillval ) ) zland = pfillval ! set land value
!
- ! define llsend and llrecv: logicals which say if mpi-neibourgs for send or receive exist or not.
- IF ( PRESENT(lsend) .AND. PRESENT(lrecv) ) THEN ! localy defined neighbourgs
- CALL ctl_stop( 'STOP', 'mpp_nc_generic+lsend and lrecv not yet implemented')
- ELSE IF( PRESENT(lsend) .OR. PRESENT(lrecv) ) THEN
- WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk with only one of the two arguments lsend or lrecv'
- CALL ctl_stop( 'STOP', ctmp1 )
- ELSE ! default neighbours
- llsend(:) = mpiSnei(ihls,:) >= 0
- IF( ll4only ) llsend(5:8) = .FALSE. ! exclude corners
- llrecv(:) = mpiRnei(ihls,:) >= 0
- IF( ll4only ) llrecv(5:8) = .FALSE. ! exclude corners
- ENDIF
+ ifill_nfd = jpfillcst ! default definition
+ IF( PRESENT(kfillmode) ) ifill_nfd = kfillmode
!
- ! define ifill: which method should be used to fill each parts (sides+corners) of the halos
- ! default definition
- DO jn = 1, 8
- IF( llrecv(jn) ) THEN ; ifill(jn) = jpfillmpi ! with an mpi communication
- ELSEIF( l_SelfPerio(jn) ) THEN ; ifill(jn) = jpfillperio ! with self-periodicity
- ELSEIF( PRESENT(kfillmode) ) THEN ; ifill(jn) = kfillmode ! localy defined
- ELSE ; ifill(jn) = jpfillcst ! constant value (zland)
- ENDIF
- END DO
- ! take care of "indirect self-periodicity" for the corners
- DO jn = 5, 8
- IF(.NOT.l_SelfPerio(jn) .AND. l_SelfPerio(jpwe)) ifill(jn) = jpfillnothing ! no bi-perio but ew-perio: do corners later
- IF(.NOT.l_SelfPerio(jn) .AND. l_SelfPerio(jpso)) ifill(jn) = jpfillnothing ! no bi-perio but ns-perio: do corners later
- END DO
- ! north fold treatment
- IF( l_IdoNFold ) THEN
- ifill_nfd = ifill(jpno) ! if we are here, this means llrecv(jpno) = .false. and l_SelfPerio(jpno) = .false.
- ifill( (/jpno/) ) = jpfillnothing ! we do north fold -> do nothing for northern halo
- ENDIF
-
- ! We first define the localization and size of the parts of the array that will be sent (s), received (r)
- ! or used for periodocity (p). The localization is defined as "the bottom left corner - 1" in i and j directions.
- ! This is a shift that will be applied later in the do loops to pick-up the appropriate part of the array
+ ihlsmax = 0
!
- ! all definitions bellow do not refer to N[ij][se]0 so we can use it with any local value of ihls
- ! ! ________________________
- ip0i = 0 ! im0j = inner |__|________________|__|
- ip1i = ihls ! im1j = inner - halo | |__|__________|__| |
- im1i = ipi-2*ihls ! | | | | | |
- im0i = ipi - ihls ! | | | | | |
- ip0j = 0 ! | | | | | |
- ip1j = ihls ! | |__|__________|__| |
- im1j = ipj-2*ihls ! ip1j = halo |__|__|__________|__|__|
- im0j = ipj - ihls ! ip0j = 0 |__|________________|__|
- ! ! ip0i ip1i im1i im0i
+ DO jf = 1, kfld
+ !
+ ipi(jf) = SIZE(ptab(jf)%pt4d,1)
+ ipj(jf) = SIZE(ptab(jf)%pt4d,2)
+ ipk(jf) = SIZE(ptab(jf)%pt4d,3)
+ ipl(jf) = SIZE(ptab(jf)%pt4d,4)
+ ihls = ( ipi(jf) - Ni_0 ) / 2
+ ihlsmax = MAX(ihls, ihlsmax)
+ !
+ IF( numcom == -1 ) THEN ! test input array shape. Use numcom to do these tests only at the beginning of the run
+ IF( MOD( ipi(jf) - Ni_0, 2 ) /= 0 ) THEN
+ WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk but the ', jf,'th input array has wong i-size: ', ipi(jf), Ni_0
+ CALL ctl_stop( 'STOP', ctmp1 )
+ ENDIF
+ IF( MOD( ipj(jf) - Nj_0, 2 ) /= 0 ) THEN
+ WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk but the ', jf,'th input array has wong j-size: ', ipj(jf), Nj_0
+ CALL ctl_stop( 'STOP', ctmp1 )
+ ENDIF
+ IF( ( ipj(jf) - Nj_0 ) / 2 /= ihls ) THEN
+ WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk but the ', jf,'th input array as wong i and j-size: ', &
+ & ipi(jf), Ni_0, ipj(jf), Nj_0
+ CALL ctl_stop( 'STOP', ctmp1 )
+ ENDIF
+ IF( ihls > n_hlsmax ) THEN
+ WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk but for the ', jf,'th input array, ', ihls, ' > n_hlsmax = ', &
+ & n_hlsmax
+ CALL ctl_stop( 'STOP', ctmp1 )
+ ENDIF
+ ENDIF
+ !
+ ! define llsend and llrecv: logicals which say if mpi-neibourgs for send or receive exist or not.
+ IF ( PRESENT(lsend) .AND. PRESENT(lrecv) ) THEN ! localy defined neighbourgs
+ CALL ctl_stop( 'STOP', 'mpp_nc_generic+lsend and lrecv not yet implemented')
+ ELSE IF( PRESENT(lsend) .OR. PRESENT(lrecv) ) THEN
+ WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk with only one of the two arguments lsend or lrecv'
+ CALL ctl_stop( 'STOP', ctmp1 )
+ ELSE ! default neighbours
+ llsend(:,jf) = mpiSnei(ihls,:) >= 0
+ IF( ll4only ) llsend(5:8,jf) = .FALSE. ! exclude corners
+ llrecv(:,jf) = mpiRnei(ihls,:) >= 0
+ IF( ll4only ) llrecv(5:8,jf) = .FALSE. ! exclude corners
+ ENDIF
+ !
+ ! define ifill: which method should be used to fill each parts (sides+corners) of the halos
+ ! default definition
+ DO jn = 1, 8
+ IF( llrecv(jn,jf) ) THEN ; ifill(jn,jf) = jpfillmpi ! with an mpi communication
+ ELSEIF( l_SelfPerio(jn) ) THEN ; ifill(jn,jf) = jpfillperio ! with self-periodicity
+ ELSEIF( PRESENT(kfillmode) ) THEN ; ifill(jn,jf) = kfillmode ! localy defined
+ ELSEIF( ihls == 0 ) THEN ; ifill(jn,jf) = jpfillnothing ! do nothing
+ ELSE ; ifill(jn,jf) = jpfillcst ! constant value (zland)
+ ENDIF
+ END DO
+ ! take care of "indirect self-periodicity" for the corners
+ DO jn = 5, 8
+ IF(.NOT.l_SelfPerio(jn) .AND. l_SelfPerio(jpwe)) ifill(jn,jf) = jpfillnothing ! no bi-perio but ew-perio: do corners later
+ IF(.NOT.l_SelfPerio(jn) .AND. l_SelfPerio(jpso)) ifill(jn,jf) = jpfillnothing ! no bi-perio but ns-perio: do corners later
+ END DO
+ ! north fold treatment
+ IF( l_IdoNFold ) ifill(jpno,jf) = jpfillnothing ! we do north fold -> do nothing for northern halo
+
+ ! We first define the localization and size of the parts of the array that will be sent (s), received (r)
+ ! or used for periodocity (p). The localization is defined as "the bottom left corner - 1" in i and j directions.
+ ! This is a shift that will be applied later in the do loops to pick-up the appropriate part of the array
+ !
+ ! all definitions bellow do not refer to N[ij][se]0 so we can use it with any local value of ihls
+ ! ! ________________________
+ ip0i = 0 ! im0j = inner |__|________________|__|
+ ip1i = ihls ! im1j = inner - halo | |__|__________|__| |
+ im1i = ipi(jf)-2*ihls ! | | | | | |
+ im0i = ipi(jf) - ihls ! | | | | | |
+ ip0j = 0 ! | | | | | |
+ ip1j = ihls ! | |__|__________|__| |
+ im1j = ipj(jf)-2*ihls ! ip1j = halo |__|__|__________|__|__|
+ im0j = ipj(jf) - ihls ! ip0j = 0 |__|________________|__|
+ ! ! ip0i ip1i im1i im0i
+ !
+ iwewe(:) = (/ jpwe,jpea,jpwe,jpea /) ; issnn(:) = (/ jpso,jpso,jpno,jpno /)
+ ! sides: west east south north ; corners: so-we, so-ea, no-we, no-ea
+ isizei(1:4,jf) = (/ ihls, ihls, Ni_0, Ni_0 /) ; isizei(5:8,jf) = ihls ! i- count
+ isizej(1:4,jf) = (/ Nj_0, Nj_0, ihls, ihls /) ; isizej(5:8,jf) = ihls ! j- count
+ ishtSi(1:4,jf) = (/ ip1i, im1i, ip1i, ip1i /) ; ishtSi(5:8,jf) = ishtSi( iwewe,jf ) ! i- shift send data
+ ishtSj(1:4,jf) = (/ ip1j, ip1j, ip1j, im1j /) ; ishtSj(5:8,jf) = ishtSj( issnn,jf ) ! j- shift send data
+ ishtRi(1:4,jf) = (/ ip0i, im0i, ip1i, ip1i /) ; ishtRi(5:8,jf) = ishtRi( iwewe,jf ) ! i- shift recv data
+ ishtRj(1:4,jf) = (/ ip1j, ip1j, ip0j, im0j /) ; ishtRj(5:8,jf) = ishtRj( issnn,jf ) ! j- shift recv data
+ ishtPi(1:4,jf) = (/ im1i, ip1i, ip1i, ip1i /) ; ishtPi(5:8,jf) = ishtPi( iwewe,jf ) ! i- shift perio data
+ ishtPj(1:4,jf) = (/ ip1j, ip1j, im1j, ip1j /) ; ishtPj(5:8,jf) = ishtPj( issnn,jf ) ! j- shift perio data
+ !
+ END DO ! jf
!
- iwewe(:) = (/ jpwe,jpea,jpwe,jpea /) ; issnn(:) = (/ jpso,jpso,jpno,jpno /)
- ! sides: west east south north ; corners: so-we, so-ea, no-we, no-ea
- isizei(1:4) = (/ ihls, ihls, Ni_0, Ni_0 /) ; isizei(5:8) = ihls ! i- count
- isizej(1:4) = (/ Nj_0, Nj_0, ihls, ihls /) ; isizej(5:8) = ihls ! j- count
- ishtSi(1:4) = (/ ip1i, im1i, ip1i, ip1i /) ; ishtSi(5:8) = ishtSi( iwewe ) ! i- shift send data
- ishtSj(1:4) = (/ ip1j, ip1j, ip1j, im1j /) ; ishtSj(5:8) = ishtSj( issnn ) ! j- shift send data
- ishtRi(1:4) = (/ ip0i, im0i, ip1i, ip1i /) ; ishtRi(5:8) = ishtRi( iwewe ) ! i- shift received data location
- ishtRj(1:4) = (/ ip1j, ip1j, ip0j, im0j /) ; ishtRj(5:8) = ishtRj( issnn ) ! j- shift received data location
- ishtPi(1:4) = (/ im1i, ip1i, ip1i, ip1i /) ; ishtPi(5:8) = ishtPi( iwewe ) ! i- shift data used for periodicity
- ishtPj(1:4) = (/ ip1j, ip1j, im1j, ip1j /) ; ishtPj(5:8) = ishtPj( issnn ) ! j- shift data used for periodicity
+ IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, SUM(ipk(:))/kfld, SUM(ipl(:))/kfld, kfld, ld_lbc = .TRUE. )
!
! -------------------------------- !
! 2. Prepare MPI exchanges !
! -------------------------------- !
!
! Allocate local temporary arrays to be sent/received.
- iszS = COUNT( llsend )
- iszR = COUNT( llrecv )
- ALLOCATE( iScnt(iszS), iRcnt(iszR), iSdpl(iszS), iRdpl(iszR) ) ! ok if iszS = 0 or iszR = 0
- iszall(:) = isizei(:) * isizej(:) * ipk * ipl * ipf
- iScnt(:) = PACK( iszall, mask = llsend ) ! ok if mask = .false.
- iRcnt(:) = PACK( iszall, mask = llrecv )
- IF( iszS > 0 ) iSdpl(1) = 0
- DO jn = 2,iszS
+ inbS = COUNT( ANY(llsend,dim=2) ) ! number of snd neighbourgs
+ inbR = COUNT( ANY(llrecv,dim=2) ) ! number of rcv neighbourgs
+ ALLOCATE( iScnt(inbS), iRcnt(inbR), iSdpl(inbS), iRdpl(inbR) ) ! ok if iszS = 0 or iszR = 0
+
+ iScnt(:) = 0 ; idx = 0
+ DO jn = 1, 8
+ IF( COUNT( llsend(jn,:) ) > 0 ) THEN ! we send something to neighbourg jn
+ idx = idx + 1
+ DO jf = 1, kfld
+ IF( llsend(jn,jf) ) iScnt(idx) = iScnt(idx) + isizei(jn,jf) * isizej(jn,jf) * ipk(jf) * ipl(jf)
+ END DO
+ ENDIF
+ END DO
+ IF( inbS > 0 ) iSdpl(1) = 0
+ DO jn = 2,inbS
iSdpl(jn) = iSdpl(jn-1) + iScnt(jn-1) ! with _alltoallv: in units of sendtype
END DO
- IF( iszR > 0 ) iRdpl(1) = 0
- DO jn = 2,iszR
+
+ iRcnt(:) = 0 ; idx = 0
+ DO jn = 1, 8
+ IF( COUNT( llrecv(jn,:) ) > 0 ) THEN ! we get something from neighbourg jn
+ idx = idx + 1
+ DO jf = 1, kfld
+ IF( llrecv(jn,jf) ) iRcnt(idx) = iRcnt(idx) + isizei(jn,jf) * isizej(jn,jf) * ipk(jf) * ipl(jf)
+ END DO
+ ENDIF
+ END DO
+ IF( inbR > 0 ) iRdpl(1) = 0
+ DO jn = 2,inbR
iRdpl(jn) = iRdpl(jn-1) + iRcnt(jn-1) ! with _alltoallv: in units of sendtype
END DO
-
+ !
! Allocate buffer arrays to be sent/received if needed
- iszS = SUM(iszall, mask = llsend) ! send buffer size
+ iszS = SUM(iScnt) ! send buffer size
IF( ALLOCATED(BUFFSND) ) THEN
+ CALL mpi_waitall(8, nreq_p2p, MPI_STATUSES_IGNORE, ierr) ! needed only if PREVIOUS call was using nn_comm = 1 (for tests)
IF( SIZE(BUFFSND) < iszS ) DEALLOCATE(BUFFSND) ! send buffer is too small
ENDIF
IF( .NOT. ALLOCATED(BUFFSND) ) ALLOCATE( BUFFSND(iszS) )
- iszR = SUM(iszall, mask = llrecv) ! recv buffer size
+ iszR = SUM(iRcnt) ! recv buffer size
IF( ALLOCATED(BUFFRCV) ) THEN
IF( SIZE(BUFFRCV) < iszR ) DEALLOCATE(BUFFRCV) ! recv buffer is too small
ENDIF
IF( .NOT. ALLOCATED(BUFFRCV) ) ALLOCATE( BUFFRCV(iszR) )
-
+ !
! fill sending buffer with ptab(jf)%pt4d
- idx = 1
+ idx = 0
DO jn = 1, 8
- IF( llsend(jn) ) THEN
- ishti = ishtSi(jn)
- ishtj = ishtSj(jn)
- DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1,isizej(jn) ; DO ji = 1,isizei(jn)
- BUFFSND(idx) = ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl)
- idx = idx + 1
- END DO ; END DO ; END DO ; END DO ; END DO
- ENDIF
+ DO jf = 1, kfld
+ IF( llsend(jn,jf) ) THEN
+ ishti = ishtSi(jn,jf)
+ ishtj = ishtSj(jn,jf)
+ DO jl = 1, ipl(jf) ; DO jk = 1, ipk(jf) ; DO jj = 1,isizej(jn,jf) ; DO ji = 1,isizei(jn,jf)
+ idx = idx + 1
+ BUFFSND(idx) = ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl)
+ END DO ; END DO ; END DO ; END DO
+ ENDIF
+ END DO
END DO
!
! ------------------------------------------------ !
! 3. Do all MPI exchanges in 1 unique call !
! ------------------------------------------------ !
!
- IF( ln_timing ) CALL tic_tac(.TRUE.)
- CALL mpi_neighbor_alltoallv (BUFFSND, iScnt, iSdpl, MPI_TYPE, BUFFRCV, iRcnt, iRdpl, MPI_TYPE, impi_nc, ierr)
- IF( ln_timing ) CALL tic_tac(.FALSE.)
+ IF( ihlsmax > 0 ) THEN
+ impi_nc = mpi_nc_com8( ihlsmax )
+ IF( ll4only ) impi_nc = mpi_nc_com4( ihlsmax )
+#if ! defined key_mpi2
+ IF( ln_timing ) CALL tic_tac( .TRUE.)
+ CALL mpi_Ineighbor_alltoallv(BUFFSND, iScnt, iSdpl, MPI_TYPE, BUFFRCV, iRcnt, iRdpl, MPI_TYPE, impi_nc, nreq_nei, ierr)
+ IF( ln_timing ) CALL tic_tac(.FALSE.)
+#endif
+ ENDIF
+ nreq_p2p = MPI_REQUEST_NULL ! needed only if we switch between nn_comm = 1 and 2 (for tests)
!
- ! ------------------------- !
- ! 4. Fill all halos !
- ! ------------------------- !
+ ! --------------------------------- !
+ ! 4. Fill all Non-MPI halos !
+ ! --------------------------------- !
!
- idx = 1
- ! MPI3 bug fix when domain decomposition has 2 columns/rows
- IF (jpni .eq. 2) THEN
- IF (jpnj .eq. 2) THEN
- jnf(1:8) = (/ 2, 1, 4, 3, 8, 7, 6, 5 /)
- ELSE
- jnf(1:8) = (/ 2, 1, 3, 4, 6, 5, 8, 7 /)
- ENDIF
- ELSE
- IF (jpnj .eq. 2) THEN
- jnf(1:8) = (/ 1, 2, 4, 3, 7, 8, 5, 6 /)
- ELSE
- jnf(1:8) = (/ 1, 2, 3, 4, 5, 6, 7, 8 /)
- ENDIF
- ENDIF
-
+ ! do it first to give (potentially) more time for the communications
DO jn = 1, 8
- ishti = ishtRi(jnf(jn))
- ishtj = ishtRj(jnf(jn))
- SELECT CASE ( ifill(jnf(jn)) )
- CASE ( jpfillnothing ) ! no filling
- CASE ( jpfillmpi ) ! fill with data received by MPI
- DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1,isizej(jnf(jn)) ; DO ji = 1,isizei(jnf(jn))
- ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = BUFFRCV(idx)
- idx = idx + 1
- END DO ; END DO ; END DO ; END DO ; END DO
- CASE ( jpfillperio ) ! use periodicity
- ishti2 = ishtPi(jnf(jn))
- ishtj2 = ishtPj(jnf(jn))
- DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1,isizej(jnf(jn)) ; DO ji = 1,isizei(jnf(jn))
- ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl)
- END DO ; END DO ; END DO ; END DO ; END DO
- CASE ( jpfillcopy ) ! filling with inner domain values
- ishti2 = ishtSi(jnf(jn))
- ishtj2 = ishtSj(jnf(jn))
- DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1,isizej(jnf(jn)) ; DO ji = 1,isizei(jnf(jn))
- ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl)
- END DO ; END DO ; END DO ; END DO ; END DO
- CASE ( jpfillcst ) ! filling with constant value
- DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1,isizej(jnf(jn)) ; DO ji = 1,isizei(jnf(jn))
- ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = zland
- END DO ; END DO ; END DO ; END DO ; END DO
- END SELECT
+ DO jf = 1, kfld
+ ishti = ishtRi(jn,jf)
+ ishtj = ishtRj(jn,jf)
+ SELECT CASE ( ifill(jn,jf) )
+ CASE ( jpfillnothing ) ! no filling
+ CASE ( jpfillmpi ) ! no it later
+ CASE ( jpfillperio ) ! use periodicity
+ ishti2 = ishtPi(jn,jf)
+ ishtj2 = ishtPj(jn,jf)
+ DO jl = 1, ipl(jf) ; DO jk = 1, ipk(jf) ; DO jj = 1,isizej(jn,jf) ; DO ji = 1,isizei(jn,jf)
+ ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl)
+ END DO ; END DO ; END DO ; END DO
+ CASE ( jpfillcopy ) ! filling with inner domain values
+ ishti2 = ishtSi(jn,jf)
+ ishtj2 = ishtSj(jn,jf)
+ DO jl = 1, ipl(jf) ; DO jk = 1, ipk(jf) ; DO jj = 1,isizej(jn,jf) ; DO ji = 1,isizei(jn,jf)
+ ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl)
+ END DO ; END DO ; END DO ; END DO
+ CASE ( jpfillcst ) ! filling with constant value
+ DO jl = 1, ipl(jf) ; DO jk = 1, ipk(jf) ; DO jj = 1,isizej(jn,jf) ; DO ji = 1,isizei(jn,jf)
+ ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = zland
+ END DO ; END DO ; END DO ; END DO
+ END SELECT
+ END DO
+ END DO
+ !
+ ! ----------------------------- !
+ ! 5. Fill all MPI halos !
+ ! ----------------------------- !
+ !
+ CALL mpi_wait( nreq_nei, MPI_STATUS_IGNORE, ierr )
+ !
+ idx = 0
+ DO jn = 1, 8
+ DO jf = 1, kfld
+ IF( ifill(jn,jf) == jpfillmpi ) THEN ! fill with data received by MPI
+ ishti = ishtRi(jn,jf)
+ ishtj = ishtRj(jn,jf)
+ DO jl = 1, ipl(jf) ; DO jk = 1, ipk(jf) ; DO jj = 1,isizej(jn,jf) ; DO ji = 1,isizei(jn,jf)
+ idx = idx + 1
+ ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = BUFFRCV(idx)
+ END DO; END DO ; END DO ; END DO
+ ENDIF
+ END DO
END DO
DEALLOCATE( iScnt, iRcnt, iSdpl, iRdpl )
IF( iszS > jpi*jpj ) DEALLOCATE(BUFFSND) ! blocking Send -> can directly deallocate
IF( iszR > jpi*jpj ) DEALLOCATE(BUFFRCV) ! blocking Recv -> can directly deallocate
-
- ! potential "indirect self-periodicity" for the corners
+ !
+ ! ---------------------------------------------------------------- !
+ ! 6. Potential "indirect self-periodicity" for the corners !
+ ! ---------------------------------------------------------------- !
+ !
DO jn = 5, 8
IF( .NOT. l_SelfPerio(jn) .AND. l_SelfPerio(jpwe) ) THEN ! no bi-perio but ew-perio: corners indirect definition
- ishti = ishtRi(jn)
- ishtj = ishtRj(jn)
- ishti2 = ishtPi(jn) ! use i- shift periodicity
- ishtj2 = ishtRj(jn) ! use j- shift recv location: use ew-perio -> ok as filling of the south and north halos now done
- DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1,isizej(jn) ; DO ji = 1,isizei(jn)
- ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl)
- END DO ; END DO ; END DO ; END DO ; END DO
+ DO jf = 1, kfld
+ ishti = ishtRi(jn,jf)
+ ishtj = ishtRj(jn,jf)
+ ishti2 = ishtPi(jn,jf) ! use i- shift periodicity
+ ishtj2 = ishtRj(jn,jf) ! use j- shift recv location: use ew-perio -> ok as filling of the so and no halos now done
+ DO jl = 1, ipl(jf) ; DO jk = 1, ipk(jf) ; DO jj = 1,isizej(jn,jf) ; DO ji = 1,isizei(jn,jf)
+ ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl)
+ END DO ; END DO ; END DO ; END DO
+ END DO
ENDIF
IF( .NOT. l_SelfPerio(jn) .AND. l_SelfPerio(jpso) ) THEN ! no bi-perio but ns-perio: corners indirect definition
- ishti = ishtRi(jn)
- ishtj = ishtRj(jn)
- ishti2 = ishtRi(jn) ! use i- shift recv location: use ns-perio -> ok as filling of the west and east halos now done
- ishtj2 = ishtPj(jn) ! use j- shift periodicity
- DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1,isizej(jn) ; DO ji = 1,isizei(jn)
- ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl)
- END DO ; END DO ; END DO ; END DO ; END DO
+ DO jf = 1, kfld
+ ishti = ishtRi(jn,jf)
+ ishtj = ishtRj(jn,jf)
+ ishti2 = ishtRi(jn,jf) ! use i- shift recv location: use ns-perio -> ok as filling of the we and ea halos now done
+ ishtj2 = ishtPj(jn,jf) ! use j- shift periodicity
+ DO jl = 1, ipl(jf) ; DO jk = 1, ipk(jf) ; DO jj = 1,isizej(jn,jf) ; DO ji = 1,isizei(jn,jf)
+ ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl)
+ END DO ; END DO ; END DO ; END DO
+ END DO
ENDIF
END DO
!
! ------------------------------- !
- ! 5. north fold treatment !
+ ! 7. north fold treatment !
! ------------------------------- !
!
IF( l_IdoNFold ) THEN
- IF( jpni == 1 ) THEN ; CALL lbc_nfd( ptab, cd_nat, psgn , ihls, ipf ) ! self NFold
- ELSE ; CALL mpp_nfd( ptab, cd_nat, psgn, ifill_nfd, zland, ihls, ipf ) ! mpi NFold
+ IF( jpni == 1 ) THEN ; CALL lbc_nfd( ptab, cd_nat, psgn , kfld ) ! self NFold
+ ELSE ; CALL mpp_nfd( ptab, cd_nat, psgn, ifill_nfd, zland, kfld ) ! mpi NFold
ENDIF
ENDIF
!
diff --git a/src/OCE/LBC/lbc_lnk_pt2pt_generic.h90 b/src/OCE/LBC/lbc_lnk_pt2pt_generic.h90
index 395a3e93c..777c9913d 100644
--- a/src/OCE/LBC/lbc_lnk_pt2pt_generic.h90
+++ b/src/OCE/LBC/lbc_lnk_pt2pt_generic.h90
@@ -1,6 +1,6 @@
-#if ! defined BLOCK_ISEND && ! defined BLOCK_FILL
- SUBROUTINE lbc_lnk_pt2pt_/**/PRECISION( cdname, ptab, cd_nat, psgn, kfld, kfillmode, pfillval, khls, lsend, lrecv, ld4only )
+#if ! defined BLOCK_ISEND && ! defined BLOCK_FILL_nonMPI && ! defined BLOCK_FILL_MPI_RECV
+ SUBROUTINE lbc_lnk_pt2pt_/**/PRECISION( cdname, ptab, cd_nat, psgn, kfld, kfillmode, pfillval, lsend, lrecv, ld4only )
CHARACTER(len=*) , INTENT(in ) :: cdname ! name of the calling subroutine
TYPE(PTR_4d_/**/PRECISION), DIMENSION(:), INTENT(inout) :: ptab ! pointer of arrays on which apply the b.c.
CHARACTER(len=1), DIMENSION(:), INTENT(in ) :: cd_nat ! nature of array grid-points
@@ -8,161 +8,185 @@
INTEGER , INTENT(in ) :: kfld ! number of pt3d arrays
INTEGER , OPTIONAL, INTENT(in ) :: kfillmode ! filling method for halo over land (default = constant)
REAL(PRECISION), OPTIONAL, INTENT(in ) :: pfillval ! background value (used at closed boundaries)
- INTEGER , OPTIONAL, INTENT(in ) :: khls ! halo size, default = nn_hls
LOGICAL, DIMENSION(8),OPTIONAL, INTENT(in ) :: lsend, lrecv ! communication with other 4 proc
LOGICAL, OPTIONAL, INTENT(in ) :: ld4only ! if .T., do only 4-neighbour comm (ignore corners)
!
INTEGER :: ji, jj, jk, jl, jf, jn ! dummy loop indices
- INTEGER :: ipi, ipj, ipk, ipl, ipf ! dimension of the input array
INTEGER :: ip0i, ip1i, im0i, im1i
INTEGER :: ip0j, ip1j, im0j, im1j
INTEGER :: ishti, ishtj, ishti2, ishtj2
INTEGER :: ifill_nfd, icomm, ierr
- INTEGER :: ihls, idxs, idxr, iszS, iszR
+ INTEGER :: ihls, iisz
+ INTEGER :: idxs, idxr, iszS, iszR
INTEGER, DIMENSION(4) :: iwewe, issnn
- INTEGER, DIMENSION(8) :: isizei, ishtSi, ishtRi, ishtPi
- INTEGER, DIMENSION(8) :: isizej, ishtSj, ishtRj, ishtPj
- INTEGER, DIMENSION(8) :: ifill, iszall, ishtS, ishtR
- INTEGER, DIMENSION(8) :: ireq ! mpi_request id
+ INTEGER, DIMENSION(8) :: ibufszS, ibufszR, ishtS, ishtR
INTEGER, DIMENSION(8) :: iStag, iRtag ! Send and Recv mpi_tag id
- REAL(PRECISION) :: zland
- LOGICAL, DIMENSION(8) :: llsend, llrecv
+ INTEGER, DIMENSION( kfld) :: ipi, ipj, ipk, ipl ! dimension of the input array
+ INTEGER, DIMENSION(8,kfld) :: ifill
+ INTEGER, DIMENSION(8,kfld) :: isizei, ishtSi, ishtRi, ishtPi
+ INTEGER, DIMENSION(8,kfld) :: isizej, ishtSj, ishtRj, ishtPj
+ LOGICAL, DIMENSION(8,kfld) :: llsend, llrecv
LOGICAL :: ll4only ! default: 8 neighbourgs
+ REAL(PRECISION) :: zland
!!----------------------------------------------------------------------
!
! ----------------------------------------- !
! 1. local variables initialization !
! ----------------------------------------- !
!
- ipi = SIZE(ptab(1)%pt4d,1)
- ipj = SIZE(ptab(1)%pt4d,2)
- ipk = SIZE(ptab(1)%pt4d,3)
- ipl = SIZE(ptab(1)%pt4d,4)
- ipf = kfld
- !
- IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ipk, ipl, ipf, ld_lbc = .TRUE. )
- !
idxs = 1 ! initalize index for send buffer
idxr = 1 ! initalize index for recv buffer
icomm = mpi_comm_oce ! shorter name
!
! take care of optional parameters
!
- ihls = nn_hls ! default definition
- IF( PRESENT( khls ) ) ihls = khls
- IF( ihls > n_hlsmax ) THEN
- WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk with khls > n_hlsmax : ', khls, '>', n_hlsmax
- CALL ctl_stop( 'STOP', ctmp1 )
- ENDIF
- IF( ipi /= Ni_0+2*ihls ) THEN
- WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk with an input array which does not match ihls along i: ', ipi, ihls, Ni_0
- CALL ctl_stop( 'STOP', ctmp1 )
- ENDIF
- IF( ipj /= Nj_0+2*ihls ) THEN
- WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk with an input array which does not match ihls along j:', ipj, ihls , Nj_0
- CALL ctl_stop( 'STOP', ctmp1 )
- ENDIF
- !
- ll4only = .FALSE. ! default definition
- IF( PRESENT(ld4only) ) ll4only = ld4only
+ ll4only = .FALSE. ! default definition
+ IF( PRESENT( ld4only ) ) ll4only = ld4only
!
zland = 0._wp ! land filling value: zero by default
- IF( PRESENT( pfillval ) ) zland = pfillval ! set land value
+ IF( PRESENT( pfillval) ) zland = pfillval ! set land value
!
- ! define llsend and llrecv: logicals which say if mpi-neibourgs for send or receive exist or not.
- IF ( PRESENT(lsend) .AND. PRESENT(lrecv) ) THEN ! localy defined neighbourgs
- llsend(:) = lsend(:) ; llrecv(:) = lrecv(:)
- ELSE IF( PRESENT(lsend) .OR. PRESENT(lrecv) ) THEN
- WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk with only one of the two arguments lsend or lrecv'
- CALL ctl_stop( 'STOP', ctmp1 )
- ELSE ! default neighbours
- llsend(:) = mpiSnei(ihls,:) >= 0
- IF( ll4only ) llsend(5:8) = .FALSE. ! exclude corners
- llrecv(:) = mpiRnei(ihls,:) >= 0
- IF( ll4only ) llrecv(5:8) = .FALSE. ! exclude corners
- ENDIF
+ ifill_nfd = jpfillcst ! default definition
+ IF( PRESENT(kfillmode) ) ifill_nfd = kfillmode
!
- ! define ifill: which method should be used to fill each parts (sides+corners) of the halos
- ! default definition
- DO jn = 1, 4
- IF( llrecv(jn) ) THEN ; ifill(jn) = jpfillmpi ! with an mpi communication
- ELSEIF( l_SelfPerio(jn) ) THEN ; ifill(jn) = jpfillperio ! with self-periodicity
- ELSEIF( PRESENT(kfillmode) ) THEN ; ifill(jn) = kfillmode ! localy defined
- ELSE ; ifill(jn) = jpfillcst ! constant value (zland)
+ DO jf = 1, kfld
+ !
+ ipi(jf) = SIZE(ptab(jf)%pt4d,1)
+ ipj(jf) = SIZE(ptab(jf)%pt4d,2)
+ ipk(jf) = SIZE(ptab(jf)%pt4d,3)
+ ipl(jf) = SIZE(ptab(jf)%pt4d,4)
+ ihls = ( ipi(jf) - Ni_0 ) / 2
+ !
+ IF( numcom == -1 ) THEN ! test input array shape. Use numcom to do these tests only at the beginning of the run
+ IF( MOD( ipi(jf) - Ni_0, 2 ) /= 0 ) THEN
+ WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk but the ', jf,'th input array has wong i-size: ', ipi(jf), Ni_0
+ CALL ctl_stop( 'STOP', ctmp1 )
+ ENDIF
+ IF( MOD( ipj(jf) - Nj_0, 2 ) /= 0 ) THEN
+ WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk but the ', jf,'th input array has wong j-size: ', ipj(jf), Nj_0
+ CALL ctl_stop( 'STOP', ctmp1 )
+ ENDIF
+ IF( ( ipj(jf) - Nj_0 ) / 2 /= ihls ) THEN
+ WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk but the ', jf,'th input array as wong i and j-size: ', &
+ & ipi(jf), Ni_0, ipj(jf), Nj_0
+ CALL ctl_stop( 'STOP', ctmp1 )
+ ENDIF
+ IF( ihls > n_hlsmax ) THEN
+ WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk but for the ', jf,'th input array, ', ihls, ' > n_hlsmax = ', &
+ & n_hlsmax
+ CALL ctl_stop( 'STOP', ctmp1 )
+ ENDIF
ENDIF
- END DO
- DO jn = 5, 8
- IF( llrecv(jn) ) THEN ; ifill(jn) = jpfillmpi ! with an mpi communication
- ELSE ; ifill(jn) = jpfillnothing! do nothing
+ !
+ ! define llsend and llrecv: logicals which say if mpi-neibourgs for send or receive exist or not.
+ IF ( PRESENT(lsend) .AND. PRESENT(lrecv) ) THEN ! localy defined neighbourgs
+ llsend(:,jf) = lsend(:) ; llrecv(:,jf) = lrecv(:)
+ ELSE IF( PRESENT(lsend) .OR. PRESENT(lrecv) ) THEN
+ WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk with only one of the two arguments lsend or lrecv'
+ CALL ctl_stop( 'STOP', ctmp1 )
+ ELSE ! default neighbours
+ llsend(:,jf) = mpiSnei(ihls,:) >= 0
+ IF( ll4only ) llsend(5:8,jf) = .FALSE. ! exclude corners
+ llrecv(:,jf) = mpiRnei(ihls,:) >= 0
+ IF( ll4only ) llrecv(5:8,jf) = .FALSE. ! exclude corners
ENDIF
- END DO
!
- ! north fold treatment
- IF( l_IdoNFold ) THEN
- ifill_nfd = ifill(jpno) ! if we are here, this means llrecv(jpno) = .false. and l_SelfPerio(jpno) = .false.
- ifill( (/jpno/) ) = jpfillnothing ! we do north fold -> do nothing for northern halo
- ENDIF
-
- ! We first define the localization and size of the parts of the array that will be sent (s), received (r)
- ! or used for periodocity (p). The localization is defined as "the bottom left corner - 1" in i and j directions.
- ! This is a shift that will be applied later in the do loops to pick-up the appropriate part of the array
- !
- ! all definitions bellow do not refer to N[ij][se]0 so we can use it with any local value of ihls
- ! ! ________________________
- ip0i = 0 ! im0j = inner |__|__|__________|__|__|
- ip1i = ihls ! im1j = inner - halo |__|__|__________|__|__|
- im1i = ipi-2*ihls ! | | | | | |
- im0i = ipi - ihls ! | | | | | |
- ip0j = 0 ! | | | | | |
- ip1j = ihls ! |__|__|__________|__|__|
- im1j = ipj-2*ihls ! ip1j = halo |__|__|__________|__|__|
- im0j = ipj - ihls ! ip0j = 0 |__|__|__________|__|__|
- ! ! ip0i ip1i im1i im0i
+ ! define ifill: which method should be used to fill each parts (sides+corners) of the halos
+ ! default definition
+ DO jn = 1, 4 ! 4 sides
+ IF( llrecv(jn,jf) ) THEN ; ifill(jn,jf) = jpfillmpi ! with an mpi communication
+ ELSEIF( l_SelfPerio(jn) ) THEN ; ifill(jn,jf) = jpfillperio ! with self-periodicity
+ ELSEIF( PRESENT(kfillmode) ) THEN ; ifill(jn,jf) = kfillmode ! localy defined
+ ELSEIF( ihls == 0 ) THEN ; ifill(jn,jf) = jpfillnothing ! do nothing
+ ELSE ; ifill(jn,jf) = jpfillcst ! constant value (zland)
+ ENDIF
+ END DO
+ DO jn = 5, 8 ! 4 corners
+ IF( llrecv(jn,jf) ) THEN ; ifill(jn,jf) = jpfillmpi ! with an mpi communication
+ ELSE ; ifill(jn,jf) = jpfillnothing ! do nothing
+ ENDIF
+ END DO
+ !
+ ! north fold treatment
+ IF( l_IdoNFold ) ifill(jpno,jf) = jpfillnothing ! we do north fold -> do nothing for northern halo
+
+ ! We first define the localization and size of the parts of the array that will be sent (s), received (r)
+ ! or used for periodocity (p). The localization is defined as "the bottom left corner - 1" in i and j directions.
+ ! This is a shift that will be applied later in the do loops to pick-up the appropriate part of the array
+ !
+ ! all definitions bellow do not refer to N[ij][se]0 so we can use it with any local value of ihls
+ !
+ ! ! ________________________
+ ip0i = 0 ! im0j = inner |__|__|__________|__|__|
+ ip1i = ihls ! im1j = inner - halo |__|__|__________|__|__|
+ im1i = ipi(jf)-2*ihls ! | | | | | |
+ im0i = ipi(jf) - ihls ! | | | | | |
+ ip0j = 0 ! | | | | | |
+ ip1j = ihls ! |__|__|__________|__|__|
+ im1j = ipj(jf)-2*ihls ! ip1j = halo |__|__|__________|__|__|
+ im0j = ipj(jf) - ihls ! ip0j = 0 |__|__|__________|__|__|
+ ! ! ip0i ip1i im1i im0i
+ !
+ ! define shorter names...
+ iwewe(:) = (/ jpwe,jpea,jpwe,jpea /) ; issnn(:) = (/ jpso,jpso,jpno,jpno /)
+ iisz = ipi(jf)
+ ! sides: west east south north ; corners: so-we, so-ea, no-we, no-ea
+ isizei(1:4,jf) = (/ ihls, ihls, iisz, iisz /) ; isizei(5:8,jf) = ihls ! i- count
+ isizej(1:4,jf) = (/ Nj_0, Nj_0, ihls, ihls /) ; isizej(5:8,jf) = ihls ! j- count
+ ishtSi(1:4,jf) = (/ ip1i, im1i, ip0i, ip0i /) ; ishtSi(5:8,jf) = ishtSi( iwewe,jf ) ! i- shift send data
+ ishtSj(1:4,jf) = (/ ip1j, ip1j, ip1j, im1j /) ; ishtSj(5:8,jf) = ishtSj( issnn,jf ) ! j- shift send data
+ ishtRi(1:4,jf) = (/ ip0i, im0i, ip0i, ip0i /) ; ishtRi(5:8,jf) = ishtRi( iwewe,jf ) ! i- shift recv data
+ ishtRj(1:4,jf) = (/ ip1j, ip1j, ip0j, im0j /) ; ishtRj(5:8,jf) = ishtRj( issnn,jf ) ! j- shift recv data
+ ishtPi(1:4,jf) = (/ im1i, ip1i, ip0i, ip0i /) ; ishtPi(5:8,jf) = ishtPi( iwewe,jf ) ! i- shift perio data
+ ishtPj(1:4,jf) = (/ ip1j, ip1j, im1j, ip1j /) ; ishtPj(5:8,jf) = ishtPj( issnn,jf ) ! j- shift perio data
+ !
+ END DO ! jf
!
- iwewe(:) = (/ jpwe,jpea,jpwe,jpea /) ; issnn(:) = (/ jpso,jpso,jpno,jpno /)
- ! sides: west east south north ; corners: so-we, so-ea, no-we, no-ea
- isizei(1:4) = (/ ihls, ihls, ipi, ipi /) ; isizei(5:8) = ihls ! i- count
- isizej(1:4) = (/ Nj_0, Nj_0, ihls, ihls /) ; isizej(5:8) = ihls ! j- count
- ishtSi(1:4) = (/ ip1i, im1i, ip0i, ip0i /) ; ishtSi(5:8) = ishtSi( iwewe ) ! i- shift send data
- ishtSj(1:4) = (/ ip1j, ip1j, ip1j, im1j /) ; ishtSj(5:8) = ishtSj( issnn ) ! j- shift send data
- ishtRi(1:4) = (/ ip0i, im0i, ip0i, ip0i /) ; ishtRi(5:8) = ishtRi( iwewe ) ! i- shift received data location
- ishtRj(1:4) = (/ ip1j, ip1j, ip0j, im0j /) ; ishtRj(5:8) = ishtRj( issnn ) ! j- shift received data location
- ishtPi(1:4) = (/ im1i, ip1i, ip0i, ip0i /) ; ishtPi(5:8) = ishtPi( iwewe ) ! i- shift data used for periodicity
- ishtPj(1:4) = (/ ip1j, ip1j, im1j, ip1j /) ; ishtPj(5:8) = ishtPj( issnn ) ! j- shift data used for periodicity
+ IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, SUM(ipk(:))/kfld, SUM(ipl(:))/kfld, kfld, ld_lbc = .TRUE. )
!
! -------------------------------- !
! 2. Prepare MPI exchanges !
! -------------------------------- !
!
- iStag = (/ 1, 2, 3, 4, 5, 6, 7, 8 /) ! any value but each one must be different
+ iStag = (/ 1, 2, 3, 4, 5, 6, 7, 8 /) ! can be any value but each value must be unique
! define iRtag with the corresponding iStag, e.g. data received at west where sent at east.
iRtag(jpwe) = iStag(jpea) ; iRtag(jpea) = iStag(jpwe) ; iRtag(jpso) = iStag(jpno) ; iRtag(jpno) = iStag(jpso)
iRtag(jpsw) = iStag(jpne) ; iRtag(jpse) = iStag(jpnw) ; iRtag(jpnw) = iStag(jpse) ; iRtag(jpne) = iStag(jpsw)
!
- iszall(:) = isizei(:) * isizej(:) * ipk * ipl * ipf
+ ! size of the buffer to be sent/recv in each direction
+ ibufszS(:) = 0 ! defaut definition
+ ibufszR(:) = 0
+ DO jf = 1, kfld
+ DO jn = 1, 8
+ IF( llsend(jn,jf) ) ibufszS(jn) = ibufszS(jn) + isizei(jn,jf) * isizej(jn,jf) * ipk(jf) * ipl(jf)
+ IF( llrecv(jn,jf) ) ibufszR(jn) = ibufszR(jn) + isizei(jn,jf) * isizej(jn,jf) * ipk(jf) * ipl(jf)
+ END DO
+ END DO
+ !
+ ! offset to apply to find the position of the sent/recv data within the buffer
ishtS(1) = 0
DO jn = 2, 8
- ishtS(jn) = ishtS(jn-1) + iszall(jn-1) * COUNT( (/llsend(jn-1)/) )
+ ishtS(jn) = ishtS(jn-1) + ibufszS(jn-1)
END DO
ishtR(1) = 0
DO jn = 2, 8
- ishtR(jn) = ishtR(jn-1) + iszall(jn-1) * COUNT( (/llrecv(jn-1)/) )
+ ishtR(jn) = ishtR(jn-1) + ibufszR(jn-1)
END DO
-
+ !
! Allocate buffer arrays to be sent/received if needed
- iszS = SUM(iszall, mask = llsend) ! send buffer size
+ iszS = SUM(ibufszS) ! send buffer size
IF( ALLOCATED(BUFFSND) ) THEN
CALL mpi_waitall(8, nreq_p2p, MPI_STATUSES_IGNORE, ierr) ! wait for Isend from the PREVIOUS call
IF( SIZE(BUFFSND) < iszS ) DEALLOCATE(BUFFSND) ! send buffer is too small
ENDIF
IF( .NOT. ALLOCATED(BUFFSND) ) ALLOCATE( BUFFSND(iszS) )
- iszR = SUM(iszall, mask = llrecv) ! recv buffer size
+ iszR = SUM(ibufszR) ! recv buffer size
IF( ALLOCATED(BUFFRCV) ) THEN
IF( SIZE(BUFFRCV) < iszR ) DEALLOCATE(BUFFRCV) ! recv buffer is too small
ENDIF
IF( .NOT. ALLOCATED(BUFFRCV) ) ALLOCATE( BUFFRCV(iszR) )
!
- ! default definition when no communication is done. understood by mpi_waitall
+ ! Default definition when no communication is done. Understood by mpi_waitall
nreq_p2p(:) = MPI_REQUEST_NULL ! WARNING: Must be done after the call to mpi_waitall just above
!
! ----------------------------------------------- !
@@ -177,19 +201,28 @@
!
! ----------------------------------- !
! 4. Fill east and west halos !
+ ! Must be done before sending data !
+ ! data to south/north/corners !
! ----------------------------------- !
!
- DO jn = 1, 2
-#define BLOCK_FILL
+ DO jn = 1, 2 ! first: do all the non-MPI filling to give more time to MPI_RECV
+#define BLOCK_FILL_nonMPI
+# include "lbc_lnk_pt2pt_generic.h90"
+#undef BLOCK_FILL_nonMPI
+ END DO
+ DO jn = 1, 2 ! next: do the MPI_RECV part
+#define BLOCK_FILL_MPI_RECV
# include "lbc_lnk_pt2pt_generic.h90"
-#undef BLOCK_FILL
+#undef BLOCK_FILL_MPI_RECV
END DO
!
! ------------------------------------------------- !
! 5. Do north and south MPI_Isend if needed !
+ ! and Specific problem in corner treatment !
+ ! ( very rate case... ) !
! ------------------------------------------------- !
!
- DO jn = 3, 4
+ DO jn = 3, 8
#define BLOCK_ISEND
# include "lbc_lnk_pt2pt_generic.h90"
#undef BLOCK_ISEND
@@ -199,44 +232,34 @@
! 6. north fold treatment !
! ------------------------------- !
!
- ! Must be done after receiving data from East/West neighbourgs (as it is coded in mpp_nfd, to be changed one day...)
- ! Do it after MPI_iSend to south/north neighbourgs so they won't wait (too much) to receive their data
- ! Do if before MPI_Recv from south/north neighbourgs so we have more time to receive data
+ ! Do it after MPI_iSend to south/north/corners neighbourgs so they won't wait (too much) to receive their data
+ ! Do if before MPI_Recv from south/north/corners neighbourgs so we will have more time to receive data
!
IF( l_IdoNFold ) THEN
- IF( jpni == 1 ) THEN ; CALL lbc_nfd( ptab, cd_nat, psgn , ihls, ipf ) ! self NFold
- ELSE ; CALL mpp_nfd( ptab, cd_nat, psgn, ifill_nfd, zland, ihls, ipf ) ! mpi NFold
+ IF( jpni == 1 ) THEN ; CALL lbc_nfd( ptab, cd_nat, psgn , kfld ) ! self NFold
+ ELSE ; CALL mpp_nfd( ptab, cd_nat, psgn, ifill_nfd, zland, kfld ) ! mpi NFold
ENDIF
ENDIF
!
- ! ------------------------------------- !
- ! 7. Fill south and north halos !
- ! ------------------------------------- !
+ ! ------------------------------------------------ !
+ ! 7. Fill south and north halos !
+ ! and specific problem in corner treatment !
+ ! ( very rate case... ) !
+ ! ------------------------------------------------ !
!
- DO jn = 3, 4
-#define BLOCK_FILL
+ DO jn = 3, 8 ! first: do all the non-MPI filling to give more time to MPI_RECV
+#define BLOCK_FILL_nonMPI
# include "lbc_lnk_pt2pt_generic.h90"
-#undef BLOCK_FILL
+#undef BLOCK_FILL_nonMPI
END DO
- !
- ! ----------------------------------------------- !
- ! 8. Specific problem in corner treatment !
- ! ( very rate case... ) !
- ! ----------------------------------------------- !
- !
- DO jn = 5, 8
-#define BLOCK_ISEND
+ DO jn = 3, 8 ! next: do the MPI_RECV part
+#define BLOCK_FILL_MPI_RECV
# include "lbc_lnk_pt2pt_generic.h90"
-#undef BLOCK_ISEND
- END DO
- DO jn = 5, 8
-#define BLOCK_FILL
-# include "lbc_lnk_pt2pt_generic.h90"
-#undef BLOCK_FILL
+#undef BLOCK_FILL_MPI_RECV
END DO
!
! -------------------------------------------- !
- ! 9. deallocate local temporary arrays !
+ ! 8. deallocate local temporary arrays !
! if they areg larger than jpi*jpj ! <- arbitrary max size...
! -------------------------------------------- !
!
@@ -250,53 +273,72 @@
#endif
#if defined BLOCK_ISEND
- IF( llsend(jn) ) THEN
- ishti = ishtSi(jn)
- ishtj = ishtSj(jn)
- DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1,isizej(jn) ; DO ji = 1,isizei(jn)
- BUFFSND(idxs) = ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl)
- idxs = idxs + 1
- END DO ; END DO ; END DO ; END DO ; END DO
+ IF( ibufszS(jn) > 0 ) THEN ! we must send some data
+ DO jf = 1, kfld ! first: fill the buffer to be sent
+ IF( llsend(jn,jf) ) THEN
+ ishti = ishtSi(jn,jf)
+ ishtj = ishtSj(jn,jf)
+ DO jl = 1, ipl(jf) ; DO jk = 1, ipk(jf) ; DO jj = 1,isizej(jn,jf) ; DO ji = 1,isizei(jn,jf)
+ BUFFSND(idxs) = ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl)
+ idxs = idxs + 1
+ END DO ; END DO ; END DO ; END DO
+ ENDIF
+ END DO
#if ! defined key_mpi_off
IF( ln_timing ) CALL tic_tac(.TRUE.)
- ! non-blocking send of the west/east side using local buffer
- CALL MPI_ISEND( BUFFSND(ishtS(jn)+1), iszall(jn), MPI_TYPE, mpiSnei(ihls,jn), iStag(jn), icomm, nreq_p2p(jn), ierr )
+ ! next: non-blocking send using local buffer. use mpiSnei(n_hlsmax,jn), see mppini
+ CALL MPI_ISEND( BUFFSND(ishtS(jn)+1), ibufszS(jn), MPI_TYPE, mpiSnei(n_hlsmax,jn), iStag(jn), icomm, nreq_p2p(jn), ierr )
IF( ln_timing ) CALL tic_tac(.FALSE.)
#endif
ENDIF
+
#endif
-#if defined BLOCK_FILL
- ishti = ishtRi(jn)
- ishtj = ishtRj(jn)
- SELECT CASE ( ifill(jn) )
- CASE ( jpfillnothing ) ! no filling
- CASE ( jpfillmpi ) ! fill with data received by MPI
+#if defined BLOCK_FILL_nonMPI
+ DO jf = 1, kfld
+ IF( ifill(jn,jf) /= jpfillmpi ) THEN ! treat first all non-MPI cases
+ ishti = ishtRi(jn,jf)
+ ishtj = ishtRj(jn,jf)
+ SELECT CASE ( ifill(jn,jf) )
+ CASE ( jpfillnothing ) ! no filling
+ CASE ( jpfillperio ) ! we will do it later
+ ishti2 = ishtPi(jn,jf)
+ ishtj2 = ishtPj(jn,jf)
+ DO jl = 1, ipl(jf) ; DO jk = 1, ipk(jf) ; DO jj = 1,isizej(jn,jf) ; DO ji = 1,isizei(jn,jf)
+ ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl)
+ END DO ; END DO ; END DO ; END DO
+ CASE ( jpfillcopy ) ! filling with inner domain values
+ ishti2 = ishtSi(jn,jf)
+ ishtj2 = ishtSj(jn,jf)
+ DO jl = 1, ipl(jf) ; DO jk = 1, ipk(jf) ; DO jj = 1,isizej(jn,jf) ; DO ji = 1,isizei(jn,jf)
+ ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl)
+ END DO ; END DO ; END DO ; END DO
+ CASE ( jpfillcst ) ! filling with constant value
+ DO jl = 1, ipl(jf) ; DO jk = 1, ipk(jf) ; DO jj = 1,isizej(jn,jf) ; DO ji = 1,isizei(jn,jf)
+ ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = zland
+ END DO ; END DO ; END DO ; END DO
+ END SELECT
+ ENDIF
+ END DO
+#endif
+
+#if defined BLOCK_FILL_MPI_RECV
+ IF( ibufszR(jn) > 0 ) THEN ! we must receive some data
#if ! defined key_mpi_off
IF( ln_timing ) CALL tic_tac(.TRUE.)
- ! ! blocking receive of the west/east halo in local temporary arrays
- CALL MPI_RECV( BUFFRCV(ishtR(jn)+1), iszall(jn), MPI_TYPE, mpiRnei(ihls,jn), iRtag(jn), icomm, MPI_STATUS_IGNORE, ierr )
+ ! blocking receive in local buffer. use mpiRnei(n_hlsmax,jn), see mppini
+ CALL MPI_RECV( BUFFRCV(ishtR(jn)+1), ibufszR(jn), MPI_TYPE, mpiRnei(n_hlsmax,jn), iRtag(jn), icomm, MPI_STATUS_IGNORE, ierr )
IF( ln_timing ) CALL tic_tac(.FALSE.)
#endif
- DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1,isizej(jn) ; DO ji = 1,isizei(jn)
- ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = BUFFRCV(idxr)
- idxr = idxr + 1
- END DO ; END DO ; END DO ; END DO ; END DO
- CASE ( jpfillperio ) ! use periodicity
- ishti2 = ishtPi(jn)
- ishtj2 = ishtPj(jn)
- DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1,isizej(jn) ; DO ji = 1,isizei(jn)
- ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl)
- END DO ; END DO ; END DO ; END DO ; END DO
- CASE ( jpfillcopy ) ! filling with inner domain values
- ishti2 = ishtSi(jn)
- ishtj2 = ishtSj(jn)
- DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1,isizej(jn) ; DO ji = 1,isizei(jn)
- ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl)
- END DO ; END DO ; END DO ; END DO ; END DO
- CASE ( jpfillcst ) ! filling with constant value
- DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1,isizej(jn) ; DO ji = 1,isizei(jn)
- ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = zland
- END DO ; END DO ; END DO ; END DO ; END DO
- END SELECT
+ DO jf = 1, kfld
+ IF( ifill(jn,jf) == jpfillmpi ) THEN ! Use MPI-received data
+ ishti = ishtRi(jn,jf)
+ ishtj = ishtRj(jn,jf)
+ DO jl = 1, ipl(jf) ; DO jk = 1, ipk(jf) ; DO jj = 1,isizej(jn,jf) ; DO ji = 1,isizei(jn,jf)
+ ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = BUFFRCV(idxr)
+ idxr = idxr + 1
+ END DO ; END DO ; END DO ; END DO
+ ENDIF
+ END DO
+ ENDIF
#endif
diff --git a/src/OCE/LBC/lbc_nfd_generic.h90 b/src/OCE/LBC/lbc_nfd_generic.h90
index 18ae89738..fdfa8b62b 100644
--- a/src/OCE/LBC/lbc_nfd_generic.h90
+++ b/src/OCE/LBC/lbc_nfd_generic.h90
@@ -1,28 +1,23 @@
- SUBROUTINE lbc_nfd_/**/PRECISION( ptab, cd_nat, psgn, khls, kfld )
+ SUBROUTINE lbc_nfd_/**/PRECISION( ptab, cd_nat, psgn, kfld )
TYPE(PTR_4d_/**/PRECISION), DIMENSION(:), INTENT(inout) :: ptab ! pointer of arrays on which apply the b.c.
CHARACTER(len=1), DIMENSION(:), INTENT(in ) :: cd_nat ! nature of array grid-points
REAL(PRECISION), DIMENSION(:), INTENT(in ) :: psgn ! sign used across the north fold boundary
- INTEGER , INTENT(in ) :: khls ! halo size, default = nn_hls
INTEGER , INTENT(in ) :: kfld ! number of pt3d arrays
!
INTEGER :: ji, jj, jk, jl, jf ! dummy loop indices
- INTEGER :: ipi, ipj, ipk, ipl, ipf ! dimension of the input array
+ INTEGER :: ipi, ipj, ipk, ipl, ihls ! dimension of the input array
INTEGER :: ii1, ii2, ij1, ij2
!!----------------------------------------------------------------------
!
- ipi = SIZE(ptab(1)%pt4d,1)
- ipj = SIZE(ptab(1)%pt4d,2)
- ipk = SIZE(ptab(1)%pt4d,3)
- ipl = SIZE(ptab(1)%pt4d,4)
- ipf = kfld
+ DO jf = 1, kfld ! Loop on the number of arrays to be treated
!
- IF( ipi /= Ni0glo+2*khls ) THEN
- WRITE(ctmp1,*) 'lbc_nfd input array does not match khls', ipi, khls, Ni0glo
- CALL ctl_stop( 'STOP', ctmp1 )
- ENDIF
- !
- DO jf = 1, ipf ! Loop on the number of arrays to be treated
+ ipi = SIZE(ptab(jf)%pt4d,1)
+ ipj = SIZE(ptab(jf)%pt4d,2)
+ ipk = SIZE(ptab(jf)%pt4d,3)
+ ipl = SIZE(ptab(jf)%pt4d,4)
+ !
+ ihls = ( ipi - Ni0glo ) / 2
!
IF( c_NFtype == 'T' ) THEN ! * North fold T-point pivot
!
@@ -30,160 +25,162 @@
CASE ( 'T' , 'W' ) ! T-, W-point
DO jl = 1, ipl ; DO jk = 1, ipk
!
- ! last khls lines (from ipj to ipj-khls+1) : full
- DO jj = 1, khls
- ij1 = ipj - jj + 1 ! ends at: ipj - khls + 1
- ij2 = ipj - 2*khls + jj - 1 ! ends at: ipj - 2*khls + khls - 1 = ipj - khls - 1
+ ! last ihls lines (from ipj to ipj-ihls+1) : full
+ DO jj = 1, ihls
+ ij1 = ipj - jj + 1 ! ends at: ipj - ihls + 1
+ ij2 = ipj - 2*ihls + jj - 1 ! ends at: ipj - 2*ihls + ihls - 1 = ipj - ihls - 1
!
- DO ji = 1, khls ! first khls points
- ii1 = ji ! ends at: khls
- ii2 = 2*khls + 2 - ji ! ends at: 2*khls + 2 - khls = khls + 2
+ DO ji = 1, ihls ! first ihls points
+ ii1 = ji ! ends at: ihls
+ ii2 = 2*ihls + 2 - ji ! ends at: 2*ihls + 2 - ihls = ihls + 2
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, 1 ! point khls+1
- ii1 = khls + ji
+ DO ji = 1, 1 ! point ihls+1
+ ii1 = ihls + ji
ii2 = ii1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, Ni0glo - 1 ! points from khls+2 to ipi - khls (note: Ni0glo = ipi - 2*khls)
- ii1 = 2 + khls + ji - 1 ! ends at: 2 + khls + ipi - 2*khls - 1 - 1 = ipi - khls
- ii2 = ipi - khls - ji + 1 ! ends at: ipi - khls - ( ipi - 2*khls - 1 ) + 1 = khls + 2
+ DO ji = 1, Ni0glo - 1 ! points from ihls+2 to ipi - ihls (note: Ni0glo = ipi - 2*ihls)
+ ii1 = 2 + ihls + ji - 1 ! ends at: 2 + ihls + ipi - 2*ihls - 1 - 1 = ipi - ihls
+ ii2 = ipi - ihls - ji + 1 ! ends at: ipi - ihls - ( ipi - 2*ihls - 1 ) + 1 = ihls + 2
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, 1 ! point ipi - khls + 1
- ii1 = ipi - khls + ji
- ii2 = khls + ji
+ DO ji = 1, COUNT( (/ihls > 0/) ) ! point ipi - ihls + 1
+ ii1 = ipi - ihls + ji
+ ii2 = ihls + ji
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, khls-1 ! last khls-1 points
- ii1 = ipi - khls + 1 + ji ! ends at: ipi - khls + 1 + khls - 1 = ipi
- ii2 = ipi - khls + 1 - ji ! ends at: ipi - khls + 1 - khls + 1 = ipi - 2*khls + 2
+ DO ji = 1, ihls-1 ! last ihls-1 points
+ ii1 = ipi - ihls + 1 + ji ! ends at: ipi - ihls + 1 + ihls - 1 = ipi
+ ii2 = ipi - ihls + 1 - ji ! ends at: ipi - ihls + 1 - ihls + 1 = ipi - 2*ihls + 2
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
END DO
!
- ! line number ipj-khls : right half
+ ! line number ipj-ihls : right half
DO jj = 1, 1
- ij1 = ipj - khls
+ ij1 = ipj - ihls
ij2 = ij1 ! same line
!
- DO ji = 1, Ni0glo/2-1 ! points from ipi/2+2 to ipi - khls (note: Ni0glo = ipi - 2*khls)
- ii1 = ipi/2 + ji + 1 ! ends at: ipi/2 + (ipi/2 - khls - 1) + 1 = ipi - khls
- ii2 = ipi/2 - ji + 1 ! ends at: ipi/2 - (ipi/2 - khls - 1) + 1 = khls + 2
+ DO ji = 1, Ni0glo/2-1 ! points from ipi/2+2 to ipi - ihls (note: Ni0glo = ipi - 2*ihls)
+ ii1 = ipi/2 + ji + 1 ! ends at: ipi/2 + (ipi/2 - ihls - 1) + 1 = ipi - ihls
+ ii2 = ipi/2 - ji + 1 ! ends at: ipi/2 - (ipi/2 - ihls - 1) + 1 = ihls + 2
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, khls ! first khls points: redo them just in case (if e-w periodocity already done)
- ! ! as we just changed points ipi-2khls+1 to ipi-khls
- ii1 = ji ! ends at: khls
- ii2 = 2*khls + 2 - ji ! ends at: 2*khls + 2 - khls = khls + 2
+ DO ji = 1, ihls ! first ihls points: redo them just in case (if e-w periodocity already done)
+ ! ! as we just changed points ipi-2ihls+1 to ipi-ihls
+ ii1 = ji ! ends at: ihls
+ ii2 = 2*ihls + 2 - ji ! ends at: 2*ihls + 2 - ihls = ihls + 2
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- ! ! last khls-1 points: have been / will done by e-w periodicity
+ ! ! last ihls-1 points: have been or will be done by e-w periodicity
END DO
!
- END DO; END DO
+ END DO ; END DO
CASE ( 'U' ) ! U-point
DO jl = 1, ipl ; DO jk = 1, ipk
!
- ! last khls lines (from ipj to ipj-khls+1) : full
- DO jj = 1, khls
- ij1 = ipj - jj + 1 ! ends at: ipj - khls + 1
- ij2 = ipj - 2*khls + jj - 1 ! ends at: ipj - 2*khls + khls - 1 = ipj - khls - 1
+ ! last ihls lines (from ipj to ipj-ihls+1) : full
+ DO jj = 1, ihls
+ ij1 = ipj - jj + 1 ! ends at: ipj - ihls + 1
+ ij2 = ipj - 2*ihls + jj - 1 ! ends at: ipj - 2*ihls + ihls - 1 = ipj - ihls - 1
!
- DO ji = 1, khls ! first khls points
- ii1 = ji ! ends at: khls
- ii2 = 2*khls + 1 - ji ! ends at: 2*khls + 1 - khls = khls + 1
+ DO ji = 1, ihls ! first ihls points
+ ii1 = ji ! ends at: ihls
+ ii2 = 2*ihls + 1 - ji ! ends at: 2*ihls + 1 - ihls = ihls + 1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, Ni0glo ! points from khls to ipi - khls (note: Ni0glo = ipi - 2*khls)
- ii1 = khls + ji ! ends at: khls + ipi - 2*khls = ipi - khls
- ii2 = ipi - khls - ji + 1 ! ends at: ipi - khls - ( ipi - 2*khls ) + 1 = khls + 1
+ DO ji = 1, Ni0glo ! points from ihls to ipi - ihls (note: Ni0glo = ipi - 2*ihls)
+ ii1 = ihls + ji ! ends at: ihls + ipi - 2*ihls = ipi - ihls
+ ii2 = ipi - ihls - ji + 1 ! ends at: ipi - ihls - ( ipi - 2*ihls ) + 1 = ihls + 1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, khls ! last khls points
- ii1 = ipi - khls + ji ! ends at: ipi - khls + khls = ipi
- ii2 = ipi - khls - ji + 1 ! ends at: ipi - khls + 1 - khls = ipi - 2*khls + 1
+ DO ji = 1, ihls ! last ihls points
+ ii1 = ipi - ihls + ji ! ends at: ipi - ihls + ihls = ipi
+ ii2 = ipi - ihls - ji + 1 ! ends at: ipi - ihls + 1 - ihls = ipi - 2*ihls + 1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
END DO
!
- ! line number ipj-khls : right half
+ ! line number ipj-ihls : right half
DO jj = 1, 1
- ij1 = ipj - khls
+ ij1 = ipj - ihls
ij2 = ij1 ! same line
!
- DO ji = 1, Ni0glo/2 ! points from ipi/2+1 to ipi - khls (note: Ni0glo = ipi - 2*khls)
- ii1 = ipi/2 + ji ! ends at: ipi/2 + (ipi/2 - khls) = ipi - khls
- ii2 = ipi/2 - ji + 1 ! ends at: ipi/2 - (ipi/2 - khls) + 1 = khls + 1
+ DO ji = 1, Ni0glo/2 ! points from ipi/2+1 to ipi - ihls (note: Ni0glo = ipi - 2*ihls)
+ ii1 = ipi/2 + ji ! ends at: ipi/2 + (ipi/2 - ihls) = ipi - ihls
+ ii2 = ipi/2 - ji + 1 ! ends at: ipi/2 - (ipi/2 - ihls) + 1 = ihls + 1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, khls ! first khls points: redo them just in case (if e-w periodocity already done)
- ! ! as we just changed points ipi-2khls+1 to ipi-khls
- ii1 = ji ! ends at: khls
- ii2 = 2*khls + 1 - ji ! ends at: 2*khls + 1 - khls = khls + 1
+ DO ji = 1, ihls ! first ihls points: redo them just in case (if e-w periodocity already done)
+ ! ! as we just changed points ipi-2ihls+1 to ipi-ihls
+ ii1 = ji ! ends at: ihls
+ ii2 = 2*ihls + 1 - ji ! ends at: 2*ihls + 1 - ihls = ihls + 1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- ! ! last khls-1 points: have been / will done by e-w periodicity
+ ! ! last ihls-1 points: have been or will be done by e-w periodicity
END DO
!
- END DO; END DO
+ END DO ; END DO
CASE ( 'V' ) ! V-point
DO jl = 1, ipl ; DO jk = 1, ipk
!
- ! last khls+1 lines (from ipj to ipj-khls) : full
- DO jj = 1, khls+1
- ij1 = ipj - jj + 1 ! ends at: ipj - ( khls + 1 ) + 1 = ipj - khls
- ij2 = ipj - 2*khls + jj - 2 ! ends at: ipj - 2*khls + khls + 1 - 2 = ipj - khls - 1
+ ! last ihls+1 lines (from ipj to ipj-ihls) : full
+ DO jj = 1, ihls+1
+ ij1 = ipj - jj + 1 ! ends at: ipj - ( ihls + 1 ) + 1 = ipj - ihls
+ ij2 = ipj - 2*ihls + jj - 2 ! ends at: ipj - 2*ihls + ihls + 1 - 2 = ipj - ihls - 1
!
- DO ji = 1, khls ! first khls points
- ii1 = ji ! ends at: khls
- ii2 = 2*khls + 2 - ji ! ends at: 2*khls + 2 - khls = khls + 2
+ DO ji = 1, ihls ! first ihls points
+ ii1 = ji ! ends at: ihls
+ ii2 = 2*ihls + 2 - ji ! ends at: 2*ihls + 2 - ihls = ihls + 2
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, 1 ! point khls+1
- ii1 = khls + ji
+ DO ji = 1, 1 ! point ihls+1
+ ii1 = ihls + ji
ii2 = ii1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, Ni0glo - 1 ! points from khls+2 to ipi - khls (note: Ni0glo = ipi - 2*khls)
- ii1 = 2 + khls + ji - 1 ! ends at: 2 + khls + ipi - 2*khls - 1 - 1 = ipi - khls
- ii2 = ipi - khls - ji + 1 ! ends at: ipi - khls - ( ipi - 2*khls - 1 ) + 1 = khls + 2
+ DO ji = 1, Ni0glo - 1 ! points from ihls+2 to ipi - ihls (note: Ni0glo = ipi - 2*ihls)
+ ii1 = 2 + ihls + ji - 1 ! ends at: 2 + ihls + ipi - 2*ihls - 1 - 1 = ipi - ihls
+ ii2 = ipi - ihls - ji + 1 ! ends at: ipi - ihls - ( ipi - 2*ihls - 1 ) + 1 = ihls + 2
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, 1 ! point ipi - khls + 1
- ii1 = ipi - khls + ji
- ii2 = khls + ji
+ IF( ihls > 0 ) THEN
+ DO ji = 1, COUNT( (/ihls > 0/) ) ! point ipi - ihls + 1
+ ii1 = ipi - ihls + ji
+ ii2 = ihls + ji
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, khls-1 ! last khls-1 points
- ii1 = ipi - khls + 1 + ji ! ends at: ipi - khls + 1 + khls - 1 = ipi
- ii2 = ipi - khls + 1 - ji ! ends at: ipi - khls + 1 - khls + 1 = ipi - 2*khls + 2
+ ENDIF
+ DO ji = 1, ihls-1 ! last ihls-1 points
+ ii1 = ipi - ihls + 1 + ji ! ends at: ipi - ihls + 1 + ihls - 1 = ipi
+ ii2 = ipi - ihls + 1 - ji ! ends at: ipi - ihls + 1 - ihls + 1 = ipi - 2*ihls + 2
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
END DO
!
- END DO; END DO
+ END DO ; END DO
CASE ( 'F' ) ! F-point
DO jl = 1, ipl ; DO jk = 1, ipk
!
- ! last khls+1 lines (from ipj to ipj-khls) : full
- DO jj = 1, khls+1
- ij1 = ipj - jj + 1 ! ends at: ipj - ( khls + 1 ) + 1 = ipj - khls
- ij2 = ipj - 2*khls + jj - 2 ! ends at: ipj - 2*khls + khls + 1 - 2 = ipj - khls - 1
+ ! last ihls+1 lines (from ipj to ipj-ihls) : full
+ DO jj = 1, ihls+1
+ ij1 = ipj - jj + 1 ! ends at: ipj - ( ihls + 1 ) + 1 = ipj - ihls
+ ij2 = ipj - 2*ihls + jj - 2 ! ends at: ipj - 2*ihls + ihls + 1 - 2 = ipj - ihls - 1
!
- DO ji = 1, khls ! first khls points
- ii1 = ji ! ends at: khls
- ii2 = 2*khls + 1 - ji ! ends at: 2*khls + 1 - khls = khls + 1
+ DO ji = 1, ihls ! first ihls points
+ ii1 = ji ! ends at: ihls
+ ii2 = 2*ihls + 1 - ji ! ends at: 2*ihls + 1 - ihls = ihls + 1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, Ni0glo ! points from khls to ipi - khls (note: Ni0glo = ipi - 2*khls)
- ii1 = khls + ji ! ends at: khls + ipi - 2*khls = ipi - khls
- ii2 = ipi - khls - ji + 1 ! ends at: ipi - khls - ( ipi - 2*khls ) + 1 = khls + 1
+ DO ji = 1, Ni0glo ! points from ihls to ipi - ihls (note: Ni0glo = ipi - 2*ihls)
+ ii1 = ihls + ji ! ends at: ihls + ipi - 2*ihls = ipi - ihls
+ ii2 = ipi - ihls - ji + 1 ! ends at: ipi - ihls - ( ipi - 2*ihls ) + 1 = ihls + 1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, khls ! last khls points
- ii1 = ipi - khls + ji ! ends at: ipi - khls + khls = ipi
- ii2 = ipi - khls - ji + 1 ! ends at: ipi - khls + 1 - khls = ipi - 2*khls + 1
+ DO ji = 1, ihls ! last ihls points
+ ii1 = ipi - ihls + ji ! ends at: ipi - ihls + ihls = ipi
+ ii2 = ipi - ihls - ji + 1 ! ends at: ipi - ihls + 1 - ihls = ipi - 2*ihls + 1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
END DO
@@ -199,9 +196,9 @@
CASE ( 'T' , 'W' ) ! T-, W-point
DO jl = 1, ipl ; DO jk = 1, ipk
!
- ! first: line number ipj-khls : 3 points
+ ! first: line number ipj-ihls : 3 points
DO jj = 1, 1
- ij1 = ipj - khls
+ ij1 = ipj - ihls
ij2 = ij1 ! same line
!
DO ji = 1, 1 ! points from ipi/2+1
@@ -209,37 +206,37 @@
ii2 = ipi/2 - ji + 1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = ptab(jf)%pt4d(ii2,ij2,jk,jl) ! Warning: pb with sign...
END DO
- DO ji = 1, 1 ! points ipi - khls
- ii1 = ipi - khls + ji - 1
- ii2 = khls + ji
+ DO ji = 1, 1 ! points ipi - ihls
+ ii1 = ipi - ihls + ji - 1
+ ii2 = ihls + ji
ptab(jf)%pt4d(ii1,ij1,jk,jl) = ptab(jf)%pt4d(ii2,ij2,jk,jl) ! Warning: pb with sign...
END DO
- DO ji = 1, 1 ! point khls: redo it just in case (if e-w periodocity already done)
- ! ! as we just changed point ipi - khls
- ii1 = khls + ji - 1
- ii2 = khls + ji
+ DO ji = 1, COUNT( (/ihls > 0/) ) ! point ihls: redo it just in case (if e-w periodocity already done)
+ ! ! as we just changed point ipi - ihls
+ ii1 = ihls + ji - 1
+ ii2 = ihls + ji
ptab(jf)%pt4d(ii1,ij1,jk,jl) = ptab(jf)%pt4d(ii2,ij2,jk,jl) ! Warning: pb with sign...
END DO
END DO
!
- ! Second: last khls lines (from ipj to ipj-khls+1) : full
- DO jj = 1, khls
- ij1 = ipj + 1 - jj ! ends at: ipj + 1 - khls
- ij2 = ipj - 2*khls + jj ! ends at: ipj - 2*khls + khls = ipj - khls
+ ! Second: last ihls lines (from ipj to ipj-ihls+1) : full
+ DO jj = 1, ihls
+ ij1 = ipj + 1 - jj ! ends at: ipj + 1 - ihls
+ ij2 = ipj - 2*ihls + jj ! ends at: ipj - 2*ihls + ihls = ipj - ihls
!
- DO ji = 1, khls ! first khls points
- ii1 = ji ! ends at: khls
- ii2 = 2*khls + 1 - ji ! ends at: 2*khls + 1 - khls = khls + 1
+ DO ji = 1, ihls ! first ihls points
+ ii1 = ji ! ends at: ihls
+ ii2 = 2*ihls + 1 - ji ! ends at: 2*ihls + 1 - ihls = ihls + 1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, Ni0glo ! points from khls to ipi - khls (note: Ni0glo = ipi - 2*khls)
- ii1 = khls + ji ! ends at: khls + ipi - 2*khls = ipi - khls
- ii2 = ipi - khls - ji + 1 ! ends at: ipi - khls - ( ipi - 2*khls ) + 1 = khls + 1
+ DO ji = 1, Ni0glo ! points from ihls to ipi - ihls (note: Ni0glo = ipi - 2*ihls)
+ ii1 = ihls + ji ! ends at: ihls + ipi - 2*ihls = ipi - ihls
+ ii2 = ipi - ihls - ji + 1 ! ends at: ipi - ihls - ( ipi - 2*ihls ) + 1 = ihls + 1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, khls ! last khls points
- ii1 = ipi - khls + ji ! ends at: ipi - khls + khls = ipi
- ii2 = ipi - khls - ji + 1 ! ends at: ipi - khls + 1 - khls = ipi - 2*khls + 1
+ DO ji = 1, ihls ! last ihls points
+ ii1 = ipi - ihls + ji ! ends at: ipi - ihls + ihls = ipi
+ ii2 = ipi - ihls - ji + 1 ! ends at: ipi - ihls + 1 - ihls = ipi - 2*ihls + 1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
END DO
@@ -248,34 +245,34 @@
CASE ( 'U' ) ! U-point
DO jl = 1, ipl ; DO jk = 1, ipk
!
- ! last khls lines (from ipj to ipj-khls+1) : full
- DO jj = 1, khls
- ij1 = ipj + 1 - jj ! ends at: ipj + 1 - khls
- ij2 = ipj - 2*khls + jj ! ends at: ipj - 2*khls + khls = ipj - khls
+ ! last ihls lines (from ipj to ipj-ihls+1) : full
+ DO jj = 1, ihls
+ ij1 = ipj + 1 - jj ! ends at: ipj + 1 - ihls
+ ij2 = ipj - 2*ihls + jj ! ends at: ipj - 2*ihls + ihls = ipj - ihls
!
- DO ji = 1, khls-1 ! first khls-1 points
- ii1 = ji ! ends at: khls-1
- ii2 = 2*khls - ji ! ends at: 2*khls - ( khls - 1 ) = khls + 1
+ DO ji = 1, ihls-1 ! first ihls-1 points
+ ii1 = ji ! ends at: ihls-1
+ ii2 = 2*ihls - ji ! ends at: 2*ihls - ( ihls - 1 ) = ihls + 1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, 1 ! point khls
- ii1 = khls + ji - 1
+ DO ji = 1, 1 ! point ihls (here ihls > 0 so it is ok)
+ ii1 = ihls + ji - 1
ii2 = ipi - ii1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, Ni0glo - 1 ! points from khls+1 to ipi - khls - 1 (note: Ni0glo = ipi - 2*khls)
- ii1 = khls + ji ! ends at: khls + ( ipi - 2*khls - 1 ) = ipi - khls - 1
- ii2 = ipi - khls - ji ! ends at: ipi - khls - ( ipi - 2*khls - 1 ) = khls + 1
+ DO ji = 1, Ni0glo - 1 ! points from ihls+1 to ipi - ihls - 1 (note: Ni0glo = ipi - 2*ihls)
+ ii1 = ihls + ji ! ends at: ihls + ( ipi - 2*ihls - 1 ) = ipi - ihls - 1
+ ii2 = ipi - ihls - ji ! ends at: ipi - ihls - ( ipi - 2*ihls - 1 ) = ihls + 1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, 1 ! point ipi - khls
- ii1 = ipi - khls + ji - 1
+ DO ji = 1, 1 ! point ipi - ihls
+ ii1 = ipi - ihls + ji - 1
ii2 = ii1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, khls ! last khls points
- ii1 = ipi - khls + ji ! ends at: ipi - khls + khls = ipi
- ii2 = ipi - khls - ji ! ends at: ipi - khls - khls = ipi - 2*khls
+ DO ji = 1, ihls ! last ihls points
+ ii1 = ipi - ihls + ji ! ends at: ipi - ihls + ihls = ipi
+ ii2 = ipi - ihls - ji ! ends at: ipi - ihls - ihls = ipi - 2*ihls
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
END DO
@@ -284,100 +281,100 @@
CASE ( 'V' ) ! V-point
DO jl = 1, ipl ; DO jk = 1, ipk
!
- ! last khls lines (from ipj to ipj-khls+1) : full
- DO jj = 1, khls
- ij1 = ipj - jj + 1 ! ends at: ipj - khls + 1
- ij2 = ipj - 2*khls + jj - 1 ! ends at: ipj - 2*khls + khls - 1 = ipj - khls - 1
+ ! last ihls lines (from ipj to ipj-ihls+1) : full
+ DO jj = 1, ihls
+ ij1 = ipj - jj + 1 ! ends at: ipj - ihls + 1
+ ij2 = ipj - 2*ihls + jj - 1 ! ends at: ipj - 2*ihls + ihls - 1 = ipj - ihls - 1
!
- DO ji = 1, khls ! first khls points
- ii1 = ji ! ends at: khls
- ii2 = 2*khls + 1 - ji ! ends at: 2*khls + 1 - khls = khls + 1
+ DO ji = 1, ihls ! first ihls points
+ ii1 = ji ! ends at: ihls
+ ii2 = 2*ihls + 1 - ji ! ends at: 2*ihls + 1 - ihls = ihls + 1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, Ni0glo ! points from khls to ipi - khls (note: Ni0glo = ipi - 2*khls)
- ii1 = khls + ji ! ends at: khls + ipi - 2*khls = ipi - khls
- ii2 = ipi - khls - ji + 1 ! ends at: ipi - khls - ( ipi - 2*khls ) + 1 = khls + 1
+ DO ji = 1, Ni0glo ! points from ihls to ipi - ihls (note: Ni0glo = ipi - 2*ihls)
+ ii1 = ihls + ji ! ends at: ihls + ipi - 2*ihls = ipi - ihls
+ ii2 = ipi - ihls - ji + 1 ! ends at: ipi - ihls - ( ipi - 2*ihls ) + 1 = ihls + 1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, khls ! last khls points
- ii1 = ipi - khls + ji ! ends at: ipi - khls + khls = ipi
- ii2 = ipi - khls - ji + 1 ! ends at: ipi - khls + 1 - khls = ipi - 2*khls + 1
+ DO ji = 1, ihls ! last ihls points
+ ii1 = ipi - ihls + ji ! ends at: ipi - ihls + ihls = ipi
+ ii2 = ipi - ihls - ji + 1 ! ends at: ipi - ihls + 1 - ihls = ipi - 2*ihls + 1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
END DO
!
- ! line number ipj-khls : right half
+ ! line number ipj-ihls : right half
DO jj = 1, 1
- ij1 = ipj - khls
+ ij1 = ipj - ihls
ij2 = ij1 ! same line
!
- DO ji = 1, Ni0glo/2 ! points from ipi/2+1 to ipi - khls (note: Ni0glo = ipi - 2*khls)
- ii1 = ipi/2 + ji ! ends at: ipi/2 + (ipi/2 - khls) = ipi - khls
- ii2 = ipi/2 - ji + 1 ! ends at: ipi/2 - (ipi/2 - khls) + 1 = khls + 1
+ DO ji = 1, Ni0glo/2 ! points from ipi/2+1 to ipi - ihls (note: Ni0glo = ipi - 2*ihls)
+ ii1 = ipi/2 + ji ! ends at: ipi/2 + (ipi/2 - ihls) = ipi - ihls
+ ii2 = ipi/2 - ji + 1 ! ends at: ipi/2 - (ipi/2 - ihls) + 1 = ihls + 1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, khls ! first khls points: redo them just in case (if e-w periodocity already done)
- ! ! as we just changed points ipi-2khls+1 to ipi-khls
- ii1 = ji ! ends at: khls
- ii2 = 2*khls + 1 - ji ! ends at: 2*khls + 1 - khls = khls + 1
+ DO ji = 1, ihls ! first ihls points: redo them just in case (if e-w periodocity already done)
+ ! ! as we just changed points ipi-2ihls+1 to ipi-ihls
+ ii1 = ji ! ends at: ihls
+ ii2 = 2*ihls + 1 - ji ! ends at: 2*ihls + 1 - ihls = ihls + 1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- ! ! last khls points: have been / will done by e-w periodicity
+ ! ! last ihls points: have been or will be done by e-w periodicity
END DO
!
END DO; END DO
CASE ( 'F' ) ! F-point
DO jl = 1, ipl ; DO jk = 1, ipk
!
- ! last khls lines (from ipj to ipj-khls+1) : full
- DO jj = 1, khls
- ij1 = ipj - jj + 1 ! ends at: ipj - khls + 1
- ij2 = ipj - 2*khls + jj - 1 ! ends at: ipj - 2*khls + khls - 1 = ipj - khls - 1
+ ! last ihls lines (from ipj to ipj-ihls+1) : full
+ DO jj = 1, ihls
+ ij1 = ipj - jj + 1 ! ends at: ipj - ihls + 1
+ ij2 = ipj - 2*ihls + jj - 1 ! ends at: ipj - 2*ihls + ihls - 1 = ipj - ihls - 1
!
- DO ji = 1, khls-1 ! first khls-1 points
- ii1 = ji ! ends at: khls-1
- ii2 = 2*khls - ji ! ends at: 2*khls - ( khls - 1 ) = khls + 1
+ DO ji = 1, ihls-1 ! first ihls-1 points
+ ii1 = ji ! ends at: ihls-1
+ ii2 = 2*ihls - ji ! ends at: 2*ihls - ( ihls - 1 ) = ihls + 1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, 1 ! point khls
- ii1 = khls + ji - 1
+ DO ji = 1, 1 ! point ihls (here ihls > 0 so it is ok)
+ ii1 = ihls + ji - 1
ii2 = ipi - ii1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, Ni0glo - 1 ! points from khls+1 to ipi - khls - 1 (note: Ni0glo = ipi - 2*khls)
- ii1 = khls + ji ! ends at: khls + ( ipi - 2*khls - 1 ) = ipi - khls - 1
- ii2 = ipi - khls - ji ! ends at: ipi - khls - ( ipi - 2*khls - 1 ) = khls + 1
+ DO ji = 1, Ni0glo - 1 ! points from ihls+1 to ipi - ihls - 1 (note: Ni0glo = ipi - 2*ihls)
+ ii1 = ihls + ji ! ends at: ihls + ( ipi - 2*ihls - 1 ) = ipi - ihls - 1
+ ii2 = ipi - ihls - ji ! ends at: ipi - ihls - ( ipi - 2*ihls - 1 ) = ihls + 1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, 1 ! point ipi - khls
- ii1 = ipi - khls + ji - 1
+ DO ji = 1, 1 ! point ipi - ihls
+ ii1 = ipi - ihls + ji - 1
ii2 = ii1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, khls ! last khls points
- ii1 = ipi - khls + ji ! ends at: ipi - khls + khls = ipi
- ii2 = ipi - khls - ji ! ends at: ipi - khls - khls = ipi - 2*khls
+ DO ji = 1, ihls ! last ihls points
+ ii1 = ipi - ihls + ji ! ends at: ipi - ihls + ihls = ipi
+ ii2 = ipi - ihls - ji ! ends at: ipi - ihls - ihls = ipi - 2*ihls
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
END DO
!
- ! line number ipj-khls : right half
+ ! line number ipj-ihls : right half
DO jj = 1, 1
- ij1 = ipj - khls
+ ij1 = ipj - ihls
ij2 = ij1 ! same line
!
- DO ji = 1, Ni0glo/2-1 ! points from ipi/2+1 to ipi - khls-1 (note: Ni0glo = ipi - 2*khls)
- ii1 = ipi/2 + ji ! ends at: ipi/2 + (ipi/2 - khls) = ipi - khls
- ii2 = ipi/2 - ji ! ends at: ipi/2 - (ipi/2 - khls - 1 ) = khls + 1
+ DO ji = 1, Ni0glo/2-1 ! points from ipi/2+1 to ipi - ihls-1 (note: Ni0glo = ipi - 2*ihls)
+ ii1 = ipi/2 + ji ! ends at: ipi/2 + (ipi/2 - ihls) = ipi - ihls
+ ii2 = ipi/2 - ji ! ends at: ipi/2 - (ipi/2 - ihls - 1 ) = ihls + 1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = 1, khls-1 ! first khls-1 points: redo them just in case (if e-w periodocity already done)
- ! ! as we just changed points ipi-2khls+1 to ipi-nn_hl-1
- ii1 = ji ! ends at: khls
- ii2 = 2*khls - ji ! ends at: 2*khls - ( khls - 1 ) = khls + 1
+ DO ji = 1, ihls-1 ! first ihls-1 points: redo them just in case (if e-w periodocity already done)
+ ! ! as we just changed points ipi-2ihls+1 to ipi-nn_hl-1
+ ii1 = ji ! ends at: ihls
+ ii2 = 2*ihls - ji ! ends at: 2*ihls - ( ihls - 1 ) = ihls + 1
ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- ! ! last khls points: have been / will done by e-w periodicity
+ ! ! last ihls points: have been or will be done by e-w periodicity
END DO
!
END DO; END DO
@@ -385,7 +382,7 @@
!
ENDIF ! c_NFtype == 'F'
!
- END DO ! ipf
+ END DO ! kfld
!
END SUBROUTINE lbc_nfd_/**/PRECISION
diff --git a/src/OCE/LBC/lbclnk.F90 b/src/OCE/LBC/lbclnk.F90
index be65cdc13..3776b5953 100644
--- a/src/OCE/LBC/lbclnk.F90
+++ b/src/OCE/LBC/lbclnk.F90
@@ -38,11 +38,9 @@ MODULE lbclnk
MODULE PROCEDURE lbc_lnk_pt2pt_sp, lbc_lnk_pt2pt_dp
END INTERFACE
-#if ! defined key_mpi2
INTERFACE lbc_lnk_neicoll
MODULE PROCEDURE lbc_lnk_neicoll_sp ,lbc_lnk_neicoll_dp
END INTERFACE
-#endif
!
INTERFACE lbc_lnk_icb
MODULE PROCEDURE mpp_lnk_2d_icb_dp, mpp_lnk_2d_icb_sp
@@ -51,10 +49,10 @@ MODULE lbclnk
PUBLIC lbc_lnk ! ocean/ice lateral boundary conditions
PUBLIC lbc_lnk_icb ! iceberg lateral boundary conditions
- REAL(dp), DIMENSION(:), ALLOCATABLE :: buffsnd_dp, buffrcv_dp ! MPI send/recv buffers
- REAL(sp), DIMENSION(:), ALLOCATABLE :: buffsnd_sp, buffrcv_sp !
- INTEGER, DIMENSION(8) :: nreq_p2p ! request id for MPI_Isend in point-2-point communication
-
+ REAL(dp), DIMENSION(:), ALLOCATABLE :: buffsnd_dp, buffrcv_dp ! MPI send/recv buffers
+ REAL(sp), DIMENSION(:), ALLOCATABLE :: buffsnd_sp, buffrcv_sp !
+ INTEGER, DIMENSION(8) :: nreq_p2p = MPI_REQUEST_NULL ! request id for MPI_Isend in point-2-point communication
+ INTEGER :: nreq_nei = MPI_REQUEST_NULL ! request id for mpi_neighbor_ialltoallv
!! * Substitutions
!!# include "do_loop_substitute.h90"
!!----------------------------------------------------------------------
@@ -134,9 +132,7 @@ CONTAINS
# define BUFFSND buffsnd_sp
# define BUFFRCV buffrcv_sp
# include "lbc_lnk_pt2pt_generic.h90"
-#if ! defined key_mpi2
# include "lbc_lnk_neicoll_generic.h90"
-#endif
# undef MPI_TYPE
# undef BUFFSND
# undef BUFFRCV
@@ -149,9 +145,7 @@ CONTAINS
# define BUFFSND buffsnd_dp
# define BUFFRCV buffrcv_dp
# include "lbc_lnk_pt2pt_generic.h90"
-#if ! defined key_mpi2
# include "lbc_lnk_neicoll_generic.h90"
-#endif
# undef MPI_TYPE
# undef BUFFSND
# undef BUFFRCV
diff --git a/src/OCE/LBC/lbcnfd.F90 b/src/OCE/LBC/lbcnfd.F90
index dc784b868..c6be460c9 100644
--- a/src/OCE/LBC/lbcnfd.F90
+++ b/src/OCE/LBC/lbcnfd.F90
@@ -23,8 +23,11 @@ MODULE lbcnfd
PRIVATE
INTERFACE lbc_nfd ! called by mpp_nfd, lbc_lnk_pt2pt or lbc_lnk_neicoll
- MODULE PROCEDURE lbc_nfd_sp, lbc_nfd_ext_sp
- MODULE PROCEDURE lbc_nfd_dp, lbc_nfd_ext_dp
+ MODULE PROCEDURE lbc_nfd_sp, lbc_nfd_dp
+ END INTERFACE
+
+ INTERFACE lbc_nfd_ext ! called by mpp_lnk_2d_icb
+ MODULE PROCEDURE lbc_nfd_ext_sp, lbc_nfd_ext_dp
END INTERFACE
INTERFACE mpp_nfd ! called by lbc_lnk_pt2pt or lbc_lnk_neicoll
@@ -33,11 +36,13 @@ MODULE lbcnfd
PUBLIC mpp_nfd ! mpi north fold conditions
PUBLIC lbc_nfd ! north fold conditions
+ PUBLIC lbc_nfd_ext ! north fold conditions, called by mpp_lnk_2d_icb
- INTEGER, PUBLIC :: nfd_nbnei
- INTEGER, PUBLIC, ALLOCATABLE, DIMENSION (: ) :: nfd_rknei
- INTEGER, PUBLIC, ALLOCATABLE, DIMENSION (:,:) :: nfd_rksnd
- INTEGER, PUBLIC, ALLOCATABLE, DIMENSION (:,:) :: nfd_jisnd
+ INTEGER, PUBLIC :: nfd_nbnei
+ INTEGER, PUBLIC, ALLOCATABLE, DIMENSION (: ) :: nfd_rknei
+ INTEGER, PUBLIC, ALLOCATABLE, DIMENSION (:,:,:) :: nfd_rksnd
+ INTEGER, PUBLIC, ALLOCATABLE, DIMENSION (:,:,:) :: nfd_jisnd
+ LOGICAL, PUBLIC, ALLOCATABLE, DIMENSION (:,: ) :: lnfd_same
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
diff --git a/src/OCE/LBC/lib_mpp.F90 b/src/OCE/LBC/lib_mpp.F90
index 9854cb04b..3c4c955f9 100644
--- a/src/OCE/LBC/lib_mpp.F90
+++ b/src/OCE/LBC/lib_mpp.F90
@@ -142,7 +142,7 @@ MODULE lib_mpp
INTEGER :: MPI_SUMDD
! Neighbourgs informations
- INTEGER, PARAMETER, PUBLIC :: n_hlsmax = 3
+ INTEGER, PARAMETER, PUBLIC :: n_hlsmax = 2
INTEGER, DIMENSION( 8), PUBLIC :: mpinei !: 8-neighbourg MPI indexes (starting at 0, -1 if no neighbourg)
INTEGER, DIMENSION(0:n_hlsmax,8), PUBLIC :: mpiSnei !: 8-neighbourg Send MPI indexes (starting at 0, -1 if no neighbourg)
INTEGER, DIMENSION(0:n_hlsmax,8), PUBLIC :: mpiRnei !: 8-neighbourg Recv MPI indexes (starting at 0, -1 if no neighbourg)
@@ -1127,7 +1127,7 @@ CONTAINS
INTEGER :: ierr
LOGICAL, PARAMETER :: ireord = .FALSE.
!!----------------------------------------------------------------------
-#if ! defined key_mpi_off && ! defined key_mpi2
+#if ! defined key_mpi_off
iScnt4 = COUNT( mpiSnei(khls,1:4) >= 0 )
iRcnt4 = COUNT( mpiRnei(khls,1:4) >= 0 )
@@ -1141,10 +1141,19 @@ CONTAINS
iSnei8 = PACK( mpiSnei(khls,1:8), mask = mpiSnei(khls,1:8) >= 0 )
iRnei8 = PACK( mpiRnei(khls,1:8), mask = mpiRnei(khls,1:8) >= 0 )
+ ! Isolated processes (i.e., processes WITH no outgoing or incoming edges, that is, processes that have specied
+ ! indegree and outdegree as zero and thus DO not occur as source or destination rank in the graph specication)
+ ! are allowed.
+
+# if ! defined key_mpi2
CALL MPI_Dist_graph_create_adjacent( mpi_comm_oce, iScnt4, iSnei4, MPI_UNWEIGHTED, iRcnt4, iRnei4, MPI_UNWEIGHTED, &
& MPI_INFO_NULL, ireord, mpi_nc_com4(khls), ierr )
CALL MPI_Dist_graph_create_adjacent( mpi_comm_oce, iScnt8, iSnei8, MPI_UNWEIGHTED, iRcnt8, iRnei8, MPI_UNWEIGHTED, &
& MPI_INFO_NULL, ireord, mpi_nc_com8(khls), ierr)
+# else
+ mpi_nc_com4(khls) = -1
+ mpi_nc_com8(khls) = -1
+# endif
DEALLOCATE( iSnei4, iRnei4, iSnei8, iRnei8 )
#endif
@@ -1307,7 +1316,7 @@ CONTAINS
IF ( ncomm_sequence(ji,1) .GT. 1 .AND. ncomm_sequence(ji,2) .GT. 1 ) jj = jj + 1
jh = MAX (jh, ncomm_sequence(ji,1)*ncomm_sequence(ji,2))
END DO
- WRITE(numcom,'(A,I3)') ' 3D Exchanged halos : ', jk
+ WRITE(numcom,'(A,I3)') ' 3D or 4D Exchanged halos : ', jk
WRITE(numcom,'(A,I3)') ' Multi arrays exchanged halos : ', jf
WRITE(numcom,'(A,I3)') ' from which 3D : ', jj
WRITE(numcom,'(A,I10)') ' Array max size : ', jh*jpi*jpj
diff --git a/src/OCE/LBC/mpp_lbc_north_icb_generic.h90 b/src/OCE/LBC/mpp_lbc_north_icb_generic.h90
index 3c8382eac..63cef9abf 100644
--- a/src/OCE/LBC/mpp_lbc_north_icb_generic.h90
+++ b/src/OCE/LBC/mpp_lbc_north_icb_generic.h90
@@ -92,7 +92,7 @@
! 2. North-Fold boundary conditions
! ----------------------------------
- CALL lbc_nfd( ztab_e(:,1-kextj:ipj+kextj), cd_type, psgn, kextj )
+ CALL lbc_nfd_ext( ztab_e(:,1-kextj:ipj+kextj), cd_type, psgn, kextj )
ij = 1 - kextj
!! Scatter back to pt2d
diff --git a/src/OCE/LBC/mpp_lnk_icb_generic.h90 b/src/OCE/LBC/mpp_lnk_icb_generic.h90
index 8798f3e0c..b0cb70d46 100644
--- a/src/OCE/LBC/mpp_lnk_icb_generic.h90
+++ b/src/OCE/LBC/mpp_lnk_icb_generic.h90
@@ -87,7 +87,7 @@
IF( l_IdoNFold ) THEN
!
SELECT CASE ( jpni )
- CASE ( 1 ) ; CALL lbc_nfd ( pt2d(1:jpi,1:jpj+kextj), cd_type, psgn, kextj )
+ CASE ( 1 ) ; CALL lbc_nfd_ext ( pt2d(1:jpi,1:jpj+kextj), cd_type, psgn, kextj )
CASE DEFAULT ; CALL LBCNORTH ( pt2d(1:jpi,1:jpj+kextj), cd_type, psgn, kextj )
END SELECT
!
diff --git a/src/OCE/LBC/mpp_loc_generic.h90 b/src/OCE/LBC/mpp_loc_generic.h90
index 1bce8df2d..fe5697630 100644
--- a/src/OCE/LBC/mpp_loc_generic.h90
+++ b/src/OCE/LBC/mpp_loc_generic.h90
@@ -47,6 +47,7 @@
!
INTEGER :: ierror, ii, idim
INTEGER :: index0
+ INTEGER :: ihls, ipiglo, ipjglo
INTEGER , DIMENSION(:), ALLOCATABLE :: ilocs
REAL(PRECISION) :: zmin ! local minimum
REAL(PRECISION), DIMENSION(2,1) :: zain, zaout
@@ -60,6 +61,9 @@
ENDIF
!
idim = SIZE(kindex)
+ ihls = ( SIZE(ARRAY_IN(:,:,:), 1) - Ni_0 ) / 2
+ ipiglo = Ni0glo + 2*ihls
+ ipjglo = Nj0glo + 2*ihls
!
IF ( ANY( MASK_IN(:,:,:) ) ) THEN ! there is at least 1 valid point...
!
@@ -68,9 +72,9 @@
ilocs = LOC_OPERATION( ARRAY_IN(:,:,:) , mask= MASK_IN(:,:,:) )
zmin = ARRAY_IN(ilocs(1),ilocs(2),ilocs(3))
!
- kindex(1) = mig( ilocs(1) )
+ kindex(1) = mig( ilocs(1), ihls )
#if defined DIM_2d || defined DIM_3d /* avoid warning when kindex has 1 element */
- kindex(2) = mjg( ilocs(2) )
+ kindex(2) = mjg( ilocs(2), ihls )
#endif
#if defined DIM_3d /* avoid warning when kindex has 2 elements */
kindex(3) = ilocs(3)
@@ -80,10 +84,10 @@
!
index0 = kindex(1)-1 ! 1d index starting at 0
#if defined DIM_2d || defined DIM_3d /* avoid warning when kindex has 1 element */
- index0 = index0 + jpiglo * (kindex(2)-1)
+ index0 = index0 + ipiglo * (kindex(2)-1)
#endif
#if defined DIM_3d /* avoid warning when kindex has 2 elements */
- index0 = index0 + jpiglo * jpjglo * (kindex(3)-1)
+ index0 = index0 + ipiglo * ipjglo * (kindex(3)-1)
#endif
ELSE
! special case for land processors
@@ -105,20 +109,20 @@
pmin = zaout(1,1)
index0 = NINT( zaout(2,1) )
#if defined DIM_3d /* avoid warning when kindex has 2 elements */
- kindex(3) = index0 / (jpiglo*jpjglo)
- index0 = index0 - kindex(3) * (jpiglo*jpjglo)
+ kindex(3) = index0 / (ipiglo*ipjglo)
+ index0 = index0 - kindex(3) * (ipiglo*ipjglo)
#endif
#if defined DIM_2d || defined DIM_3d /* avoid warning when kindex has 1 element */
- kindex(2) = index0 / jpiglo
- index0 = index0 - kindex(2) * jpiglo
+ kindex(2) = index0 / ipiglo
+ index0 = index0 - kindex(2) * ipiglo
#endif
kindex(1) = index0
kindex(:) = kindex(:) + 1 ! start indices at 1
IF( .NOT. llhalo ) THEN
- kindex(1) = kindex(1) - nn_hls
+ kindex(1) = kindex(1) - ihls
#if defined DIM_2d || defined DIM_3d /* avoid warning when kindex has 1 element */
- kindex(2) = kindex(2) - nn_hls
+ kindex(2) = kindex(2) - ihls
#endif
ENDIF
diff --git a/src/OCE/LBC/mpp_nfd_generic.h90 b/src/OCE/LBC/mpp_nfd_generic.h90
index fd45035fe..237f9b311 100644
--- a/src/OCE/LBC/mpp_nfd_generic.h90
+++ b/src/OCE/LBC/mpp_nfd_generic.h90
@@ -1,38 +1,39 @@
- SUBROUTINE mpp_nfd_/**/PRECISION( ptab, cd_nat, psgn, kfillmode, pfillval, khls, kfld )
+ SUBROUTINE mpp_nfd_/**/PRECISION( ptab, cd_nat, psgn, kfillmode, pfillval, kfld )
TYPE(PTR_4d_/**/PRECISION), DIMENSION(:), INTENT(inout) :: ptab ! pointer of arrays on which apply the b.c.
- CHARACTER(len=1), DIMENSION(:), INTENT(in ) :: cd_nat ! nature of array grid-points
- REAL(PRECISION), DIMENSION(:), INTENT(in ) :: psgn ! sign used across the north fold boundary
- INTEGER , INTENT(in ) :: kfillmode ! filling method for halo over land
- REAL(PRECISION) , INTENT(in ) :: pfillval ! background value (used at closed boundaries)
- INTEGER , INTENT(in ) :: khls ! halo size, default = nn_hls
- INTEGER , INTENT(in ) :: kfld ! number of pt3d arrays
+ CHARACTER(len=1), DIMENSION(kfld), INTENT(in ) :: cd_nat ! nature of array grid-points
+ REAL(PRECISION), DIMENSION(kfld), INTENT(in ) :: psgn ! sign used across the north fold boundary
+ INTEGER , INTENT(in ) :: kfillmode ! filling method for halo over land
+ REAL(PRECISION) , INTENT(in ) :: pfillval ! background value (used at closed boundaries)
+ INTEGER , INTENT(in ) :: kfld ! number of pt3d arrays
!
LOGICAL :: ll_add_line
INTEGER :: ji, jj, jk, jl, jf, jr, jg, jn ! dummy loop indices
- INTEGER :: ipi, ipj, ipj2, ipk, ipl, ipf ! dimension of the input array
- INTEGER :: ierr, ibuffsize, iis0, iie0, impp
- INTEGER :: ii1, ii2, ij1, ij2, iis, iie, iib, iig, iin
- INTEGER :: i0max
- INTEGER :: ij, iproc, ipni, ijnr
- INTEGER, DIMENSION (:), ALLOCATABLE :: ireq_s, ireq_r ! for mpi_isend when avoiding mpi_allgather
- INTEGER :: ipjtot ! sum of lines for all multi fields
- INTEGER :: i012 ! 0, 1 or 2
- INTEGER , DIMENSION(:,:) , ALLOCATABLE :: ijsnd ! j-position of sent lines for each field
- INTEGER , DIMENSION(:,:) , ALLOCATABLE :: ijbuf ! j-position of send buffer lines for each field
- INTEGER , DIMENSION(:,:) , ALLOCATABLE :: ijrcv ! j-position of recv buffer lines for each field
- INTEGER , DIMENSION(:,:) , ALLOCATABLE :: ii1st, iiend
- INTEGER , DIMENSION(:) , ALLOCATABLE :: ipjfld ! number of sent lines for each field
- REAL(PRECISION), DIMENSION(:,:,:,:) , ALLOCATABLE :: zbufs ! buffer, receive and work arrays
- REAL(PRECISION), DIMENSION(:,:,:,:,:) , ALLOCATABLE :: zbufr ! buffer, receive and work arrays
- REAL(PRECISION), DIMENSION(:,:,:,:,:) , ALLOCATABLE :: znorthloc
- REAL(PRECISION), DIMENSION(:,:,:,:,:,:), ALLOCATABLE :: znorthglo
- TYPE(PTR_4D_/**/PRECISION), DIMENSION(:), ALLOCATABLE :: ztabglo ! array or pointer of arrays on which apply the b.c.
+ INTEGER :: ierr, ibuffsize, impp, ipi0
+ INTEGER :: ii1, ii2, ij1, ij2, ij3, iig, inei
+ INTEGER :: i0max, ilntot, iisht, ijsht, ihsz
+ INTEGER :: iproc, ijnr, ipjtot, iFT, iFU, i012
+ INTEGER, DIMENSION(kfld) :: ipi, ipj, ipj1, ipj2, ipk, ipl ! dimension of the input array
+ INTEGER, DIMENSION(kfld) :: ihls ! halo size
+ INTEGER, DIMENSION(:) , ALLOCATABLE :: ireq_s, ireq_r ! for mpi_isend when avoiding mpi_allgather
+ INTEGER, DIMENSION(:) , ALLOCATABLE :: ipjfld ! number of sent lines for each field
+ REAL(PRECISION) :: zhuge, zztmp
+ REAL(PRECISION), DIMENSION(:,:) , ALLOCATABLE :: zbufs ! buffer, receive and work arrays
+ REAL(PRECISION), DIMENSION(:,:,:), ALLOCATABLE :: zbufr ! buffer, receive and work arrays
+ REAL(PRECISION), DIMENSION(:,:) , ALLOCATABLE :: znorthloc
+ REAL(PRECISION), DIMENSION(:,:,:), ALLOCATABLE :: znorthall
+ TYPE(PTR_4D_/**/PRECISION), DIMENSION(1) :: ztabglo ! array or pointer of arrays on which apply the b.c.
!!----------------------------------------------------------------------
!
- ipk = SIZE(ptab(1)%pt4d,3)
- ipl = SIZE(ptab(1)%pt4d,4)
- ipf = kfld
+ zhuge = HUGE(0._/**/PRECISION) ! avoid to call the huge function inside do loops
+ !
+ DO jf = 1, kfld
+ ipi(jf) = SIZE(ptab(jf)%pt4d,1)
+ ipj(jf) = SIZE(ptab(jf)%pt4d,2)
+ ipk(jf) = SIZE(ptab(jf)%pt4d,3)
+ ipl(jf) = SIZE(ptab(jf)%pt4d,4)
+ ihls(jf) = ( ipi(jf) - Ni_0 ) / 2
+ END DO
!
IF( ln_nnogather ) THEN !== no allgather exchanges ==!
@@ -61,74 +62,43 @@
! also force it if not restart during the first 2 steps (leap frog?)
ll_add_line = l_full_nf_update .OR. ( ncom_stp <= nit000+1 .AND. .NOT. ln_rstart )
- ALLOCATE(ipjfld(ipf)) ! how many lines do we exchange for each field?
+ ALLOCATE(ipjfld(kfld)) ! how many lines do we send for each field?
IF( ll_add_line ) THEN
- DO jf = 1, ipf ! Loop over the number of arrays to be processed
- ipjfld(jf) = khls + COUNT( (/ c_NFtype == 'T' .OR. cd_nat(jf) == 'V' .OR. cd_nat(jf) == 'F' /) )
+ DO jf = 1, kfld ! Loop over the number of arrays to be processed
+ ipjfld(jf) = ihls(jf) + COUNT( (/ c_NFtype == 'T' .OR. cd_nat(jf) == 'V' .OR. cd_nat(jf) == 'F' /) ) &
+ & + COUNT( (/ c_NFtype == 'F' .AND. cd_nat(jf) == 'T' .AND. ihls(jf) == 0 /) )
END DO
ELSE
- ipjfld(:) = khls
+ ipjfld(:) = ihls(:)
ENDIF
-
- ipj = MAXVAL(ipjfld(:)) ! Max 2nd dimension of message transfers
- ipjtot = SUM( ipjfld(:)) ! Total number of lines to be exchanged
-
- ! Index of modifying lines in input
- ALLOCATE( ijsnd(ipj, ipf), ijbuf(ipj, ipf), ijrcv(ipj, ipf), ii1st(ipj, ipf), iiend(ipj, ipf) )
-
- ij1 = 0
- DO jf = 1, ipf ! Loop over the number of arrays to be processed
- !
- DO jj = 1, khls ! first khls lines (starting from top) must be fully defined
- ii1st(jj, jf) = 1
- iiend(jj, jf) = jpi
- END DO
- !
- ! what do we do with line khls+1 (starting from top)
- IF( c_NFtype == 'T' ) THEN ! * North fold T-point pivot
- SELECT CASE ( cd_nat(jf) )
- CASE ('T','W') ; i012 = 1 ; ii1st(khls+1, jf) = mi0(jpiglo/2+2) ; iiend(khls+1, jf) = mi1(jpiglo-khls)
- CASE ('U' ) ; i012 = 1 ; ii1st(khls+1, jf) = mi0(jpiglo/2+1) ; iiend(khls+1, jf) = mi1(jpiglo-khls)
- CASE ('V' ) ; i012 = 2 ; ii1st(khls+1, jf) = 1 ; iiend(khls+1, jf) = jpi
- CASE ('F' ) ; i012 = 2 ; ii1st(khls+1, jf) = 1 ; iiend(khls+1, jf) = jpi
- END SELECT
- ENDIF
- IF( c_NFtype == 'F' ) THEN ! * North fold F-point pivot
- SELECT CASE ( cd_nat(jf) )
- CASE ('T','W') ; i012 = 0 ! we don't touch line khls+1
- CASE ('U' ) ; i012 = 0 ! we don't touch line khls+1
- CASE ('V' ) ; i012 = 1 ; ii1st(khls+1, jf) = mi0(jpiglo/2+1) ; iiend(khls+1, jf) = mi1(jpiglo-khls )
- CASE ('F' ) ; i012 = 1 ; ii1st(khls+1, jf) = mi0(jpiglo/2+1) ; iiend(khls+1, jf) = mi1(jpiglo-khls-1)
- END SELECT
- ENDIF
- !
- DO jj = 1, ipjfld(jf)
- ij1 = ij1 + 1
- ijsnd(jj,jf) = jpj - 2*khls + jj - i012 ! sent lines (from bottom of sent lines)
- ijbuf(jj,jf) = ij1 ! gather all lines in the snd/rcv buffers
- ijrcv(jj,jf) = jpj - jj + 1 ! recv lines (from the top -> reverse order for jj)
- END DO
- !
- END DO
!
- i0max = jpimax - 2 * khls ! we are not sending the halos
- ALLOCATE( zbufs(i0max,ipjtot,ipk,ipl), ireq_s(nfd_nbnei) ) ! store all the data to be sent in a buffer array
- ibuffsize = i0max * ipjtot * ipk * ipl
+ i0max = MAXVAL( nfni_0, mask = nfproc /= -1 ) ! largest value of Ni_0 among processors (we are not sending halos)
+ ilntot = SUM( ipjfld(:) * ipk(:) * ipl(:) )
+ ALLOCATE( zbufs(i0max,ilntot), ireq_s(nfd_nbnei) ) ! store all the data to be sent in a buffer array
+ ibuffsize = i0max * ilntot ! must be the same for all processors -> use i0max
!
! fill the send buffer with all the lines
- DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk
- DO jj = 1, ipjfld(jf)
- ij1 = ijbuf(jj,jf)
- ij2 = ijsnd(jj,jf)
- DO ji = Nis0, Nie0 ! should not use any other value
- iib = ji - Nis0 + 1
- zbufs(iib,ij1,jk,jl) = ptab(jf)%pt4d(ji,ij2,jk,jl)
- END DO
- DO ji = Ni_0+1, i0max ! avoid sending uninitialized values (make sure we don't use it)
- zbufs(ji,ij1,jk,jl) = HUGE(0._/**/PRECISION) ! make sure we don't use it...
+ ij1 = 0
+ DO jf = 1, kfld
+ !
+ i012 = COUNT( (/ c_NFtype == 'T' /) ) + COUNT( (/ cd_nat(jf) == 'V' .OR. cd_nat(jf) == 'F' /) ) &
+ & + COUNT( (/ ihls(jf) == 0 .AND. cd_nat(jf) == 'T' .AND. c_NFtype == 'F' /) ) ! 0, 1 OR 2
+ ijsht = ipj(jf) - 2*ihls(jf) - i012 ! j-position of the sent lines (from bottom of sent lines)
+ !
+ DO jl = 1, ipl(jf) ; DO jk = 1, ipk(jf)
+ DO jj = 1, ipjfld(jf)
+ ij1 = ij1 + 1
+ ij2 = jj + ijsht
+ DO ji = 1, Ni_0 ! use only inner domain
+ ii2 = ji + ihls(jf)
+ zbufs(ji,ij1) = ptab(jf)%pt4d(ii2,ij2,jk,jl)
+ END DO
+ DO ji = Ni_0+1, i0max ! avoid sending uninitialized values and make sure we don't use it
+ zbufs(ji,ij1) = zhuge
+ END DO
END DO
- END DO
- END DO ; END DO ; END DO
+ END DO ; END DO
+ END DO ! jf
!
! start waiting time measurement
IF( ln_timing ) CALL tic_tac(.TRUE.)
@@ -136,68 +106,62 @@
! send the same buffer data to all neighbourgs as soon as possible
DO jn = 1, nfd_nbnei
iproc = nfd_rknei(jn)
- IF( iproc /= narea-1 .AND. iproc /= -1 ) THEN
+ IF( iproc /= narea-1 .AND. iproc /= -1 ) THEN ! it is neither me nor a land-only neighbourg
#if ! defined key_mpi_off
CALL MPI_Isend( zbufs, ibuffsize, MPI_TYPE, iproc, 5, mpi_comm_oce, ireq_s(jn), ierr )
#endif
ELSE
- ireq_s(jn) = MPI_REQUEST_NULL
+ ireq_s(jn) = MPI_REQUEST_NULL ! must be defined for mpi_waitall
ENDIF
END DO
!
- ALLOCATE( zbufr(i0max,ipjtot,ipk,ipl,nfd_nbnei), ireq_r(nfd_nbnei) )
+ ALLOCATE( zbufr(i0max,ilntot,nfd_nbnei), ireq_r(nfd_nbnei) )
!
- DO jn = 1, nfd_nbnei
- !
+ DO jn = 1, nfd_nbnei ! 1st loop: first get data which does not need any communication
+ ! ! -> this gives more time to receive the communications
iproc = nfd_rknei(jn)
!
- IF( iproc == -1 ) THEN ! No neighbour (land proc that was suppressed)
+ IF( iproc == -1 ) THEN ! No neighbour (land-only neighbourg that was suppressed)
!
- ireq_r(jn) = MPI_REQUEST_NULL ! no message to be received
- zbufr(:,:,:,:,jn) = HUGE(0._/**/PRECISION) ! default: define it and make sure we don't use it...
+ ireq_r(jn) = MPI_REQUEST_NULL ! no message to be received, must be defined for mpi_waitall
SELECT CASE ( kfillmode )
CASE ( jpfillnothing ) ! no filling
- CASE ( jpfillcopy ) ! filling with inner domain values
- DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk
- DO jj = 1, ipjfld(jf)
- ij1 = ijbuf(jj,jf)
- ij2 = ijsnd(jj,jf) ! we will use only the first value, see init_nfdcom
- zbufr(1,ij1,jk,jl,jn) = ptab(jf)%pt4d(Nis0,ij2,jk,jl) ! chose to take the 1st inner domain point
- END DO
- END DO ; END DO ; END DO
+ CASE ( jpfillcopy ) ! filling with my inner domain values
+ ! ! trick: we use only the 1st value, see init_nfdcom
+ zbufr(1,:,jn) = zbufs(1,:) ! chose to take the 1st inner domain point
CASE ( jpfillcst ) ! filling with constant value
- zbufr(1,:,:,:,jn) = pfillval ! we will use only the first value, see init_nfdcom
+ zbufr(1,:,jn) = pfillval ! trick: we use only the 1st value, see init_nfdcom
END SELECT
!
- ELSE IF( iproc == narea-1 ) THEN ! get data from myself!
+ ELSE IF( iproc == narea-1 ) THEN ! I get data from myself!
!
- ireq_r(jn) = MPI_REQUEST_NULL ! no message to be received
- DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk
- DO jj = 1, ipjfld(jf)
- ij1 = ijbuf(jj,jf)
- ij2 = ijsnd(jj,jf)
- DO ji = Nis0, Nie0 ! should not use any other value
- iib = ji - Nis0 + 1
- zbufr(iib,ij1,jk,jl,jn) = ptab(jf)%pt4d(ji,ij2,jk,jl)
- END DO
- END DO
- END DO ; END DO ; END DO
+ ireq_r(jn) = MPI_REQUEST_NULL ! no message to be received, must be defined for mpi_waitall
+ zbufr(:,:,jn) = zbufs(:,:) ! we can directly do: received buffer = sent buffer!
!
- ELSE ! get data from a neighbour trough communication
+ ENDIF
+ !
+ END DO ! nfd_nbnei
+ !
+ DO jn = 1, nfd_nbnei ! 2nd loop: now get data from a neighbour trough communication
+ !
+ iproc = nfd_rknei(jn)
+ IF( iproc /= narea-1 .AND. iproc /= -1 ) THEN ! it is neither me nor a land-only neighbourg
#if ! defined key_mpi_off
- CALL MPI_Irecv( zbufr(:,:,:,:,jn), ibuffsize, MPI_TYPE, iproc, 5, mpi_comm_oce, ireq_r(jn), ierr )
+ CALL MPI_Irecv( zbufr(:,:,jn), ibuffsize, MPI_TYPE, iproc, 5, mpi_comm_oce, ireq_r(jn), ierr )
#endif
ENDIF
- !
END DO ! nfd_nbnei
!
+#if ! defined key_mpi_off
CALL mpi_waitall(nfd_nbnei, ireq_r, MPI_STATUSES_IGNORE, ierr) ! wait for all Irecv
+#endif
!
IF( ln_timing ) CALL tic_tac(.FALSE.)
!
- ! North fold boundary condition
+ ! Apply the North pole folding
!
- DO jf = 1, ipf
+ ij2 = 0
+ DO jf = 1, kfld
!
SELECT CASE ( cd_nat(jf) ) ! which grid number?
CASE ('T','W') ; iig = 1 ! T-, W-point
@@ -206,76 +170,43 @@
CASE ('F') ; iig = 4 ! F-point
END SELECT
!
- DO jl = 1, ipl ; DO jk = 1, ipk
- !
- ! if T point with F-point pivot : must be done first
- ! --> specific correction of 3 points near the 2 pivots (to be clean, usually masked -> so useless)
- IF( c_NFtype == 'F' .AND. iig == 1 ) THEN
- ij1 = jpj - khls ! j-index in the receiving array
- ij2 = 1 ! only 1 line in the buffer
- DO ji = mi0(khls), mi1(khls) ! change because of EW periodicity as we also change jpiglo-khls
- iib = nfd_jisnd(mi0( khls),iig) ! i-index in the buffer
- iin = nfd_rksnd(mi0( khls),iig) ! neigbhour-index in the buffer
- IF( nfd_rknei(iin) == -1 .AND. kfillmode == jpfillnothing ) CYCLE
- ptab(jf)%pt4d(ji,ij1,jk,jl) = zbufr(iib,ij2,jk,jl,iin) ! no psgn(jf)
- END DO
- DO ji = mi0(jpiglo/2+1), mi1(jpiglo/2+1)
- iib = nfd_jisnd(mi0( jpiglo/2+1),iig) ! i-index in the buffer
- iin = nfd_rksnd(mi0( jpiglo/2+1),iig) ! neigbhour-index in the buffer
- IF( nfd_rknei(iin) == -1 .AND. kfillmode == jpfillnothing ) CYCLE
- ptab(jf)%pt4d(ji,ij1,jk,jl) = zbufr(iib,ij2,jk,jl,iin) ! no psgn(jf)
- END DO
- DO ji = mi0(jpiglo-khls), mi1(jpiglo-khls)
- iib = nfd_jisnd(mi0(jpiglo-khls),iig) ! i-index in the buffer
- iin = nfd_rksnd(mi0(jpiglo-khls),iig) ! neigbhour-index in the buffer
- IF( nfd_rknei(iin) == -1 .AND. kfillmode == jpfillnothing ) CYCLE
- ptab(jf)%pt4d(ji,ij1,jk,jl) = zbufr(iib,ij2,jk,jl,iin) ! no psgn(jf)
- END DO
- ENDIF
+ ihsz = ihls(jf) ! shorter name
+ iisht = nn_hls - ihsz
+ iFT = COUNT( (/ ihsz > 0 .AND. c_NFtype == 'F' .AND. cd_nat(jf) == 'T' /) ) ! F-folding and T grid
+ !
+ DO jl = 1, ipl(jf) ; DO jk = 1, ipk(jf)
!
- ! Apply the North pole folding.
- DO jj = 1, ipjfld(jf) ! for all lines to be exchanged for this field
- ij1 = ijrcv(jj,jf) ! j-index in the receiving array
- ij2 = ijbuf(jj,jf) ! j-index in the buffer
- iis = ii1st(jj,jf) ! stating i-index in the receiving array
- iie = iiend(jj,jf) ! ending i-index in the receiving array
- DO ji = iis, iie
- iib = nfd_jisnd(ji,iig) ! i-index in the buffer
- iin = nfd_rksnd(ji,iig) ! neigbhour-index in the buffer
- IF( nfd_rknei(iin) == -1 .AND. kfillmode == jpfillnothing ) CYCLE
- ptab(jf)%pt4d(ji,ij1,jk,jl) = psgn(jf) * zbufr(iib,ij2,jk,jl,iin)
+ DO jj = 1,ihsz ! NP folding for the last ihls(jf) lines of this field
+ ij1 = ipj(jf) - jj + 1 ! j-index in the receiving array (from the top -> reverse order for jj)
+ ij2 = ij2 + 1
+ ij3 = ihsz+1 - jj + 1
+ DO ji = 1, ipi(jf)
+ ii1 = ji + iisht
+ inei = nfd_rksnd(ii1,ij3,iig) ! neigbhour-index in the buffer
+ IF( nfd_rknei(inei) == -1 .AND. kfillmode == jpfillnothing ) CYCLE ! no neighbourg and do nothing to fill
+ ii2 = nfd_jisnd(ii1,ij3,iig) ! i-index in the buffer, starts at 1 in the inner domain
+ ptab(jf)%pt4d(ji,ij1,jk,jl) = psgn(jf) * zbufr(ii2,ij2,inei)
END DO
END DO
- !
- ! re-apply periodocity when we modified the eastern side of the inner domain (and not the full line)
- IF( c_NFtype == 'T' ) THEN ! * North fold T-point pivot
- IF( iig <= 2 ) THEN ; iis = mi0(1) ; iie = mi1(khls) ! 'T','W','U': update west halo
- ELSE ; iis = 1 ; iie = 0 ! 'V','F' : full line already exchanged
- ENDIF
- ENDIF
- IF( c_NFtype == 'F' ) THEN ! * North fold F-point pivot
- IF( iig <= 2 ) THEN ; iis = 1 ; iie = 0 ! 'T','W','U': nothing to do
- ELSEIF( iig == 3 ) THEN ; iis = mi0(1) ; iie = mi1(khls) ! 'V' : update west halo
- ELSEIF( khls > 1 ) THEN ; iis = mi0(1) ; iie = mi1(khls-1) ! 'F' and khls > 1
- ELSE ; iis = 1 ; iie = 0 ! 'F' and khls == 1 : nothing to do
- ENDIF
- ENDIF
- jj = ipjfld(jf) ! only for the last line of this field
- ij1 = ijrcv(jj,jf) ! j-index in the receiving array
- ij2 = ijbuf(jj,jf) ! j-index in the buffer
- DO ji = iis, iie
- iib = nfd_jisnd(ji,iig) ! i-index in the buffer
- iin = nfd_rksnd(ji,iig) ! neigbhour-index in the buffer
- IF( nfd_rknei(iin) == -1 .AND. kfillmode == jpfillnothing ) CYCLE
- ptab(jf)%pt4d(ji,ij1,jk,jl) = psgn(jf) * zbufr(iib,ij2,jk,jl,iin)
+ DO jj = ihsz+1, ipjfld(jf)+iFT ! NP folding for line ipj-ihsz that can be partially modified
+ ij1 = ipj(jf) - jj + 1 ! j-index in the receiving array (from the top -> reverse order for jj)
+ ij2 = ij2 + 1 - iFT
+ ij3 = 1
+ DO ji = 1, ipi(jf)
+ ii1 = ji + iisht
+ IF( lnfd_same(ii1,iig) ) CYCLE ! do nothing if should not be modified
+ inei = nfd_rksnd(ii1,ij3,iig) ! neigbhour-index in the buffer
+ IF( nfd_rknei(inei) == -1 .AND. kfillmode == jpfillnothing ) CYCLE ! no neighbourg and do nothing to fill
+ ii2 = nfd_jisnd(ii1,ij3,iig) ! i-index in the buffer, starts at 1 in the inner domain
+ ptab(jf)%pt4d(ji,ij1,jk,jl) = psgn(jf) * zbufr(ii2,ij2,inei)
+ END DO
END DO
!
- END DO ; END DO ! ipl ; ipk
+ END DO ; END DO ! jk ; jl
!
- END DO ! ipf
-
+ END DO ! jf
!
- DEALLOCATE( zbufr, ireq_r, ijsnd, ijbuf, ijrcv, ii1st, iiend, ipjfld )
+ DEALLOCATE( zbufr, ireq_r, ipjfld )
!
CALL mpi_waitall(nfd_nbnei, ireq_s, MPI_STATUSES_IGNORE, ierr) ! wait for all Isend
!
@@ -283,114 +214,128 @@
!
ELSE !== allgather exchanges ==!
!
- ! how many lines do we exchange at max? -> ipj (no further optimizations in this case...)
- ipj = khls + 2
- ! how many lines do we need at max? -> ipj2 (no further optimizations in this case...)
- ipj2 = 2 * khls + 2
+ DO jf = 1, kfld
+ ! how many lines do we send for each field?
+ ipj1(jf) = ihls(jf) + COUNT( (/ c_NFtype == 'T' .OR. cd_nat(jf) == 'V' .OR. cd_nat(jf) == 'F' /) ) &
+ & + COUNT( (/ c_NFtype == 'F' .AND. cd_nat(jf) == 'T' .AND. ihls(jf) == 0 /) )
+ ! how many lines do we need for each field?
+ ipj2(jf) = 2 * ihls(jf) + COUNT( (/ c_NFtype == 'T' /) ) + COUNT( (/ cd_nat(jf) == 'V' .OR. cd_nat(jf) == 'F' /) ) &
+ & + COUNT( (/ c_NFtype == 'F' .AND. cd_nat(jf) == 'T' .AND. ihls(jf) == 0 /) )
+ END DO
!
- i0max = jpimax - 2 * khls
- ibuffsize = i0max * ipj * ipk * ipl * ipf
- ALLOCATE( znorthloc(i0max,ipj,ipk,ipl,ipf), znorthglo(i0max,ipj,ipk,ipl,ipf,ndim_rank_north) )
+ i0max = MAXVAL( nfni_0, mask = nfproc /= -1 ) ! largest value of Ni_0 among processors (we are not sending halos)
+ ibuffsize = i0max * SUM( ipj1(:) * ipk(:) * ipl(:) ) ! use i0max because each proc must have the same buffer size
+ ALLOCATE( znorthloc(i0max, ibuffsize/i0max), znorthall(i0max, ibuffsize/i0max, ndim_rank_north) )
!
- DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ! put in znorthloc ipj j-lines of ptab
- DO jj = 1, ipj
- ij2 = jpj - ipj2 + jj ! the first ipj lines of the last ipj2 lines
+ ij1 = 0 ! initalize line index
+ DO jf = 1, kfld ; DO jl = 1, ipl(jf) ; DO jk = 1, ipk(jf)
+ DO jj = 1, ipj1(jf) ! put in znorthloc ipj1(jf) j-lines of ptab
+ ij2 = ipj(jf) - ipj2(jf) + jj ! the first ipj1 lines of the last ipj2 lines
+ ij1 = ij1 + 1
DO ji = 1, Ni_0
- ii2 = Nis0 - 1 + ji ! inner domain: Nis0 to Nie0
- znorthloc(ji,jj,jk,jl,jf) = ptab(jf)%pt4d(ii2,ij2,jk,jl)
+ ii2 = ihls(jf) + ji ! copy only the inner domain
+ znorthloc(ji,ij1) = ptab(jf)%pt4d(ii2,ij2,jk,jl)
END DO
- DO ji = Ni_0+1, i0max
- znorthloc(ji,jj,jk,jl,jf) = HUGE(0._/**/PRECISION) ! avoid sending uninitialized values (make sure we don't use it)
+ DO ji = Ni_0+1, i0max ! avoid to send uninitialized values
+ znorthloc(ji,ij1) = zhuge ! and make sure we don't use it
END DO
END DO
END DO ; END DO ; END DO
!
! start waiting time measurement
- IF( ln_timing ) CALL tic_tac(.TRUE.)
#if ! defined key_mpi_off
- CALL MPI_ALLGATHER( znorthloc, ibuffsize, MPI_TYPE, znorthglo, ibuffsize, MPI_TYPE, ncomm_north, ierr )
+ IF( ln_timing ) CALL tic_tac( .TRUE.) ! start waiting time measurement
+ ! fill znorthall with the znorthloc of each northern process
+ CALL MPI_ALLGATHER( znorthloc, ibuffsize, MPI_TYPE, znorthall, ibuffsize, MPI_TYPE, ncomm_north, ierr )
+ IF( ln_timing ) CALL tic_tac(.FALSE.) ! stop waiting time measurement
#endif
- ! stop waiting time measurement
- IF( ln_timing ) CALL tic_tac(.FALSE.)
- DEALLOCATE( znorthloc )
- ALLOCATE( ztabglo(ipf) )
- DO jf = 1, ipf
- ALLOCATE( ztabglo(jf)%pt4d(jpiglo,ipj2,ipk,ipl) )
- END DO
+ DEALLOCATE( znorthloc ) ! no more need of znorthloc
!
- ! need to fill only the first ipj lines of ztabglo as lbc_nfd don't use the last khls lines
- ijnr = 0
- DO jr = 1, jpni ! recover the global north array
- iproc = nfproc(jr)
- impp = nfimpp(jr)
- ipi = nfjpi( jr) - 2 * khls ! corresponds to Ni_0 but for subdomain iproc
- IF( iproc == -1 ) THEN ! No neighbour (land proc that was suppressed)
- !
- SELECT CASE ( kfillmode )
- CASE ( jpfillnothing ) ! no filling
- CALL ctl_stop( 'STOP', 'mpp_nfd_generic : cannot use jpfillnothing with ln_nnogather = F')
- CASE ( jpfillcopy ) ! filling with inner domain values
- DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk
- DO jj = 1, ipj
- ij2 = jpj - ipj2 + jj ! the first ipj lines of the last ipj2 lines
- DO ji = 1, ipi
- ii1 = impp + khls + ji - 1 ! corresponds to mig(khls + ji) but for subdomain iproc
- ztabglo(jf)%pt4d(ii1,jj,jk,jl) = ptab(jf)%pt4d(Nis0,ij2,jk,jl) ! chose to take the 1st inner domain point
+ DO jf = 1, kfld
+ !
+ ihsz = ihls(jf) ! shorter name
+ iisht = nn_hls - ihsz
+ ALLOCATE( ztabglo(1)%pt4d(Ni0glo+2*ihsz,ipj2(jf),ipk(jf),ipl(jf)) )
+ !
+ iFU = COUNT( (/ c_NFtype == 'F' .AND. cd_nat(jf) == 'U' /) ) ! F-folding and U grid
+ IF( iFU == 0 ) ztabglo(1)%pt4d(:,ipj2(jf)-ihsz,:,:) = zhuge ! flag off the line that is not fully modified
+ !
+ ! need to fill only the first ipj1(j) lines of ztabglo as lbc_nfd don't use the last ihsz lines
+ ijnr = 0
+ DO jr = 1, jpni ! recover the global north array using each northern process
+ iproc = nfproc(jr) ! process number
+ impp = nfimpp(jr) + ihsz ! ( = +nn_hls-iisht) ! inner domain position (without halos) of subdomain iproc
+ ipi0 = nfni_0(jr) ! Ni_0 but for subdomain iproc
+ !
+ IF( iproc == -1 ) THEN ! No neighbour (land proc that was suppressed)
+ !
+ SELECT CASE ( kfillmode )
+ CASE ( jpfillnothing ) ! no filling
+ CALL ctl_stop( 'STOP', 'mpp_nfd_generic : cannot use jpfillnothing with ln_nnogather = F')
+ CASE ( jpfillcopy ) ! filling with inner domain values
+ DO jl = 1, ipl(jf) ; DO jk = 1, ipk(jf)
+ DO jj = 1, ipj1(jf)
+ ij2 = ipj(jf) - ipj2(jf) + jj ! the first ipj1(jf) lines of the last ipj2(jf) lines
+ DO ji = 1, ipi0
+ ii1 = impp + ji - 1 ! inner iproc-subdomain in the global domain with ihsz halos
+ ztabglo(1)%pt4d(ii1,jj,jk,jl) = ptab(jf)%pt4d(ihsz+1,ij2,jk,jl) ! take the 1st inner domain point
+ END DO
END DO
- END DO
- END DO ; END DO ; END DO
- CASE ( jpfillcst ) ! filling with constant value
- DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk
- DO jj = 1, ipj
- DO ji = 1, ipi
- ii1 = impp + khls + ji - 1 ! corresponds to mig(khls + ji) but for subdomain iproc
- ztabglo(jf)%pt4d(ii1,jj,jk,jl) = pfillval
+ END DO ; END DO
+ CASE ( jpfillcst ) ! filling with constant value
+ DO jl = 1, ipl(jf) ; DO jk = 1, ipk(jf)
+ DO jj = 1, ipj1(jf)
+ DO ji = 1, ipi0
+ ii1 = impp + ji - 1 ! inner iproc-subdomain in the global domain with ihsz halos
+ ztabglo(1)%pt4d(ii1,jj,jk,jl) = pfillval
+ END DO
+ END DO
+ END DO ; END DO
+ END SELECT
+ !
+ ELSE ! use neighbour values
+ ijnr = ijnr + 1
+ ij1 = SUM( ipj1(1:jf-1) * ipk(1:jf-1) * ipl(1:jf-1) ) ! reset line offset, return 0 if jf = 1
+ DO jl = 1, ipl(jf) ; DO jk = 1, ipk(jf)
+ DO jj = 1, ipj1(jf)
+ ij1 = ij1 + 1
+ DO ji = 1, ipi0
+ ii1 = impp + ji - 1 ! inner iproc-subdomain in the global domain with ihsz halos
+ ztabglo(1)%pt4d(ii1,jj,jk,jl) = znorthall(ji, ij1, ijnr)
END DO
END DO
- END DO ; END DO ; END DO
- END SELECT
+ END DO ; END DO
+ ENDIF
!
- ELSE
- ijnr = ijnr + 1
- DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk
- DO jj = 1, ipj
- DO ji = 1, ipi
- ii1 = impp + khls + ji - 1 ! corresponds to mig(khls + ji) but for subdomain iproc
- ztabglo(jf)%pt4d(ii1,jj,jk,jl) = znorthglo(ji,jj,jk,jl,jf,ijnr)
- END DO
- END DO
- END DO ; END DO ; END DO
- ENDIF
+ END DO ! jpni
!
- END DO ! jpni
- DEALLOCATE( znorthglo )
- !
- DO jf = 1, ipf
- CALL lbc_nfd( ztabglo(jf:jf), cd_nat(jf:jf), psgn(jf:jf), khls, 1 ) ! North fold boundary condition
- DO jl = 1, ipl ; DO jk = 1, ipk ! e-w periodicity
- DO jj = 1, khls + 1
- ij1 = ipj2 - (khls + 1) + jj ! need only the last khls + 1 lines until ipj2
- ztabglo(jf)%pt4d( 1: khls,ij1,jk,jl) = ztabglo(jf)%pt4d(jpiglo-2*khls+1:jpiglo-khls,ij1,jk,jl)
- ztabglo(jf)%pt4d(jpiglo-khls+1:jpiglo,ij1,jk,jl) = ztabglo(jf)%pt4d( khls+1: 2*khls,ij1,jk,jl)
+ CALL lbc_nfd( ztabglo, cd_nat(jf:jf), psgn(jf:jf), 1 ) ! North fold boundary condition
+ !
+ DO jl = 1, ipl(jf) ; DO jk = 1, ipk(jf) ! Scatter back to ARRAY_IN
+ DO jj = 0, ihsz-1
+ ij1 = ipj( jf) - jj ! last ihsz lines
+ ij2 = ipj2(jf) - jj ! last ihsz lines
+ DO ji= 1, ipi(jf)
+ ii2 = mig(ji+iisht,ihsz) ! warning, mig is expecting local domain indices related to nn_hls
+ ptab(jf)%pt4d(ji,ij1,jk,jl) = ztabglo(1)%pt4d(ii2,ij2,jk,jl)
+ END DO
END DO
- END DO ; END DO
- END DO
- !
- DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ! Scatter back to ARRAY_IN
- DO jj = 1, khls + 1
- ij1 = jpj - (khls + 1) + jj ! last khls + 1 lines until jpj
- ij2 = ipj2 - (khls + 1) + jj ! last khls + 1 lines until ipj2
- DO ji= 1, jpi
- ii2 = mig(ji)
- ptab(jf)%pt4d(ji,ij1,jk,jl) = ztabglo(jf)%pt4d(ii2,ij2,jk,jl)
+ DO jj = ihsz, ihsz - iFU
+ ij1 = ipj( jf) - jj ! last ihsz+1 line
+ ij2 = ipj2(jf) - jj ! last ihsz+1 line
+ DO ji= 1, ipi(jf)
+ ii2 = mig(ji+iisht,ihsz) ! warning, mig is expecting local domain indices related to nn_hls
+ zztmp = ztabglo(1)%pt4d(ii2,ij2,jk,jl)
+ IF( zztmp /= zhuge ) ptab(jf)%pt4d(ji,ij1,jk,jl) = zztmp ! apply it only if it was modified by lbc_nfd
+ END DO
END DO
- END DO
- END DO ; END DO ; END DO
+ END DO ; END DO
+ !
+ DEALLOCATE( ztabglo(1)%pt4d )
+ !
+ END DO ! jf
!
- DO jf = 1, ipf
- DEALLOCATE( ztabglo(jf)%pt4d )
- END DO
- DEALLOCATE( ztabglo )
+ DEALLOCATE( znorthall )
!
ENDIF ! ln_nnogather
!
diff --git a/src/OCE/LBC/mppini.F90 b/src/OCE/LBC/mppini.F90
index b59af288e..99df2fa79 100644
--- a/src/OCE/LBC/mppini.F90
+++ b/src/OCE/LBC/mppini.F90
@@ -165,6 +165,10 @@ CONTAINS
902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nammpp in configuration namelist' )
!
nn_hls = MAX(1, nn_hls) ! nn_hls must be > 0
+# if defined key_mpi2
+ WRITE(numout,*) ' use key_mpi2, we force nn_comm = 1'
+ nn_comm = 1
+# endif
IF(lwp) THEN
WRITE(numout,*) ' Namelist nammpp'
IF( jpni < 1 .OR. jpnj < 1 ) THEN
@@ -303,7 +307,7 @@ CONTAINS
9002 FORMAT (a, i4, a)
9003 FORMAT (a, i5)
- ALLOCATE( nfimpp(jpni), nfproc(jpni), nfjpi(jpni), &
+ ALLOCATE( nfimpp(jpni), nfproc(jpni), nfjpi(jpni), nfni_0(jpni), &
& iin(jpnij), ijn(jpnij), &
& iimppt(jpni,jpnj), ijmppt(jpni,jpnj), ijpi(jpni,jpnj), ijpj(jpni,jpnj), ipproc(jpni,jpnj), &
& inei(8,jpni,jpnj), llnei(8,jpni,jpnj), &
@@ -375,7 +379,8 @@ CONTAINS
! Store informations for the north pole folding communications
nfproc(:) = ipproc(:,jpnj)
nfimpp(:) = iimppt(:,jpnj)
- nfjpi (:) = ijpi(:,jpnj)
+ nfjpi (:) = ijpi(:,jpnj) ! needed only for mpp_lbc_north_icb_generic.h90
+ nfni_0(:) = ijpi(:,jpnj) - 2 * nn_hls
!
! 3. Define Western, Eastern, Southern and Northern neighbors + corners in the subdomain grid reference
! ------------------------------------------------------------------------------------------------------
@@ -490,7 +495,7 @@ CONTAINS
!
! set default neighbours
mpinei(:) = impi(:,narea) ! should be just local but is still used in icblbc and mpp_lnk_icb_generic.h90...
- mpiSnei(0,:) = -1 ! no comm if no halo (but need it for NP Folding
+ mpiSnei(0,:) = -1 ! no comm if no halo (but still need to call the NP Folding that may modify the last line)
mpiRnei(0,:) = -1
DO jh = 1, n_hlsmax
mpiSnei(jh,:) = impi(:,narea) ! default definition
@@ -518,6 +523,7 @@ CONTAINS
!
! ! Prepare mpp north fold
!
+ l_NFold = l_NFold .AND. ANY( nfproc /= -1 ) ! make sure that we kept at least 1 proc along the last line
llmpiNFold = jpni > 1 .AND. l_NFold ! is the North fold done with an MPI communication?
l_IdoNFold = ijn(narea) == jpnj .AND. l_NFold ! is this process doing North fold?
!
@@ -1181,7 +1187,7 @@ CONTAINS
!
ALLOCATE( zmsk0(ipi,ipj), zmsk(ipi,ipj) )
zmsk0(jh+1:jh+Ni_0,jh+1:jh+Nj_0) = REAL(COUNT(lloce, dim = 3), wp) ! define inner domain -> need REAL to use lbclnk
- CALL lbc_lnk('mppini', zmsk0, 'T', 1._wp, khls = jh) ! fill halos
+ CALL lbc_lnk( ' mppini', zmsk0, 'T', 1._wp ) ! fill halos
! Beware about the mask we must use here :
DO jj = jh+1, jh+Nj_0
DO ji = jh+1, jh+Ni_0
@@ -1194,7 +1200,7 @@ CONTAINS
& + zmsk0(ji+1,jj) + zmsk0(ji,jj+1) + zmsk0(ji+1,jj+1)
END DO
END DO
- CALL lbc_lnk('mppini', zmsk, 'T', 1._wp, khls = jh) ! fill halos again!
+ CALL lbc_lnk( 'mppini', zmsk, 'T', 1._wp ) ! fill halos again!
!
iiwe = jh ; iiea = Ni_0 ! bottom-left corner - 1 of the sent data
ijso = jh ; ijno = Nj_0
@@ -1267,7 +1273,7 @@ ENDIF
! used in IOM. This works even if jpnij .ne. jpni*jpnj.
iglo( :) = (/ Ni0glo, Nj0glo /)
iloc( :) = (/ Ni_0 , Nj_0 /)
- iabsf(:) = (/ Nis0 , Njs0 /) + (/ nimpp, njmpp /) - 1 - nn_hls ! corresponds to mig0(Nis0) but mig0 is not yet defined!
+ iabsf(:) = (/ Nis0 , Njs0 /) + (/ nimpp, njmpp /) - 1 - nn_hls ! corresponds to mig(Nis0,0) but mig is not yet defined!
iabsl(:) = iabsf(:) + iloc(:) - 1
ihals(:) = (/ 0 , 0 /)
ihale(:) = (/ 0 , 0 /)
@@ -1302,10 +1308,10 @@ ENDIF
INTEGER, INTENT(in ) :: knum ! layout.dat unit
!
REAL(wp), DIMENSION(jpi,jpj,2,4) :: zinfo
- INTEGER , DIMENSION(10) :: irknei ! too many elements but safe...
+ INTEGER , DIMENSION(0:10) :: irknei ! too many elements but safe...
INTEGER :: ji, jj, jg, jn ! dummy loop indices
INTEGER :: iitmp
- LOGICAL :: lnew
+ LOGICAL :: llnew
!!----------------------------------------------------------------------
!
IF (lwp) THEN
@@ -1319,29 +1325,28 @@ ENDIF
WRITE(knum,*)
WRITE(knum,*)
WRITE(knum,*) 'Number of subdomains located along the north fold : ', ndim_rank_north
- WRITE(knum,*) 'Rank of the subdomains located along the north fold : ', ndim_rank_north
+ WRITE(knum,*) 'Rank of the subdomains located along the north fold : '
DO jn = 1, ndim_rank_north, 5
WRITE(knum,*) nrank_north( jn:MINVAL( (/jn+4,ndim_rank_north/) ) )
END DO
ENDIF
- nfd_nbnei = 0 ! defaul def (useless?)
+ nfd_nbnei = 0 ! default def (useless?)
IF( ln_nnogather ) THEN
!
! Use the "gather nfd" to know how to do the nfd: for ji point, which process send data from which of its ji-index?
! Note that nfd is perfectly symetric: I receive data from X <=> I send data to X (-> no deadlock)
!
- zinfo(:,:,:,:) = HUGE(0._wp) ! default def to make sure we don't use the halos
- DO jg = 1, 4 ! grid type: T, U, V, F
+ DO jg = 1, 4 ! grid type: T, U, V, F
DO jj = nn_hls+1, jpj-nn_hls ! inner domain (warning do_loop_substitute not yet defined)
DO ji = nn_hls+1, jpi-nn_hls ! inner domain (warning do_loop_substitute not yet defined)
- zinfo(ji,jj,1,jg) = REAL(narea, wp) ! mpi_rank + 1 (as default lbc_lnk fill is 0
+ zinfo(ji,jj,1,jg) = REAL(narea, wp) ! mpi_rank + 1 (note: lbc_lnk will put 0 if no neighbour)
zinfo(ji,jj,2,jg) = REAL(ji, wp) ! ji of this proc
END DO
END DO
END DO
!
- ln_nnogather = .FALSE. ! force "classical" North pole folding to fill all halos -> should be no more HUGE values...
+ ln_nnogather = .FALSE. ! force "classical" North pole folding to fill all halos
CALL lbc_lnk( 'mppini', zinfo(:,:,:,1), 'T', 1._wp ) ! Do 4 calls instead of 1 to save memory as the nogather version
CALL lbc_lnk( 'mppini', zinfo(:,:,:,2), 'U', 1._wp ) ! creates buffer arrays with jpiglo as the first dimension
CALL lbc_lnk( 'mppini', zinfo(:,:,:,3), 'V', 1._wp ) !
@@ -1350,24 +1355,52 @@ ENDIF
IF( l_IdoNFold ) THEN ! only the procs involed in the NFD must take care of this
- ALLOCATE( nfd_rksnd(jpi,4), nfd_jisnd(jpi,4) ) ! neighbour rand and remote ji-index for each grid (T, U, V, F)
- nfd_rksnd(:,:) = NINT( zinfo(:, jpj, 1, :) ) - 1 ! neighbour MPI rank
- nfd_jisnd(:,:) = NINT( zinfo(:, jpj, 2, :) ) - nn_hls ! neighbour ji index (shifted as we don't send the halos)
- WHERE( nfd_rksnd == -1 ) nfd_jisnd = 1 ! use ji=1 if no neighbour, see mpp_nfd_generic.h90
-
- nfd_nbnei = 1 ! Number of neighbour sending data for the nfd. We have at least 1 neighbour!
- irknei(1) = nfd_rksnd(1,1) ! which is the 1st one (I can be neighbour of myself, exclude land-proc are also ok)
+ ALLOCATE( nfd_rksnd(jpi,nn_hls+1,4), nfd_jisnd(jpi,nn_hls+1,4), lnfd_same(jpi,4) )
+ nfd_rksnd(:,:,:) = NINT( zinfo(:,jpj-nn_hls:jpj,1,:) ) - 1 ! neighbour MPI rank (-1 means no neighbour)
+ ! Use some tricks for mpp_nfd_generic.h90:
+ ! 1) neighbour ji index (shifted as we don't send the halos)
+ nfd_jisnd(:,:,:) = NINT( zinfo(:,jpj-nn_hls:jpj,2,:) ) - nn_hls
+ ! 2) use ji=1 if no neighbour
+ WHERE( nfd_rksnd == -1 ) nfd_jisnd = 1
+ ! 3) control which points must be modified by the NP folding on line jpjglo-nn_hls
+ lnfd_same(:,:) = .TRUE.
+ IF( c_NFtype == 'T' ) THEN
+ lnfd_same(mi0(jpiglo/2+2,nn_hls):mi1(jpiglo-nn_hls,nn_hls), 1) = .FALSE.
+ lnfd_same(mi0(jpiglo/2+1,nn_hls):mi1(jpiglo-nn_hls,nn_hls), 2) = .FALSE.
+ lnfd_same(mi0( nn_hls+1,nn_hls):mi1(jpiglo-nn_hls,nn_hls),3:4) = .FALSE.
+ IF( l_Iperio ) THEN ! in case the ew-periodicity was done before calling the NP folding
+ lnfd_same(mi0( 1,nn_hls):mi1(nn_hls,nn_hls),1:4) = .FALSE.
+ lnfd_same(mi0(jpiglo-nn_hls+1,nn_hls):mi1(jpiglo,nn_hls),3:4) = .FALSE.
+ ENDIF
+ ELSEIF( c_NFtype == 'F' ) THEN
+ lnfd_same(mi0(jpiglo/2+1 ,nn_hls):mi1(jpiglo/2+1 ,nn_hls),1) = .FALSE.
+ lnfd_same(mi0(jpiglo-nn_hls,nn_hls):mi1(jpiglo-nn_hls ,nn_hls),1) = .FALSE.
+ lnfd_same(mi0(jpiglo/2+1 ,nn_hls):mi1(jpiglo-nn_hls ,nn_hls),3) = .FALSE.
+ lnfd_same(mi0(jpiglo/2+1 ,nn_hls):mi1(jpiglo-nn_hls-1,nn_hls),4) = .FALSE.
+ IF( l_Iperio ) THEN ! in case the ew-periodicity was done before calling the NP folding
+ lnfd_same(mi0(nn_hls,nn_hls):mi1(nn_hls ,nn_hls),1) = .FALSE.
+ lnfd_same(mi0( 1,nn_hls):mi1(nn_hls ,nn_hls),3) = .FALSE.
+ IF( nn_hls > 1 ) lnfd_same(mi0( 1,nn_hls):mi1(nn_hls-1,nn_hls),4) = .FALSE.
+ ENDIF
+ ENDIF
+ WHERE( lnfd_same ) nfd_jisnd(:,1,:) = HUGE(0) ! make sure we dont use it
+
+ nfd_nbnei = 0
+ irknei(0) = HUGE(0)
DO jg = 1, 4
- DO ji = 1, jpi ! we must be able to fill the full line including halos
- lnew = .TRUE. ! new neighbour?
- DO jn = 1, nfd_nbnei
- IF( irknei(jn) == nfd_rksnd(ji,jg) ) lnew = .FALSE. ! already found
+ DO jj = 1, nn_hls+1
+ DO ji = 1, jpi ! we must be able to fill the full line including halos
+ IF( jj == 1 .AND. lnfd_same(ji,jg) ) CYCLE
+ llnew = .TRUE. ! new neighbour?
+ DO jn = 0, nfd_nbnei
+ IF( irknei(jn) == nfd_rksnd(ji,jj,jg) ) llnew = .FALSE. ! already found
+ END DO
+ IF( llnew ) THEN
+ jn = nfd_nbnei + 1
+ nfd_nbnei = jn
+ irknei(jn) = nfd_rksnd(ji,jj,jg)
+ ENDIF
END DO
- IF( lnew ) THEN
- jn = nfd_nbnei + 1
- nfd_nbnei = jn
- irknei(jn) = nfd_rksnd(ji,jg)
- ENDIF
END DO
END DO
@@ -1375,14 +1408,20 @@ ENDIF
nfd_rknei(:) = irknei(1:nfd_nbnei)
! re-number nfd_rksnd according to the indexes of nfd_rknei
DO jg = 1, 4
- DO ji = 1, jpi
- iitmp = nfd_rksnd(ji,jg) ! must store a copy of nfd_rksnd(ji,jg) to make sure we don't change it twice
- DO jn = 1, nfd_nbnei
- IF( iitmp == nfd_rknei(jn) ) nfd_rksnd(ji,jg) = jn
+ DO jj = 1, nn_hls+1
+ DO ji = 1, jpi
+ IF( jj == 1 .AND. lnfd_same(ji,jg) ) THEN
+ nfd_rksnd(ji,jj,jg) = HUGE(0) ! make sure we don't use it
+ ELSE
+ iitmp = nfd_rksnd(ji,jj,jg) ! must store a copy of nfd_rksnd(ji,jj,jg) so we don't change it twice
+ DO jn = 1, nfd_nbnei
+ IF( iitmp == nfd_rknei(jn) ) nfd_rksnd(ji,jj,jg) = jn
+ END DO
+ ENDIF
END DO
END DO
END DO
-
+
IF( ldwrtlay ) THEN
WRITE(knum,*)
WRITE(knum,*) 'north fold exchanges with explicit point-to-point messaging :'
@@ -1437,38 +1476,74 @@ ENDIF
!!
!! ** Method :
!!
- !! ** Action : - mig , mjg : local domain indices ==> global domain, including halos, indices
- !! - mig0, mjg0: local domain indices ==> global domain, excluding halos, indices
+ !! Local domain indices: Same values for the same point, different upper/lower bounds
+ !! e.g. with nn_hls = 2
+ !! jh = 0 x,x,3,...,jpi-2, x, x
+ !! jh = 1 x,2,3,...,jpi-2,jpi-1, x
+ !! jh = 2 1,2,3,...,jpi-2,jpi-1,jpi
+ !!
+ !! or jh = 0 x,x,3,...,Ni_0+2, x, x
+ !! jh = 1 x,2,3,...,Ni_0+2,Ni_0+3, x
+ !! jh = 2 1,2,3,...,Ni_0+2,Ni_0+3,Ni_0+4
+ !!
+ !! Global domain indices: different values for the same point, all starts at 1
+ !! e.g. with nn_hls = 2
+ !! jh = 0 1,2,3, ...,jpiglo-4, x, x,x,x
+ !! jh = 1 1,2,3, ...,jpiglo-4,jpiglo-3,jpiglo-2, x,x
+ !! jh = 2 1,2,3,...,jpiglo-4,jpiglo-3,jpiglo-2,jpiglo-1,jpiglo
+ !!
+ !! or jh = 0 1,2,3, ...,Ni0glo , x, x,x,x
+ !! jh = 1 1,2,3, ...,Ni0glo ,Ni0glo+1,Ni0glo+2, x,x
+ !! jh = 2 1,2,3,...,Ni0glo,Ni0glo+1,Ni0glo+2,Ni0glo+3,Ni0glo+4
+ !! ^
+ !! |
+ !! |
+ !! iimpp
+ !!
+ !! ** Action : - mig , mjg : local domain indices ==> global domain indices
!! - mi0 , mi1 : global domain indices ==> local domain indices
!! - mj0 , mj1 (if global point not in the local domain ==> mi0>mi1 and/or mj0>mj1)
!!----------------------------------------------------------------------
- INTEGER :: ji, jj ! dummy loop argument
+ INTEGER :: ji, jj, jh ! dummy loop argument
+ INTEGER :: ipi, ipj, ipiglo, ipjglo, iimpp, ijmpp, ishft
!!----------------------------------------------------------------------
!
- ALLOCATE( mig(jpi), mjg(jpj), mig0(jpi), mjg0(jpj) )
- ALLOCATE( mi0(jpiglo), mi1(jpiglo), mj0(jpjglo), mj1(jpjglo) )
+ ALLOCATE( mig(jpi , 0:nn_hls), mjg(jpj , 0:nn_hls) )
+ ALLOCATE( mi0(jpiglo, 0:nn_hls), mi1(jpiglo, 0:nn_hls), mj0(jpjglo, 0:nn_hls), mj1(jpjglo, 0:nn_hls) )
!
- DO ji = 1, jpi ! local domain indices ==> global domain indices, including halos
- mig(ji) = ji + nimpp - 1
- END DO
- DO jj = 1, jpj
- mjg(jj) = jj + njmpp - 1
- END DO
- ! ! local domain indices ==> global domain indices, excluding halos
- !
- mig0(:) = mig(:) - nn_hls
- mjg0(:) = mjg(:) - nn_hls
- ! ! global domain, including halos, indices ==> local domain indices
- ! ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the
- ! ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain.
- DO ji = 1, jpiglo
- mi0(ji) = MAX( 1 , MIN( ji - nimpp + 1, jpi+1 ) )
- mi1(ji) = MAX( 0 , MIN( ji - nimpp + 1, jpi ) )
- END DO
- DO jj = 1, jpjglo
- mj0(jj) = MAX( 1 , MIN( jj - njmpp + 1, jpj+1 ) )
- mj1(jj) = MAX( 0 , MIN( jj - njmpp + 1, jpj ) )
- END DO
+ DO jh = 0, nn_hls
+ !
+ ishft = nn_hls - jh
+ !
+ ipi = Ni_0 + 2*jh ; ipj = Nj_0 + 2*jh
+ ipiglo = Ni0glo + 2*jh ; ipjglo = Nj0glo + 2*jh
+ iimpp = nimpp - ishft ; ijmpp = njmpp - ishft
+ !
+ ! local domain indices ==> global domain indices, including jh halos
+ !
+ DO ji = ishft + 1, ishft + ipi
+ mig(ji,jh) = ji + iimpp - 1
+ END DO
+ !
+ DO jj = ishft + 1, ishft + ipj
+ mjg(jj,jh) = jj + ijmpp - 1
+ END DO
+ !
+ ! global domain, including jh halos, indices ==> local domain indices
+ ! return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the
+ ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain.
+ !
+ DO ji = 1, ipiglo
+ mi0(ji,jh) = MAX( 1 , MIN( ji - iimpp + 1, ipi+ishft+1 ) )
+ mi1(ji,jh) = MAX( 0 , MIN( ji - iimpp + 1, ipi+ishft ) )
+ END DO
+ !
+ DO jj = 1, ipjglo
+ mj0(jj,jh) = MAX( 1 , MIN( jj - ijmpp + 1, ipj+ishft+1 ) )
+ mj1(jj,jh) = MAX( 0 , MIN( jj - ijmpp + 1, ipj+ishft ) )
+ END DO
+ !
+ END DO ! jh
!
END SUBROUTINE init_locglo
diff --git a/src/OCE/OBS/mpp_map.F90 b/src/OCE/OBS/mpp_map.F90
index 5a4007df1..553a36446 100644
--- a/src/OCE/OBS/mpp_map.F90
+++ b/src/OCE/OBS/mpp_map.F90
@@ -10,8 +10,8 @@ MODULE mpp_map
!! mppmap_init : Initialize mppmap.
!!----------------------------------------------------------------------
USE par_kind, ONLY : wp ! Precision variables
- USE par_oce , ONLY : jpi, jpj, Nis0, Nie0, Njs0, Nje0 ! Ocean parameters
- USE dom_oce , ONLY : mig, mjg, narea ! Ocean space and time domain variables
+ USE par_oce , ONLY : jpi, jpj, Nis0, Nie0, Njs0, Nje0, nn_hls ! Ocean parameters
+ USE dom_oce , ONLY : mig, mjg, narea ! Ocean space and time domain variables
#if ! defined key_mpi_off
USE lib_mpp , ONLY : mpi_comm_oce ! MPP library
#endif
@@ -64,7 +64,7 @@ INCLUDE 'mpif.h'
imppmap(:,:) = 0
! ! Setup local grid points
- imppmap(mig(1):mig(jpi),mjg(1):mjg(jpj)) = narea
+ imppmap(mig(1,nn_hls):mig(jpi,nn_hls),mjg(1,nn_hls):mjg(jpj,nn_hls)) = narea
! Get global data
diff --git a/src/OCE/OBS/obs_grd_bruteforce.h90 b/src/OCE/OBS/obs_grd_bruteforce.h90
index 5a41fa312..5df8b26c7 100644
--- a/src/OCE/OBS/obs_grd_bruteforce.h90
+++ b/src/OCE/OBS/obs_grd_bruteforce.h90
@@ -111,9 +111,9 @@
zmskg(:,:) = -1.e+10
DO jj = kldj, klej
DO ji = kldi, klei
- zlamg(mig(ji),mjg(jj)) = pglam(ji,jj)
- zphig(mig(ji),mjg(jj)) = pgphi(ji,jj)
- zmskg(mig(ji),mjg(jj)) = pmask(ji,jj)
+ zlamg(mig(ji,nn_hls),mjg(jj,nn_hls)) = pglam(ji,jj)
+ zphig(mig(ji,nn_hls),mjg(jj,nn_hls)) = pgphi(ji,jj)
+ zmskg(mig(ji,nn_hls),mjg(jj,nn_hls)) = pmask(ji,jj)
END DO
END DO
CALL mpp_global_max( zlamg )
diff --git a/src/OCE/OBS/obs_grid.F90 b/src/OCE/OBS/obs_grid.F90
index 715741623..b9c7554c4 100644
--- a/src/OCE/OBS/obs_grid.F90
+++ b/src/OCE/OBS/obs_grid.F90
@@ -280,9 +280,9 @@ CONTAINS
! Add various grids here.
DO jj = 1, jpj
DO ji = 1, jpi
- zlamg(mig(ji),mjg(jj)) = glamt(ji,jj)
- zphig(mig(ji),mjg(jj)) = gphit(ji,jj)
- zmskg(mig(ji),mjg(jj)) = tmask(ji,jj,1)
+ zlamg(mig(ji,nn_hls),mjg(jj,nn_hls)) = glamt(ji,jj)
+ zphig(mig(ji,nn_hls),mjg(jj,nn_hls)) = gphit(ji,jj)
+ zmskg(mig(ji,nn_hls),mjg(jj,nn_hls)) = tmask(ji,jj,1)
END DO
END DO
CALL mpp_global_max( zlamg )
diff --git a/src/OCE/OBS/obs_inter_sup.F90 b/src/OCE/OBS/obs_inter_sup.F90
index d8116276d..084830e1d 100644
--- a/src/OCE/OBS/obs_inter_sup.F90
+++ b/src/OCE/OBS/obs_inter_sup.F90
@@ -279,8 +279,8 @@ CONTAINS
! Pack interpolation data to be sent
DO ji = 1, itot
- ii = mi1(igrdij_recv(2*ji-1))
- ij = mj1(igrdij_recv(2*ji))
+ ii = mi1(igrdij_recv(2*ji-1),nn_hls)
+ ij = mj1(igrdij_recv(2*ji ),nn_hls)
DO jk = 1, kpk
zsend(jk,ji) = pval(ii,ij,jk)
END DO
diff --git a/src/OCE/OBS/obs_write.F90 b/src/OCE/OBS/obs_write.F90
index 1b44338d0..d0c0eda8c 100644
--- a/src/OCE/OBS/obs_write.F90
+++ b/src/OCE/OBS/obs_write.F90
@@ -245,8 +245,8 @@ CONTAINS
fbdata%iobsi(jo,jvar) = profdata%mi(jo,jvar)
fbdata%iobsj(jo,jvar) = profdata%mj(jo,jvar)
ELSE
- fbdata%iobsi(jo,jvar) = mig(profdata%mi(jo,jvar))
- fbdata%iobsj(jo,jvar) = mjg(profdata%mj(jo,jvar))
+ fbdata%iobsi(jo,jvar) = mig(profdata%mi(jo,jvar),nn_hls)
+ fbdata%iobsj(jo,jvar) = mjg(profdata%mj(jo,jvar),nn_hls)
ENDIF
END DO
CALL greg2jul( 0, &
@@ -511,8 +511,8 @@ CONTAINS
fbdata%iobsi(jo,1) = surfdata%mi(jo)
fbdata%iobsj(jo,1) = surfdata%mj(jo)
ELSE
- fbdata%iobsi(jo,1) = mig(surfdata%mi(jo))
- fbdata%iobsj(jo,1) = mjg(surfdata%mj(jo))
+ fbdata%iobsi(jo,1) = mig(surfdata%mi(jo),nn_hls)
+ fbdata%iobsj(jo,1) = mjg(surfdata%mj(jo),nn_hls)
ENDIF
CALL greg2jul( 0, &
& surfdata%nmin(jo), &
diff --git a/src/OCE/SBC/cpl_oasis3.F90 b/src/OCE/SBC/cpl_oasis3.F90
index 091ce6873..b86deba54 100644
--- a/src/OCE/SBC/cpl_oasis3.F90
+++ b/src/OCE/SBC/cpl_oasis3.F90
@@ -171,11 +171,11 @@ CONTAINS
! ... Define the partition, excluding halos as we don't want them to be "seen" by oasis
! -----------------------------------------------------------------
- paral(1) = 2 ! box partitioning
- paral(2) = Ni0glo * mjg0(nn_hls) + mig0(nn_hls) ! NEMO lower left corner global offset, without halos
- paral(3) = Ni_0 ! local extent in i, excluding halos
- paral(4) = Nj_0 ! local extent in j, excluding halos
- paral(5) = Ni0glo ! global extent in x, excluding halos
+ paral(1) = 2 ! box partitioning
+ paral(2) = Ni0glo * mjg(nn_hls,0) + mig(nn_hls,0) ! NEMO lower left corner global offset, without halos
+ paral(3) = Ni_0 ! local extent in i, excluding halos
+ paral(4) = Nj_0 ! local extent in j, excluding halos
+ paral(5) = Ni0glo ! global extent in x, excluding halos
IF( sn_cfctl%l_oasout ) THEN
WRITE(numout,*) ' multiexchg: paral (1:5)', paral
diff --git a/src/OCE/SBC/sbccpl.F90 b/src/OCE/SBC/sbccpl.F90
index dc41fe2a8..64d77b504 100644
--- a/src/OCE/SBC/sbccpl.F90
+++ b/src/OCE/SBC/sbccpl.F90
@@ -1052,7 +1052,7 @@ CONTAINS
xcplmask(:,:,:) = 0.
CALL iom_open( 'cplmask', inum )
CALL iom_get( inum, jpdom_unknown, 'cplmask', xcplmask(1:jpi,1:jpj,1:nn_cplmodel), &
- & kstart = (/ mig(1),mjg(1),1 /), kcount = (/ jpi,jpj,nn_cplmodel /) )
+ & kstart = (/ mig(1,nn_hls),mjg(1,nn_hls),1 /), kcount = (/ jpi,jpj,nn_cplmodel /) )
CALL iom_close( inum )
ELSE
xcplmask(:,:,:) = 1.
diff --git a/src/OCE/USR/usrdef_fmask.F90 b/src/OCE/USR/usrdef_fmask.F90
index bc97a2edf..d1e0d4825 100644
--- a/src/OCE/USR/usrdef_fmask.F90
+++ b/src/OCE/USR/usrdef_fmask.F90
@@ -69,25 +69,25 @@ CONTAINS
IF(lwp) WRITE(numout,*) ' Gibraltar '
ij0 = 101 + nn_hls ; ij1 = 101 + nn_hls ! Gibraltar strait : partial slip (pfmsk=0.5)
ii0 = 139 + nn_hls - 1 ; ii1 = 140 + nn_hls - 1
- pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 0.5_wp
+ pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls) , mj0(ij0,nn_hls):mj1(ij1,nn_hls) , 1:jpk ) = 0.5_wp
ij0 = 102 + nn_hls ; ij1 = 102 + nn_hls
ii0 = 139 + nn_hls - 1 ; ii1 = 140 + nn_hls - 1
- pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 0.5_wp
+ pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls) , mj0(ij0,nn_hls):mj1(ij1,nn_hls) , 1:jpk ) = 0.5_wp
!
IF(lwp) WRITE(numout,*) ' Bab el Mandeb '
ij0 = 87 + nn_hls ; ij1 = 88 + nn_hls ! Bab el Mandeb : partial slip (pfmsk=1)
ii0 = 160 + nn_hls - 1 ; ii1 = 160 + nn_hls - 1
- pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 1._wp
+ pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls) , mj0(ij0,nn_hls):mj1(ij1,nn_hls) , 1:jpk ) = 1._wp
ij0 = 88 + nn_hls ; ij1 = 88 + nn_hls
ii0 = 159 + nn_hls - 1 ; ii1 = 159 + nn_hls - 1
- pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 1._wp
+ pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls) , mj0(ij0,nn_hls):mj1(ij1,nn_hls) , 1:jpk ) = 1._wp
!
! We keep this as an example but it is instable in this case
!IF(lwp) WRITE(numout,*) ' Danish straits '
! ij0 = 115 ; ij1 = 115 ! Danish straits : strong slip (pfmsk > 2)
- ! ii0 = 145 ; ii1 = 146 ; pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 4._wp
+ ! ii0 = 145 ; ii1 = 146 ; pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls) , mj0(ij0,nn_hls):mj1(ij1,nn_hls) , 1:jpk ) = 4._wp
! ij0 = 116 ; ij1 = 116
- ! ii0 = 145 ; ii1 = 146 ; pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 4._wp
+ ! ii0 = 145 ; ii1 = 146 ; pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls) , mj0(ij0,nn_hls):mj1(ij1,nn_hls) , 1:jpk ) = 4._wp
!
CASE( 1 ) ! R1 case
IF(lwp) WRITE(numout,*)
@@ -104,42 +104,42 @@ CONTAINS
IF(lwp) WRITE(numout,*) ' Gibraltar '
ii0 = 282 + nn_hls - 1 ; ii1 = 283 + nn_hls - 1 ! Gibraltar Strait
ij0 = 241 + nn_hls - isrow ; ij1 = 241 + nn_hls - isrow
- pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp
+ pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls),mj0(ij0,nn_hls):mj1(ij1,nn_hls),1:jpk ) = 2._wp
!
IF(lwp) WRITE(numout,*) ' Bhosporus '
ii0 = 314 + nn_hls - 1 ; ii1 = 315 + nn_hls - 1 ! Bhosporus Strait
ij0 = 248 + nn_hls - isrow ; ij1 = 248 + nn_hls - isrow
- pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp
+ pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls),mj0(ij0,nn_hls):mj1(ij1,nn_hls),1:jpk ) = 2._wp
!
IF(lwp) WRITE(numout,*) ' Makassar (Top) '
ii0 = 48 + nn_hls - 1 ; ii1 = 48 + nn_hls - 1 ! Makassar Strait (Top)
ij0 = 189 + nn_hls - isrow ; ij1 = 190 + nn_hls - isrow
- pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp
+ pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls),mj0(ij0,nn_hls):mj1(ij1,nn_hls),1:jpk ) = 3._wp
!
IF(lwp) WRITE(numout,*) ' Lombok '
ii0 = 44 + nn_hls - 1 ; ii1 = 44 + nn_hls - 1 ! Lombok Strait
ij0 = 164 + nn_hls - isrow ; ij1 = 165 + nn_hls - isrow
- pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp
+ pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls),mj0(ij0,nn_hls):mj1(ij1,nn_hls),1:jpk ) = 2._wp
!
IF(lwp) WRITE(numout,*) ' Ombai '
ii0 = 53 + nn_hls - 1 ; ii1 = 53 + nn_hls - 1 ! Ombai Strait
ij0 = 164 + nn_hls - isrow ; ij1 = 165 + nn_hls - isrow
- pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp
+ pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls),mj0(ij0,nn_hls):mj1(ij1,nn_hls),1:jpk ) = 2._wp
!
IF(lwp) WRITE(numout,*) ' Timor Passage '
ii0 = 56 + nn_hls - 1 ; ii1 = 56 + nn_hls - 1 ! Timor Passage
ij0 = 164 + nn_hls - isrow ; ij1 = 165 + nn_hls - isrow
- pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp
+ pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls),mj0(ij0,nn_hls):mj1(ij1,nn_hls),1:jpk ) = 2._wp
!
IF(lwp) WRITE(numout,*) ' West Halmahera '
ii0 = 58 + nn_hls - 1 ; ii1 = 58 + nn_hls - 1 ! West Halmahera Strait
ij0 = 181 + nn_hls - isrow ; ij1 = 182 + nn_hls - isrow
- pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp
+ pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls),mj0(ij0,nn_hls):mj1(ij1,nn_hls),1:jpk ) = 3._wp
!
IF(lwp) WRITE(numout,*) ' East Halmahera '
ii0 = 55 + nn_hls - 1 ; ii1 = 55 + nn_hls - 1 ! East Halmahera Strait
ij0 = 181 + nn_hls - isrow ; ij1 = 182 + nn_hls - isrow
- pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp
+ pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls),mj0(ij0,nn_hls):mj1(ij1,nn_hls),1:jpk ) = 3._wp
!
CASE DEFAULT
IF(lwp) WRITE(numout,*)
diff --git a/src/OCE/USR/usrdef_hgr.F90 b/src/OCE/USR/usrdef_hgr.F90
index 2f617b552..cbcb3ff8e 100644
--- a/src/OCE/USR/usrdef_hgr.F90
+++ b/src/OCE/USR/usrdef_hgr.F90
@@ -115,8 +115,8 @@ CONTAINS
ENDIF
!
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- zim1 = REAL( mig0(ji), wp ) - 1. ; zim05 = REAL( mig0(ji), wp ) - 1.5
- zjm1 = REAL( mjg0(jj), wp ) - 1. ; zjm05 = REAL( mjg0(jj), wp ) - 1.5
+ zim1 = REAL( mig(ji,0), wp ) - 1. ; zim05 = REAL( mig(ji,0), wp ) - 1.5
+ zjm1 = REAL( mjg(jj,0), wp ) - 1. ; zjm05 = REAL( mjg(jj,0), wp ) - 1.5
!
!glamt(i,j) longitude at T-point
!gphit(i,j) latitude at T-point
diff --git a/src/OCE/lib_fortran.F90 b/src/OCE/lib_fortran.F90
index b621373e6..2a0e1eeda 100644
--- a/src/OCE/lib_fortran.F90
+++ b/src/OCE/lib_fortran.F90
@@ -191,11 +191,11 @@ CONTAINS
! work over the whole domain (guarantees all internal cells are set when nn_hls=2)
!
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- IF( MOD(mig(ji), 3) == MOD(nn_hls, 3) .AND. & ! 1st bottom left corner always at (Nis0-1, Njs0-1)
- & MOD(mjg(jj), 3) == MOD(nn_hls, 3) ) THEN ! bottom left corner of a 3x3 box
- ji2 = MIN(mig(ji)+2, jpiglo) - nimpp + 1 ! right position of the box
- jj2 = MIN(mjg(jj)+2, jpjglo) - njmpp + 1 ! upper position of the box
- IF( ji2 <= jpi .AND. jj2 <= jpj ) THEN ! the box is fully included in the local mpi domain
+ IF( MOD(mig(ji,nn_hls), 3) == MOD(nn_hls, 3) .AND. & ! 1st bottom left corner always at (Nis0-1, Njs0-1)
+ & MOD(mjg(jj,nn_hls), 3) == MOD(nn_hls, 3) ) THEN ! bottom left corner of a 3x3 box
+ ji2 = MIN(mig(ji,nn_hls)+2, jpiglo) - nimpp + 1 ! right position of the box
+ jj2 = MIN(mjg(jj,nn_hls)+2, jpjglo) - njmpp + 1 ! upper position of the box
+ IF( ji2 <= jpi .AND. jj2 <= jpj ) THEN ! the box is fully included in the local mpi domain
p2d(ji:ji2,jj:jj2) = SUM(p2d(ji:ji2,jj:jj2))
ENDIF
ENDIF
@@ -203,23 +203,23 @@ CONTAINS
CALL lbc_lnk( 'lib_fortran', p2d, 'T', 1.0_wp )
! no need for 2nd exchange when nn_hls > 1
IF( nn_hls == 1 ) THEN
- IF( mpiRnei(nn_hls,jpwe) > -1 ) THEN ! 1st column was changed during the previous call to lbc_lnk
- IF( MOD(mig( 1), 3) == 1 ) & ! 1st box start at i=1 -> column 1 to 3 correctly computed locally
- p2d( 1,:) = p2d( 2,:) ! previous lbc_lnk corrupted column 1 -> put it back using column 2
- IF( MOD(mig( 1), 3) == 2 ) & ! 1st box start at i=3 -> column 1 and 2 correctly computed on west neighbourh
- p2d( 2,:) = p2d( 1,:) ! previous lbc_lnk fix column 1 -> copy it to column 2
+ IF( mpiRnei(nn_hls,jpwe) > -1 ) THEN ! 1st column was changed during the previous call to lbc_lnk
+ IF( MOD(mig( 1,nn_hls), 3) == 1 ) & ! 1st box start at i=1 -> column 1 to 3 correctly computed locally
+ p2d( 1,:) = p2d( 2,:) ! previous lbc_lnk corrupted column 1 -> put it back using column 2
+ IF( MOD(mig( 1,nn_hls), 3) == 2 ) & ! 1st box start at i=3 -> column 1 and 2 correctly computed on w-neighbourh
+ p2d( 2,:) = p2d( 1,:) ! previous lbc_lnk fix column 1 -> copy it to column 2
ENDIF
IF( mpiRnei(nn_hls,jpea) > -1 ) THEN
- IF( MOD(mig(jpi-2), 3) == 1 ) p2d( jpi,:) = p2d(jpi-1,:)
- IF( MOD(mig(jpi-2), 3) == 0 ) p2d(jpi-1,:) = p2d( jpi,:)
+ IF( MOD(mig(jpi-2,nn_hls), 3) == 1 ) p2d( jpi,:) = p2d(jpi-1,:)
+ IF( MOD(mig(jpi-2,nn_hls), 3) == 0 ) p2d(jpi-1,:) = p2d( jpi,:)
ENDIF
IF( mpiRnei(nn_hls,jpso) > -1 ) THEN
- IF( MOD(mjg( 1), 3) == 1 ) p2d(:, 1) = p2d(:, 2)
- IF( MOD(mjg( 1), 3) == 2 ) p2d(:, 2) = p2d(:, 1)
+ IF( MOD(mjg( 1,nn_hls), 3) == 1 ) p2d(:, 1) = p2d(:, 2)
+ IF( MOD(mjg( 1,nn_hls), 3) == 2 ) p2d(:, 2) = p2d(:, 1)
ENDIF
IF( mpiRnei(nn_hls,jpno) > -1 ) THEN
- IF( MOD(mjg(jpj-2), 3) == 1 ) p2d(:, jpj) = p2d(:,jpj-1)
- IF( MOD(mjg(jpj-2), 3) == 0 ) p2d(:,jpj-1) = p2d(:, jpj)
+ IF( MOD(mjg(jpj-2,nn_hls), 3) == 1 ) p2d(:, jpj) = p2d(:,jpj-1)
+ IF( MOD(mjg(jpj-2,nn_hls), 3) == 0 ) p2d(:,jpj-1) = p2d(:, jpj)
ENDIF
CALL lbc_lnk( 'lib_fortran', p2d, 'T', 1.0_wp )
ENDIF
@@ -247,11 +247,11 @@ CONTAINS
! work over the whole domain (guarantees all internal cells are set when nn_hls=2)
!
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- IF( MOD(mig(ji), 3) == MOD(nn_hls, 3) .AND. & ! 1st bottom left corner always at (Nis0-1, Njs0-1)
- & MOD(mjg(jj), 3) == MOD(nn_hls, 3) ) THEN ! bottom left corner of a 3x3 box
- ji2 = MIN(mig(ji)+2, jpiglo) - nimpp + 1 ! right position of the box
- jj2 = MIN(mjg(jj)+2, jpjglo) - njmpp + 1 ! upper position of the box
- IF( ji2 <= jpi .AND. jj2 <= jpj ) THEN ! the box is fully included in the local mpi domain
+ IF( MOD(mig(ji,nn_hls), 3) == MOD(nn_hls, 3) .AND. & ! 1st bottom left corner always at (Nis0-1, Njs0-1)
+ & MOD(mjg(jj,nn_hls), 3) == MOD(nn_hls, 3) ) THEN ! bottom left corner of a 3x3 box
+ ji2 = MIN(mig(ji,nn_hls)+2, jpiglo) - nimpp + 1 ! right position of the box
+ jj2 = MIN(mjg(jj,nn_hls)+2, jpjglo) - njmpp + 1 ! upper position of the box
+ IF( ji2 <= jpi .AND. jj2 <= jpj ) THEN ! the box is fully included in the local mpi domain
p3d(ji:ji2,jj:jj2,jn) = SUM(p3d(ji:ji2,jj:jj2,jn))
ENDIF
ENDIF
@@ -260,23 +260,23 @@ CONTAINS
CALL lbc_lnk( 'lib_fortran', p3d, 'T', 1.0_wp )
! no need for 2nd exchange when nn_hls > 1
IF( nn_hls == 1 ) THEN
- IF( mpiRnei(nn_hls,jpwe) > -1 ) THEN ! 1st column was changed during the previous call to lbc_lnk
- IF( MOD(mig( 1), 3) == 1 ) & ! 1st box start at i=1 -> column 1 to 3 correctly computed locally
- p3d( 1,:,:) = p3d( 2,:,:) ! previous lbc_lnk corrupted column 1 -> put it back using column 2
- IF( MOD(mig( 1), 3) == 2 ) & ! 1st box start at i=3 -> column 1 and 2 correctly computed on west neighbourh
- p3d( 2,:,:) = p3d( 1,:,:) ! previous lbc_lnk fix column 1 -> copy it to column 2
+ IF( mpiRnei(nn_hls,jpwe) > -1 ) THEN ! 1st column was changed during the previous call to lbc_lnk
+ IF( MOD(mig( 1,nn_hls), 3) == 1 ) & ! 1st box start at i=1 -> column 1 to 3 correctly computed locally
+ p3d( 1,:,:) = p3d( 2,:,:) ! previous lbc_lnk corrupted column 1 -> put it back using column 2
+ IF( MOD(mig( 1,nn_hls), 3) == 2 ) & ! 1st box start at i=3 -> column 1 and 2 correctly computed on w-neighbourh
+ p3d( 2,:,:) = p3d( 1,:,:) ! previous lbc_lnk fix column 1 -> copy it to column 2
ENDIF
IF( mpiRnei(nn_hls,jpea) > -1 ) THEN
- IF( MOD(mig(jpi-2), 3) == 1 ) p3d( jpi,:,:) = p3d(jpi-1,:,:)
- IF( MOD(mig(jpi-2), 3) == 0 ) p3d(jpi-1,:,:) = p3d( jpi,:,:)
+ IF( MOD(mig(jpi-2,nn_hls), 3) == 1 ) p3d( jpi,:,:) = p3d(jpi-1,:,:)
+ IF( MOD(mig(jpi-2,nn_hls), 3) == 0 ) p3d(jpi-1,:,:) = p3d( jpi,:,:)
ENDIF
IF( mpiRnei(nn_hls,jpso) > -1 ) THEN
- IF( MOD(mjg( 1), 3) == 1 ) p3d(:, 1,:) = p3d(:, 2,:)
- IF( MOD(mjg( 1), 3) == 2 ) p3d(:, 2,:) = p3d(:, 1,:)
+ IF( MOD(mjg( 1,nn_hls), 3) == 1 ) p3d(:, 1,:) = p3d(:, 2,:)
+ IF( MOD(mjg( 1,nn_hls), 3) == 2 ) p3d(:, 2,:) = p3d(:, 1,:)
ENDIF
IF( mpiRnei(nn_hls,jpno) > -1 ) THEN
- IF( MOD(mjg(jpj-2), 3) == 1 ) p3d(:, jpj,:) = p3d(:,jpj-1,:)
- IF( MOD(mjg(jpj-2), 3) == 0 ) p3d(:,jpj-1,:) = p3d(:, jpj,:)
+ IF( MOD(mjg(jpj-2,nn_hls), 3) == 1 ) p3d(:, jpj,:) = p3d(:,jpj-1,:)
+ IF( MOD(mjg(jpj-2,nn_hls), 3) == 0 ) p3d(:,jpj-1,:) = p3d(:, jpj,:)
ENDIF
CALL lbc_lnk( 'lib_fortran', p3d, 'T', 1.0_wp )
ENDIF
diff --git a/src/OCE/stpctl.F90 b/src/OCE/stpctl.F90
index 96358bf94..b8cc8aaa1 100644
--- a/src/OCE/stpctl.F90
+++ b/src/OCE/stpctl.F90
@@ -231,7 +231,7 @@ CONTAINS
iloc(1:3,3) = MINLOC( ts(:,:,:,jp_sal,Kmm) , mask = llmsk(:,:,:) )
iloc(1:3,4) = MAXLOC( ts(:,:,:,jp_sal,Kmm) , mask = llmsk(:,:,:) )
DO ji = 1, jptst ! local domain indices ==> global domain indices, excluding halos
- iloc(1:2,ji) = (/ mig0(iloc(1,ji)), mjg0(iloc(2,ji)) /)
+ iloc(1:2,ji) = (/ mig(iloc(1,ji),0), mjg(iloc(2,ji),0) /)
END DO
iareamin(:) = narea ; iareamax(:) = narea ; iareasum(:) = 1 ! this is local information
ENDIF
diff --git a/src/SAS/stpctl.F90 b/src/SAS/stpctl.F90
index 6de0e1dbf..e5c9a573b 100644
--- a/src/SAS/stpctl.F90
+++ b/src/SAS/stpctl.F90
@@ -191,7 +191,7 @@ CONTAINS
iloc(1:2,2) = MAXLOC( ABS( u_ice(:,:) ) , mask = llmsk )
iloc(1:2,3) = MINLOC( tm_i(:,:) - rt0, mask = llmsk )
DO ji = 1, jptst ! local domain indices ==> global domain indices, excluding halos
- iloc(1:2,ji) = (/ mig0(iloc(1,ji)), mjg0(iloc(2,ji)) /)
+ iloc(1:2,ji) = (/ mig(iloc(1,ji),0), mjg(iloc(2,ji),0) /)
END DO
iareamin(:) = narea ; iareamax(:) = narea ; iareasum(:) = 1 ! this is local information
ENDIF
diff --git a/src/SWE/stpctl.F90 b/src/SWE/stpctl.F90
index 74def0eef..24e3bef8d 100644
--- a/src/SWE/stpctl.F90
+++ b/src/SWE/stpctl.F90
@@ -185,7 +185,7 @@ CONTAINS
llmsk(Nis0:Nie0,Njs0:Nje0,:) = umask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp ! define only the inner domain
iloc(1:3,2) = MAXLOC( ABS( uu(:,:,:, Kmm)), mask = llmsk(:,:,:) )
DO ji = 1, jptst ! local domain indices ==> global domain indices, excluding halos
- iloc(1:2,ji) = (/ mig0(iloc(1,ji)), mjg0(iloc(2,ji)) /)
+ iloc(1:2,ji) = (/ mig(iloc(1,ji),0), mjg(iloc(2,ji),0) /)
END DO
iareamin(:) = narea ; iareamax(:) = narea ; iareasum(:) = 1 ! this is local information
ENDIF
diff --git a/src/TOP/TRP/trcdmp.F90 b/src/TOP/TRP/trcdmp.F90
index 8b2be2d95..2b11fd629 100644
--- a/src/TOP/TRP/trcdmp.F90
+++ b/src/TOP/TRP/trcdmp.F90
@@ -329,11 +329,11 @@ CONTAINS
! convert the position in local domain indices
! --------------------------------------------
DO jc = 1, npncts
- nctsi1(jc) = mi0( nctsi1(jc) )
- nctsj1(jc) = mj0( nctsj1(jc) )
+ nctsi1(jc) = mi0( nctsi1(jc), nn_hls )
+ nctsj1(jc) = mj0( nctsj1(jc), nn_hls )
!
- nctsi2(jc) = mi1( nctsi2(jc) )
- nctsj2(jc) = mj1( nctsj2(jc) )
+ nctsi2(jc) = mi1( nctsi2(jc), nn_hls )
+ nctsj2(jc) = mj1( nctsj2(jc), nn_hls )
END DO
!
ENDIF
diff --git a/tests/ADIAB_WAVE/MY_SRC/usrdef_hgr.F90 b/tests/ADIAB_WAVE/MY_SRC/usrdef_hgr.F90
index 12f778f5c..ac53839aa 100644
--- a/tests/ADIAB_WAVE/MY_SRC/usrdef_hgr.F90
+++ b/tests/ADIAB_WAVE/MY_SRC/usrdef_hgr.F90
@@ -80,14 +80,14 @@ CONTAINS
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
! DO_2D( 1, 1, 1, 1 )
! ! longitude
- plamt(ji,jj) = zfact * ( REAL( mig0(ji)-1 , wp ) )
- plamu(ji,jj) = zfact * ( 0.5 + REAL( mig0(ji)-1 , wp ) )
+ plamt(ji,jj) = zfact * ( REAL( mig(ji,0)-1 , wp ) )
+ plamu(ji,jj) = zfact * ( 0.5 + REAL( mig(ji,0)-1 , wp ) )
plamv(ji,jj) = plamt(ji,jj)
plamf(ji,jj) = plamu(ji,jj)
! ! latitude
- pphit(ji,jj) = zfact2 * ( REAL( mjg0(jj)-1 , wp ) )
+ pphit(ji,jj) = zfact2 * ( REAL( mjg(jj,0)-1 , wp ) )
pphiu(ji,jj) = pphit(ji,jj)
- pphiv(ji,jj) = zfact2 * ( 0.5 + REAL( mjg0(jj)-1 , wp ) )
+ pphiv(ji,jj) = zfact2 * ( 0.5 + REAL( mjg(jj,0)-1 , wp ) )
pphif(ji,jj) = pphiv(ji,jj)
END_2D
!
diff --git a/tests/ADIAB_WAVE/MY_SRC/usrdef_zgr.F90 b/tests/ADIAB_WAVE/MY_SRC/usrdef_zgr.F90
index 5c7fac838..ed83f79c1 100644
--- a/tests/ADIAB_WAVE/MY_SRC/usrdef_zgr.F90
+++ b/tests/ADIAB_WAVE/MY_SRC/usrdef_zgr.F90
@@ -14,8 +14,7 @@ MODULE usrdef_zgr
!! zgr_z1d : reference 1D z-coordinate
!!---------------------------------------------------------------------
USE oce ! ocean variables
- USE dom_oce , ONLY: mi0, mi1 ! ocean space and time domain
- USE dom_oce , ONLY: glamt ! ocean space and time domain
+ USE dom_oce ! ocean space and time domain
USE usrdef_nam ! User defined : namelist variables
!
USE in_out_manager ! I/O manager
@@ -105,10 +104,10 @@ CONTAINS
END_2D
CALL lbc_lnk( 'usrdef_zgr', zhu, 'U', 1. ) ! boundary condition: this mask the surrouding grid-points
! ! ==>>> set by hand non-zero value on first/last columns & rows
- DO ji = mi0(1), mi1(1) ! first row of global domain only
+ DO ji = mi0(1,nn_hls), mi1(1,nn_hls) ! first row of global domain only
zhu(ji,2) = zht(ji,2)
END DO
- DO ji = mi0(jpiglo), mi1(jpiglo) ! last row of global domain only
+ DO ji = mi0(jpiglo,nn_hls), mi1(jpiglo,nn_hls) ! last row of global domain only
zhu(ji,2) = zht(ji,2)
END DO
zhu(:,1) = zhu(:,2)
diff --git a/tests/BENCH/MY_SRC/usrdef_hgr.F90 b/tests/BENCH/MY_SRC/usrdef_hgr.F90
index bc6b282ce..ec715f295 100644
--- a/tests/BENCH/MY_SRC/usrdef_hgr.F90
+++ b/tests/BENCH/MY_SRC/usrdef_hgr.F90
@@ -75,15 +75,15 @@ CONTAINS
! define unique value on each point of the inner global domain. z2d ranging from 0.05 to -0.05
!
DO_2D( 0, 0, 0, 0 ) ! +/- 0.5
- z2d(ji,jj) = 0.5 - REAL( mig0(ji) + (mjg0(jj)-1) * Ni0glo, wp ) / REAL( Ni0glo * Nj0glo, wp )
+ z2d(ji,jj) = 0.5 - REAL( mig(ji,0) + (mjg(jj,0)-1) * Ni0glo, wp ) / REAL( Ni0glo * Nj0glo, wp )
END_2D
!
! Position coordinates (in grid points)
! ==========
DO_2D( 0, 0, 0, 0 )
- zti = REAL( mig0(ji), wp ) - 0.5_wp ! start at i=0.5 in the global grid without halos
- ztj = REAL( mjg0(jj), wp ) - 0.5_wp ! start at j=0.5 in the global grid without halos
+ zti = REAL( mig(ji,0), wp ) - 0.5_wp ! start at i=0.5 in the global grid without halos
+ ztj = REAL( mjg(jj,0), wp ) - 0.5_wp ! start at j=0.5 in the global grid without halos
plamt(ji,jj) = zti * (1. + 1.0e-5 * z2d(ji,jj) )
plamu(ji,jj) = ( zti + 0.5_wp ) * (1. + 2.0e-5 * z2d(ji,jj) )
diff --git a/tests/BENCH/MY_SRC/usrdef_istate.F90 b/tests/BENCH/MY_SRC/usrdef_istate.F90
index 69da90f1b..bb35d7849 100644
--- a/tests/BENCH/MY_SRC/usrdef_istate.F90
+++ b/tests/BENCH/MY_SRC/usrdef_istate.F90
@@ -65,7 +65,7 @@ CONTAINS
! define unique value on each point of the inner global domain. z2d ranging from 0.05 to -0.05
!
DO_2D( 0, 0, 0, 0 ) ! +/- 0.05
- z2d(ji,jj) = 0.1 * ( 0.5 - REAL( mig0(ji) + (mjg0(jj)-1) * Ni0glo, wp ) / REAL( Ni0glo * Nj0glo, wp ) )
+ z2d(ji,jj) = 0.1 * ( 0.5 - REAL( mig(ji,0) + (mjg(jj,0)-1) * Ni0glo, wp ) / REAL( Ni0glo * Nj0glo, wp ) )
END_2D
!
DO_3D( 0, 0, 0, 0, 1, jpkm1 )
@@ -108,7 +108,7 @@ CONTAINS
IF(lwp) WRITE(numout,*) 'usr_def_istate_ssh : BENCH configuration, analytical definition of initial ssh'
!
DO_2D( 0, 0, 0, 0 ) ! sea level: +/- 0.05 m
- pssh(ji,jj) = 0.1 * ( 0.5 - REAL( mig0(ji) + (mjg0(jj)-1) * Ni0glo, wp ) / REAL( Ni0glo * Nj0glo, wp ) )
+ pssh(ji,jj) = 0.1 * ( 0.5 - REAL( mig(ji,0) + (mjg(jj,0)-1) * Ni0glo, wp ) / REAL( Ni0glo * Nj0glo, wp ) )
END_2D
!
CALL lbc_lnk('usrdef_istate', pssh, 'T', 1. ) ! apply boundary conditions
diff --git a/tests/BENCH/MY_SRC/usrdef_sbc.F90 b/tests/BENCH/MY_SRC/usrdef_sbc.F90
index 4bd129228..ee91c35e0 100644
--- a/tests/BENCH/MY_SRC/usrdef_sbc.F90
+++ b/tests/BENCH/MY_SRC/usrdef_sbc.F90
@@ -104,7 +104,7 @@ CONTAINS
! define unique value on each point. z2d ranging from 0.05 to -0.05
!
DO_2D( 0, 0, 0, 0 )
- zztmp = 0.1 * ( 0.5 - REAL( mig0(ji) + (mjg0(jj)-1) * Ni0glo, wp ) / REAL( Ni0glo * Nj0glo, wp ) )
+ zztmp = 0.1 * ( 0.5 - REAL( mig(ji,0) + (mjg(jj,0)-1) * Ni0glo, wp ) / REAL( Ni0glo * Nj0glo, wp ) )
utau_ice(ji,jj) = 0.1_wp + zztmp
vtau_ice(ji,jj) = 0.1_wp + zztmp
END_2D
diff --git a/tests/BENCH/MY_SRC/usrdef_zgr.F90 b/tests/BENCH/MY_SRC/usrdef_zgr.F90
index b54748001..fe5d7de80 100644
--- a/tests/BENCH/MY_SRC/usrdef_zgr.F90
+++ b/tests/BENCH/MY_SRC/usrdef_zgr.F90
@@ -197,14 +197,14 @@ CONTAINS
!
!!$ IF( c_NFtype == 'T' ) THEN ! add a small island in the upper corners to avoid model instabilities...
-!!$ z2d(mi0( nn_hls):mi1( nn_hls+2 ),mj0(jpjglo-nn_hls-1):mj1(jpjglo-nn_hls+1)) = 0._wp
-!!$ z2d(mi0(jpiglo-nn_hls):mi1(MIN(jpiglo,jpiglo-nn_hls+2)),mj0(jpjglo-nn_hls-1):mj1(jpjglo-nn_hls+1)) = 0._wp
-!!$ z2d(mi0(jpiglo/2 ):mi1( jpiglo/2 +2 ),mj0(jpjglo-nn_hls-1):mj1(jpjglo-nn_hls+1)) = 0._wp
+!!$ z2d(mi0( nn_hls,nn_hls):mi1( nn_hls+2 ,nn_hls),mj0(jpjglo-nn_hls-1,nn_hls):mj1(jpjglo-nn_hls+1,nn_hls)) = 0._wp
+!!$ z2d(mi0(jpiglo-nn_hls,nn_hls):mi1(MIN(jpiglo,jpiglo-nn_hls+2),nn_hls),mj0(jpjglo-nn_hls-1,nn_hls):mj1(jpjglo-nn_hls+1,nn_hls)) = 0._wp
+!!$ z2d(mi0(jpiglo/2 ,nn_hls):mi1( jpiglo/2 +2 ,nn_hls),mj0(jpjglo-nn_hls-1,nn_hls):mj1(jpjglo-nn_hls+1,nn_hls)) = 0._wp
!!$ ENDIF
!!$ !
IF( c_NFtype == 'F' ) THEN ! Must mask the 2 pivot-points
- z2d(mi0(nn_hls+1):mi1(nn_hls+1),mj0(jpjglo-nn_hls):mj1(jpjglo-nn_hls)) = 0._wp
- z2d(mi0(jpiglo/2):mi1(jpiglo/2),mj0(jpjglo-nn_hls):mj1(jpjglo-nn_hls)) = 0._wp
+ z2d(mi0(nn_hls+1,nn_hls):mi1(nn_hls+1,nn_hls),mj0(jpjglo-nn_hls,nn_hls):mj1(jpjglo-nn_hls,nn_hls)) = 0._wp
+ z2d(mi0(jpiglo/2,nn_hls):mi1(jpiglo/2,nn_hls),mj0(jpjglo-nn_hls,nn_hls):mj1(jpjglo-nn_hls,nn_hls)) = 0._wp
ENDIF
!
CALL lbc_lnk( 'usrdef_zgr', z2d, 'T', 1._wp ) ! set surrounding land to zero (closed boundaries)
diff --git a/tests/C1D_ASICS/MY_SRC/usrdef_nam.F90 b/tests/C1D_ASICS/MY_SRC/usrdef_nam.F90
index 538d753ce..c1d0b9765 100644
--- a/tests/C1D_ASICS/MY_SRC/usrdef_nam.F90
+++ b/tests/C1D_ASICS/MY_SRC/usrdef_nam.F90
@@ -13,7 +13,6 @@ MODULE usrdef_nam
!! usr_def_nam : read user defined namelist and set global domain size
!! usr_def_hgr : initialize the horizontal mesh
!!----------------------------------------------------------------------
- USE dom_oce , ONLY: nimpp, njmpp ! ocean space and time domain
USE dom_oce , ONLY: ln_zco, ln_zps, ln_sco ! flag of type of coordinate
USE par_oce ! ocean space and time domain
USE phycst ! physical constants
diff --git a/tests/CANAL/MY_SRC/usrdef_hgr.F90 b/tests/CANAL/MY_SRC/usrdef_hgr.F90
index 8cb9d5bdd..c7b469cf8 100644
--- a/tests/CANAL/MY_SRC/usrdef_hgr.F90
+++ b/tests/CANAL/MY_SRC/usrdef_hgr.F90
@@ -88,8 +88,8 @@ CONTAINS
#endif
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- zti = REAL( mig0(ji)-ii0, wp ) ! =0 at i=ii0 in the global grid without halos
- ztj = REAL( mjg0(jj)-ij0, wp ) ! =0 at i=ij0 in the global grid without halos
+ zti = REAL( mig(ji,0)-ii0, wp ) ! =0 at i=ii0 in the global grid without halos
+ ztj = REAL( mjg(jj,0)-ij0, wp ) ! =0 at i=ij0 in the global grid without halos
plamt(ji,jj) = rn_dx * zti
plamu(ji,jj) = rn_dx * ( zti + 0.5_wp )
diff --git a/tests/DIA_GPU/MY_SRC/stpctl.F90 b/tests/DIA_GPU/MY_SRC/stpctl.F90
index acf186402..cf7cd09c9 100644
--- a/tests/DIA_GPU/MY_SRC/stpctl.F90
+++ b/tests/DIA_GPU/MY_SRC/stpctl.F90
@@ -232,7 +232,7 @@ CONTAINS
iloc(1:3,3) = MINLOC( ts(:,:,:,jp_sal,Kmm) , mask = llmsk(:,:,:) )
iloc(1:3,4) = MAXLOC( ts(:,:,:,jp_sal,Kmm) , mask = llmsk(:,:,:) )
DO ji = 1, jptst ! local domain indices ==> global domain indices, excluding halos
- iloc(1:2,ji) = (/ mig0(iloc(1,ji)), mjg0(iloc(2,ji)) /)
+ iloc(1:2,ji) = (/ mig(iloc(1,ji),0), mjg(iloc(2,ji),0) /)
END DO
iareamin(:) = narea ; iareamax(:) = narea ; iareasum(:) = 1 ! this is local information
ENDIF
diff --git a/tests/DOME/MY_SRC/usrdef_hgr.F90 b/tests/DOME/MY_SRC/usrdef_hgr.F90
index e135d867a..3717ef1cc 100644
--- a/tests/DOME/MY_SRC/usrdef_hgr.F90
+++ b/tests/DOME/MY_SRC/usrdef_hgr.F90
@@ -93,8 +93,8 @@ CONTAINS
#endif
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- zti = REAL( mig0(ji) - 1, wp ) ! start at i=0 in the global grid without halos
- ztj = REAL( mjg0(jj) - 1, wp ) ! start at j=0 in the global grid without halos
+ zti = REAL( mig(ji,0) - 1, wp ) ! start at i=0 in the global grid without halos
+ ztj = REAL( mjg(jj,0) - 1, wp ) ! start at j=0 in the global grid without halos
plamt(ji,jj) = roffsetx + rn_dx * 1.e-3 * ( zti - 0.5_wp )
plamu(ji,jj) = roffsetx + rn_dx * 1.e-3 * zti
diff --git a/tests/DOME/MY_SRC/usrdef_istate.F90 b/tests/DOME/MY_SRC/usrdef_istate.F90
index e41bad22d..782e164e3 100644
--- a/tests/DOME/MY_SRC/usrdef_istate.F90
+++ b/tests/DOME/MY_SRC/usrdef_istate.F90
@@ -105,10 +105,10 @@ CONTAINS
! ztd = 15._wp*gdepw_0(ji,jj,jk+1)-0.5*rho0*zn2/(rn_a0*grav)*gdepw_0(ji,jj,jk+1)**2
! ztu = 15._wp*gdepw_0(ji,jj,jk )-0.5*rho0*zn2/(rn_a0*grav)*gdepw_0(ji,jj,jk )**2
! pts(ji,jj,jk,jp_tem) = (ztd - ztu)/e3t_0(ji,jj,jk) * ptmask(ji,jj,jk)
- IF (Agrif_root().AND.( mjg0(jj) == Nj0glo-2 ) ) THEN
+ IF (Agrif_root().AND.( mjg(jj,0) == Nj0glo-2 ) ) THEN
pv(ji,jj,jk) = -sqrt(zdb*zh0)*exp(-zxw/zro)*(1._wp-zf) * ptmask(ji,jj,jk)
ENDIF
- IF (Agrif_root().AND.( mjg0(jj) == Nj0glo-1 ) ) THEN
+ IF (Agrif_root().AND.( mjg(jj,0) == Nj0glo-1 ) ) THEN
pts(ji,jj,jk,jp_tem) = MIN(pts(ji,jj,jk,jp_tem), 15._wp - zdb*rho0/grav/rn_a0*(1._wp-zf)) * ptmask(ji,jj,jk)
pts(ji,jj,jk,jp_sal) = 1._wp * ptmask(ji,jj,jk)
ENDIF
diff --git a/tests/DOME/MY_SRC/usrdef_zgr.F90 b/tests/DOME/MY_SRC/usrdef_zgr.F90
index 797006a77..0fb7ecd0c 100644
--- a/tests/DOME/MY_SRC/usrdef_zgr.F90
+++ b/tests/DOME/MY_SRC/usrdef_zgr.F90
@@ -14,8 +14,7 @@ MODULE usrdef_zgr
!! zgr_z1d : reference 1D z-coordinate
!!---------------------------------------------------------------------
USE oce ! ocean variables
- USE dom_oce , ONLY: mi0, mi1 ! ocean space and time domain
- USE dom_oce , ONLY: glamt, gphit ! ocean space and time domain
+ USE dom_oce ! ocean space and time domain
USE usrdef_nam ! User defined : namelist variables
!
USE in_out_manager ! I/O manager
diff --git a/tests/ICB/MY_SRC/usrdef_nam.F90 b/tests/ICB/MY_SRC/usrdef_nam.F90
index e850ce892..a9e540109 100644
--- a/tests/ICB/MY_SRC/usrdef_nam.F90
+++ b/tests/ICB/MY_SRC/usrdef_nam.F90
@@ -14,7 +14,6 @@ MODULE usrdef_nam
!! usr_def_nam : read user defined namelist and set global domain size
!! usr_def_hgr : initialize the horizontal mesh
!!----------------------------------------------------------------------
- USE dom_oce , ONLY: nimpp , njmpp ! i- & j-indices of the local domain
USE dom_oce , ONLY: ln_zco, ln_zps, ln_sco ! flag of type of coordinate
USE par_oce ! ocean space and time domain
USE phycst ! physical constants
diff --git a/tests/ICE_ADV1D/MY_SRC/usrdef_hgr.F90 b/tests/ICE_ADV1D/MY_SRC/usrdef_hgr.F90
index 507212b66..92abf49f0 100644
--- a/tests/ICE_ADV1D/MY_SRC/usrdef_hgr.F90
+++ b/tests/ICE_ADV1D/MY_SRC/usrdef_hgr.F90
@@ -78,8 +78,8 @@ CONTAINS
zphi0 = -REAL(Nj0glo, wp) * 0.5 * 1.e-3 * rn_dy
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- zti = REAL( mig0(ji), wp ) - 0.5_wp ! start at i=0.5 in the global grid without halos
- ztj = REAL( mjg0(jj), wp ) - 0.5_wp ! start at j=0.5 in the global grid without halos
+ zti = REAL( mig(ji,0), wp ) - 0.5_wp ! start at i=0.5 in the global grid without halos
+ ztj = REAL( mjg(jj,0), wp ) - 0.5_wp ! start at j=0.5 in the global grid without halos
plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 * zti
plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * ( zti + 0.5_wp )
diff --git a/tests/ICE_ADV2D/MY_SRC/usrdef_hgr.F90 b/tests/ICE_ADV2D/MY_SRC/usrdef_hgr.F90
index b2b645b8b..0c554f80d 100644
--- a/tests/ICE_ADV2D/MY_SRC/usrdef_hgr.F90
+++ b/tests/ICE_ADV2D/MY_SRC/usrdef_hgr.F90
@@ -90,8 +90,8 @@ CONTAINS
#endif
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- zti = REAL( mig0(ji), wp ) - 0.5_wp ! start at i=0.5 in the global grid without halos
- ztj = REAL( mjg0(jj), wp ) - 0.5_wp ! start at j=0.5 in the global grid without halos
+ zti = REAL( mig(ji,0), wp ) - 0.5_wp ! start at i=0.5 in the global grid without halos
+ ztj = REAL( mjg(jj,0), wp ) - 0.5_wp ! start at j=0.5 in the global grid without halos
plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 * zti
plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * ( zti + 0.5_wp )
@@ -110,19 +110,19 @@ CONTAINS
!! clem: This can be used with a 1proc simulation but I think it breaks repro when >1procs are used
!! DO jj = 1, jpj
!! DO ji = 1, jpi
-!! !!pe1t(ji,jj) = rn_dx * EXP( -0.8/REAL(jpiglo**2) * (mi0(ji)-REAL(jpiglo+1)*0.5)**2 ) ! gaussian shape
-!! !!pe2t(ji,jj) = rn_dy * EXP( -0.8/REAL(jpjglo**2) * (mj0(jj)-REAL(jpjglo+1)*0.5)**2 ) ! gaussian shape
-!! pe1t(ji,jj) = rn_dx * ( 1. -0.1 * ABS(REAL(mi0(ji))-REAL(jpiglo+1)*0.5) / (1.-REAL(jpiglo+1)*0.5) ) ! linear shape
-!! pe2t(ji,jj) = rn_dy * ( 1. -0.1 * ABS(REAL(mj0(jj))-REAL(jpjglo+1)*0.5) / (1.-REAL(jpjglo+1)*0.5) ) ! linear shape
+!! !!pe1t(ji,jj) = rn_dx * EXP( -0.8/REAL(jpiglo**2) * (mi0(ji,nn_hls)-REAL(jpiglo+1)*0.5)**2 ) ! gaussian shape
+!! !!pe2t(ji,jj) = rn_dy * EXP( -0.8/REAL(jpjglo**2) * (mj0(jj,nn_hls)-REAL(jpjglo+1)*0.5)**2 ) ! gaussian shape
+!! pe1t(ji,jj) = rn_dx * ( 1. -0.1 * ABS(REAL(mi0(ji,nn_hls))-REAL(jpiglo+1)*0.5) / (1.-REAL(jpiglo+1)*0.5) ) ! linear shape
+!! pe2t(ji,jj) = rn_dy * ( 1. -0.1 * ABS(REAL(mj0(jj,nn_hls))-REAL(jpjglo+1)*0.5) / (1.-REAL(jpjglo+1)*0.5) ) ! linear shape
!! END DO
!! END DO
!!#if defined key_agrif
!! IF( .NOT. Agrif_Root() ) THEN ! only works if the zoom is positioned at the center of the parent grid
!! DO jj = 1, jpj
!! DO ji = 1, jpi
-!! pe1t(ji,jj) = rn_dx * ( 1. -0.1 * ABS(REAL(mi0(ji))-REAL(jpiglo+1)*0.5) / (1.-REAL(jpiglo+1)*0.5) &
+!! pe1t(ji,jj) = rn_dx * ( 1. -0.1 * ABS(REAL(mi0(ji,nn_hls))-REAL(jpiglo+1)*0.5) / (1.-REAL(jpiglo+1)*0.5) &
!! & * REAL(jpiglo) / REAL(Agrif_Parent(jpiglo) * Agrif_Rhox()) ) ! factor to match parent grid
-!! pe2t(ji,jj) = rn_dy * ( 1. -0.1 * ABS(REAL(mj0(jj))-REAL(jpjglo+1)*0.5) / (1.-REAL(jpjglo+1)*0.5) &
+!! pe2t(ji,jj) = rn_dy * ( 1. -0.1 * ABS(REAL(mj0(jj,nn_hls))-REAL(jpjglo+1)*0.5) / (1.-REAL(jpjglo+1)*0.5) &
!! & * REAL(jpjglo) / REAL(Agrif_Parent(jpjglo) * Agrif_Rhoy()) ) ! factor to match parent grid
!! END DO
!! END DO
diff --git a/tests/ICE_AGRIF/MY_SRC/usrdef_hgr.F90 b/tests/ICE_AGRIF/MY_SRC/usrdef_hgr.F90
index 9ac18267b..c087ceeb0 100644
--- a/tests/ICE_AGRIF/MY_SRC/usrdef_hgr.F90
+++ b/tests/ICE_AGRIF/MY_SRC/usrdef_hgr.F90
@@ -96,8 +96,8 @@ CONTAINS
ENDIF
#endif
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- zti = REAL( mig0(ji)-1, wp ) ! start at i=0 in the global grid without halos
- ztj = REAL( mjg0(jj)-1, wp ) ! start at j=0 in the global grid without halos
+ zti = REAL( mig(ji,0)-1, wp ) ! start at i=0 in the global grid without halos
+ ztj = REAL( mjg(jj,0)-1, wp ) ! start at j=0 in the global grid without halos
plamt(ji,jj) = roffsetx + rn_dx * 1.e-3 * ( zti - 0.5_wp )
plamu(ji,jj) = roffsetx + rn_dx * 1.e-3 * zti
@@ -116,19 +116,19 @@ CONTAINS
!! clem: This can be used with a 1proc simulation but I think it breaks repro when >1procs are used
!! DO jj = 1, jpj
!! DO ji = 1, jpi
-!! !!pe1t(ji,jj) = rn_dx * EXP( -0.8/REAL(jpiglo**2) * (mi0(ji)-REAL(jpiglo+1)*0.5)**2 ) ! gaussian shape
-!! !!pe2t(ji,jj) = rn_dy * EXP( -0.8/REAL(jpjglo**2) * (mj0(jj)-REAL(jpjglo+1)*0.5)**2 ) ! gaussian shape
-!! pe1t(ji,jj) = rn_dx * ( 1. -0.1 * ABS(REAL(mi0(ji))-REAL(jpiglo+1)*0.5) / (1.-REAL(jpiglo+1)*0.5) ) ! linear shape
-!! pe2t(ji,jj) = rn_dy * ( 1. -0.1 * ABS(REAL(mj0(jj))-REAL(jpjglo+1)*0.5) / (1.-REAL(jpjglo+1)*0.5) ) ! linear shape
+!! !!pe1t(ji,jj) = rn_dx * EXP( -0.8/REAL(jpiglo**2) * (mi0(ji,nn_hls)-REAL(jpiglo+1)*0.5)**2 ) ! gaussian shape
+!! !!pe2t(ji,jj) = rn_dy * EXP( -0.8/REAL(jpjglo**2) * (mj0(jj,nn_hls)-REAL(jpjglo+1)*0.5)**2 ) ! gaussian shape
+!! pe1t(ji,jj) = rn_dx * ( 1. -0.1 * ABS(REAL(mi0(ji,nn_hls))-REAL(jpiglo+1)*0.5) / (1.-REAL(jpiglo+1)*0.5) ) ! linear shape
+!! pe2t(ji,jj) = rn_dy * ( 1. -0.1 * ABS(REAL(mj0(jj,nn_hls))-REAL(jpjglo+1)*0.5) / (1.-REAL(jpjglo+1)*0.5) ) ! linear shape
!! END DO
!! END DO
!!#if defined key_agrif
!! IF( .NOT. Agrif_Root() ) THEN ! only works if the zoom is positioned at the center of the parent grid
!! DO jj = 1, jpj
!! DO ji = 1, jpi
-!! pe1t(ji,jj) = rn_dx * ( 1. -0.1 * ABS(REAL(mi0(ji))-REAL(jpiglo+1)*0.5) / (1.-REAL(jpiglo+1)*0.5) &
+!! pe1t(ji,jj) = rn_dx * ( 1. -0.1 * ABS(REAL(mi0(ji,nn_hls))-REAL(jpiglo+1)*0.5) / (1.-REAL(jpiglo+1)*0.5) &
!! & * REAL(jpiglo) / REAL(Agrif_Parent(jpiglo) * Agrif_Rhox()) ) ! factor to match parent grid
-!! pe2t(ji,jj) = rn_dy * ( 1. -0.1 * ABS(REAL(mj0(jj))-REAL(jpjglo+1)*0.5) / (1.-REAL(jpjglo+1)*0.5) &
+!! pe2t(ji,jj) = rn_dy * ( 1. -0.1 * ABS(REAL(mj0(jj,nn_hls))-REAL(jpjglo+1)*0.5) / (1.-REAL(jpjglo+1)*0.5) &
!! & * REAL(jpjglo) / REAL(Agrif_Parent(jpjglo) * Agrif_Rhoy()) ) ! factor to match parent grid
!! END DO
!! END DO
diff --git a/tests/ICE_RHEO/MY_SRC/icedyn_rhg_eap.F90 b/tests/ICE_RHEO/MY_SRC/icedyn_rhg_eap.F90
index 2c5e43487..6db0b1114 100644
--- a/tests/ICE_RHEO/MY_SRC/icedyn_rhg_eap.F90
+++ b/tests/ICE_RHEO/MY_SRC/icedyn_rhg_eap.F90
@@ -573,7 +573,7 @@ CONTAINS
& ) * zmsk00y(ji,jj)
ENDIF
!extra code for test case boundary conditions
- IF (mjg(jj)<25 .or. mjg(jj)>975 .or. mig(ji)<25 .or. mig(ji)>975) THEN
+ IF (mjg(jj,nn_hls)<25 .or. mjg(jj,nn_hls)>975 .or. mig(ji,nn_hls)<25 .or. mig(ji,nn_hls)>975) THEN
v_ice(ji,jj) = zinvw*(ztauy_ai(ji,jj) + zCorV(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj))
END IF
@@ -630,7 +630,7 @@ CONTAINS
& ) * zmsk00x(ji,jj)
ENDIF
!extra code for test case boundary conditions
- IF (mjg(jj)<25 .or. mjg(jj)>975 .or. mig(ji)<25 .or. mig(ji)>975) THEN
+ IF (mjg(jj,nn_hls)<25 .or. mjg(jj,nn_hls)>975 .or. mig(ji,nn_hls)<25 .or. mig(ji,nn_hls)>975) THEN
u_ice(ji,jj) = zinvw*(ztaux_ai(ji,jj) + zCorU(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj))
END IF
@@ -689,7 +689,7 @@ CONTAINS
& ) * zmsk00x(ji,jj)
ENDIF
!extra code for test case boundary conditions
- IF (mjg(jj)<25 .or. mjg(jj)>975 .or. mig(ji)<25 .or. mig(ji)>975) THEN
+ IF (mjg(jj,nn_hls)<25 .or. mjg(jj,nn_hls)>975 .or. mig(ji,nn_hls)<25 .or. mig(ji,nn_hls)>975) THEN
u_ice(ji,jj) = zinvw*(ztaux_ai(ji,jj) + zCorU(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj))
END IF
END_2D
@@ -745,7 +745,7 @@ CONTAINS
& ) * zmsk00y(ji,jj)
ENDIF
!extra code for test case boundary conditions
- IF (mjg(jj)<25 .or. mjg(jj)>975 .or. mig(ji)<25 .or. mig(ji)>975) THEN
+ IF (mjg(jj,nn_hls)<25 .or. mjg(jj,nn_hls)>975 .or. mig(ji,nn_hls)<25 .or. mig(ji,nn_hls)>975) THEN
v_ice(ji,jj) = zinvw*(ztauy_ai(ji,jj) + zCorV(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj))
END IF
END_2D
@@ -1048,7 +1048,7 @@ CONTAINS
zresm = 0._wp
DO_2D( 0, 0, 0, 0 )
! cut of the boundary of the box (forced velocities)
- IF (mjg0(jj)>30 .AND. mjg0(jj)<=970 .AND. mig0(ji)>30 .AND. mig0(ji)<=970) THEN
+ IF (mjg(jj,0)>30 .AND. mjg(jj,0)<=970 .AND. mig(ji,0)>30 .AND. mig(ji,0)<=970) THEN
zresm = MAX( zresm, MAX( ABS( pu(ji,jj) - pub(ji,jj) ) * umask(ji,jj,1), &
& ABS( pv(ji,jj) - pvb(ji,jj) ) * vmask(ji,jj,1) ) * pmsk15(ji,jj) )
ENDIF
diff --git a/tests/ICE_RHEO/MY_SRC/icedyn_rhg_evp.F90 b/tests/ICE_RHEO/MY_SRC/icedyn_rhg_evp.F90
index e2df97c76..8f691d6ca 100644
--- a/tests/ICE_RHEO/MY_SRC/icedyn_rhg_evp.F90
+++ b/tests/ICE_RHEO/MY_SRC/icedyn_rhg_evp.F90
@@ -525,7 +525,7 @@ CONTAINS
& ) * zmsk00y(ji,jj)
ENDIF
!extra code for test case boundary conditions
- IF (mjg(jj)<25 .or. mjg(jj)>975 .or. mig(ji)<25 .or. mig(ji)>975) THEN
+ IF (mjg(jj,nn_hls)<25 .or. mjg(jj,nn_hls)>975 .or. mig(ji,nn_hls)<25 .or. mig(ji,nn_hls)>975) THEN
v_ice(ji,jj) = zinvw*(ztauy_ai(ji,jj) + zCorV(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj))
END IF
END_2D
@@ -581,7 +581,7 @@ CONTAINS
& ) * zmsk00x(ji,jj)
ENDIF
!extra code for test case boundary conditions
- IF (mjg(jj)<25 .or. mjg(jj)>975 .or. mig(ji)<25 .or. mig(ji)>975) THEN
+ IF (mjg(jj,nn_hls)<25 .or. mjg(jj,nn_hls)>975 .or. mig(ji,nn_hls)<25 .or. mig(ji,nn_hls)>975) THEN
u_ice(ji,jj) = zinvw*(ztaux_ai(ji,jj) + zCorU(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj))
END IF
END_2D
@@ -639,7 +639,7 @@ CONTAINS
& ) * zmsk00x(ji,jj)
ENDIF
!extra code for test case boundary conditions
- IF (mjg(jj)<25 .or. mjg(jj)>975 .or. mig(ji)<25 .or. mig(ji)>975) THEN
+ IF (mjg(jj,nn_hls)<25 .or. mjg(jj,nn_hls)>975 .or. mig(ji,nn_hls)<25 .or. mig(ji,nn_hls)>975) THEN
u_ice(ji,jj) = zinvw*(ztaux_ai(ji,jj) + zCorU(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj))
END IF
END_2D
@@ -695,7 +695,7 @@ CONTAINS
& ) * zmsk00y(ji,jj)
ENDIF
!extra code for test case boundary conditions
- IF (mjg(jj)<25 .or. mjg(jj)>975 .or. mig(ji)<25 .or. mig(ji)>975) THEN
+ IF (mjg(jj,nn_hls)<25 .or. mjg(jj,nn_hls)>975 .or. mig(ji,nn_hls)<25 .or. mig(ji,nn_hls)>975) THEN
v_ice(ji,jj) = zinvw*(ztauy_ai(ji,jj) + zCorV(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj))
END IF
END_2D
@@ -978,7 +978,7 @@ CONTAINS
zresm = 0._wp
DO_2D( 0, 0, 0, 0 )
! cut of the boundary of the box (forced velocities)
- IF (mjg0(jj)>30 .AND. mjg0(jj)<=970 .AND. mig0(ji)>30 .AND. mig0(ji)<=970) THEN
+ IF (mjg(jj,0)>30 .AND. mjg(jj,0)<=970 .AND. mig(ji,0)>30 .AND. mig(ji,0)<=970) THEN
zresm = MAX( zresm, MAX( ABS( pu(ji,jj) - pub(ji,jj) ) * umask(ji,jj,1), &
& ABS( pv(ji,jj) - pvb(ji,jj) ) * vmask(ji,jj,1) ) * pmsk15(ji,jj) )
ENDIF
diff --git a/tests/ICE_RHEO/MY_SRC/usrdef_hgr.F90 b/tests/ICE_RHEO/MY_SRC/usrdef_hgr.F90
index e585820e8..679c21533 100644
--- a/tests/ICE_RHEO/MY_SRC/usrdef_hgr.F90
+++ b/tests/ICE_RHEO/MY_SRC/usrdef_hgr.F90
@@ -98,17 +98,17 @@ CONTAINS
!! ==> EITHER 1) variable scale factors
!! clem: This can be used with a 1proc simulation but I think it breaks repro when >1procs are used
!! DO_2D( 1, 1, 1, 1 )
-!! !!pe1t(ji,jj) = rn_dx * EXP( -0.8/REAL(jpiglo**2) * (mi0(ji)-REAL(jpiglo+1)*0.5)**2 ) ! gaussian shape
-!! !!pe2t(ji,jj) = rn_dy * EXP( -0.8/REAL(jpjglo**2) * (mj0(jj)-REAL(jpjglo+1)*0.5)**2 ) ! gaussian shape
-!! pe1t(ji,jj) = rn_dx * ( 1. -0.1 * ABS(REAL(mi0(ji))-REAL(jpiglo+1)*0.5) / (1.-REAL(jpiglo+1)*0.5) ) ! linear shape
-!! pe2t(ji,jj) = rn_dy * ( 1. -0.1 * ABS(REAL(mj0(jj))-REAL(jpjglo+1)*0.5) / (1.-REAL(jpjglo+1)*0.5) ) ! linear shape
+!! !!pe1t(ji,jj) = rn_dx * EXP( -0.8/REAL(jpiglo**2) * (mi0(ji,nn_hls)-REAL(jpiglo+1)*0.5)**2 ) ! gaussian shape
+!! !!pe2t(ji,jj) = rn_dy * EXP( -0.8/REAL(jpjglo**2) * (mj0(jj,nn_hls)-REAL(jpjglo+1)*0.5)**2 ) ! gaussian shape
+!! pe1t(ji,jj) = rn_dx * ( 1. -0.1 * ABS(REAL(mi0(ji,nn_hls))-REAL(jpiglo+1)*0.5) / (1.-REAL(jpiglo+1)*0.5) ) ! linear shape
+!! pe2t(ji,jj) = rn_dy * ( 1. -0.1 * ABS(REAL(mj0(jj,nn_hls))-REAL(jpjglo+1)*0.5) / (1.-REAL(jpjglo+1)*0.5) ) ! linear shape
!! END_2D
!!#if defined key_agrif
!! IF( .NOT. Agrif_Root() ) THEN ! only works if the zoom is positioned at the center of the parent grid
!! DO_2D( 1, 1, 1, 1 )
-!! pe1t(ji,jj) = rn_dx * ( 1. -0.1 * ABS(REAL(mi0(ji))-REAL(jpiglo+1)*0.5) / (1.-REAL(jpiglo+1)*0.5) &
+!! pe1t(ji,jj) = rn_dx * ( 1. -0.1 * ABS(REAL(mi0(ji,nn_hls))-REAL(jpiglo+1)*0.5) / (1.-REAL(jpiglo+1)*0.5) &
!! & * REAL(jpiglo) / REAL(Agrif_Parent(jpiglo) * Agrif_Rhox()) ) ! factor to match parent grid
-!! pe2t(ji,jj) = rn_dy * ( 1. -0.1 * ABS(REAL(mj0(jj))-REAL(jpjglo+1)*0.5) / (1.-REAL(jpjglo+1)*0.5) &
+!! pe2t(ji,jj) = rn_dy * ( 1. -0.1 * ABS(REAL(mj0(jj,nn_hls))-REAL(jpjglo+1)*0.5) / (1.-REAL(jpjglo+1)*0.5) &
!! & * REAL(jpjglo) / REAL(Agrif_Parent(jpjglo) * Agrif_Rhoy()) ) ! factor to match parent grid
!! END_2D
!! ENDIF
diff --git a/tests/ICE_RHEO/MY_SRC/usrdef_nam.F90 b/tests/ICE_RHEO/MY_SRC/usrdef_nam.F90
index 0f92fbee5..df8898d92 100644
--- a/tests/ICE_RHEO/MY_SRC/usrdef_nam.F90
+++ b/tests/ICE_RHEO/MY_SRC/usrdef_nam.F90
@@ -13,7 +13,6 @@ MODULE usrdef_nam
!! usr_def_nam : read user defined namelist and set global domain size
!! usr_def_hgr : initialize the horizontal mesh
!!----------------------------------------------------------------------
- USE dom_oce , ONLY: nimpp , njmpp , Agrif_Root ! i- & j-indices of the local domain
USE par_oce ! ocean space and time domain
USE phycst ! physical constants
!
diff --git a/tests/ICE_RHEO/MY_SRC/usrdef_sbc.F90 b/tests/ICE_RHEO/MY_SRC/usrdef_sbc.F90
index 2a22cfc80..0d9d07e01 100644
--- a/tests/ICE_RHEO/MY_SRC/usrdef_sbc.F90
+++ b/tests/ICE_RHEO/MY_SRC/usrdef_sbc.F90
@@ -71,8 +71,8 @@ CONTAINS
!ij0 = 1 ; ij1 = 25 ! set boundary condition
!ii0 = 975 ; ii1 = 1000
- !DO jj = mj0(ij0), mj1(ij1)
- ! DO ji = mi0(ii0), mi1(ii1)
+ !DO jj = mj0(ij0,nn_hls), mj1(ij1,nn_hls)
+ ! DO ji = mi0(ii0,nn_hls), mi1(ii1,nn_hls)
! utau(ji,jj) = -utau_ice(ji,jj)
! vtau(ji,jj) = -vtau_ice(ji,jj)
! END DO
@@ -122,8 +122,10 @@ CONTAINS
DO_2D( 0, 0, 0, 0 )
! wind spins up over 6 hours, factor 1000 to balance the units
- windu(ji,jj) = Umax/sqrt(d*1000)*(d-2*mig(ji)*res)/((d-2*mig(ji)*res)**2+(d-2*mjg(jj)*res)**2*Rwind**2)**(1/4)*min(kt*30./21600,1.)
- windv(ji,jj) = Umax/sqrt(d*1000)*(d-2*mjg(jj)*res)/((d-2*mig(ji)*res)**2+(d-2*mjg(jj)*res)**2*Rwind**2)**(1/4)*Rwind*min(kt*30./21600,1.)
+ windu(ji,jj) = Umax/SQRT(d*1000)*(d-2*mig(ji,nn_hls)*res) / &
+ & ((d-2*mig(ji,nn_hls)*res)**2+(d-2*mjg(jj,nn_hls)*res)**2*Rwind**2)**(1/4)*MIN(kt*30./21600,1.)
+ windv(ji,jj) = Umax/SQRT(d*1000)*(d-2*mjg(jj,nn_hls)*res) / &
+ & ((d-2*mig(ji,nn_hls)*res)**2+(d-2*mjg(jj,nn_hls)*res)**2*Rwind**2)**(1/4)*Rwind*MIN(kt*30./21600,1.)
END_2D
! ------------------------------------------------------------ !
diff --git a/tests/ISOMIP/MY_SRC/usrdef_hgr.F90 b/tests/ISOMIP/MY_SRC/usrdef_hgr.F90
index 95bdd75af..bda6366cb 100644
--- a/tests/ISOMIP/MY_SRC/usrdef_hgr.F90
+++ b/tests/ISOMIP/MY_SRC/usrdef_hgr.F90
@@ -78,14 +78,14 @@ CONTAINS
! !== grid point position ==! (in degrees)
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
! ! longitude (west coast at lon=0°)
- plamt(ji,jj) = rn_e1deg * ( - 0.5 + REAL( mig0(ji)-1 , wp ) )
- plamu(ji,jj) = rn_e1deg * ( REAL( mig0(ji)-1 , wp ) )
+ plamt(ji,jj) = rn_e1deg * ( - 0.5 + REAL( mig(ji,0)-1 , wp ) )
+ plamu(ji,jj) = rn_e1deg * ( REAL( mig(ji,0)-1 , wp ) )
plamv(ji,jj) = plamt(ji,jj)
plamf(ji,jj) = plamu(ji,jj)
! ! latitude (south coast at lat=-80°)
- pphit(ji,jj) = rn_e2deg * ( - 0.5 + REAL( mjg0(jj)-1 , wp ) ) - 80._wp
+ pphit(ji,jj) = rn_e2deg * ( - 0.5 + REAL( mjg(jj,0)-1 , wp ) ) - 80._wp
pphiu(ji,jj) = pphit(ji,jj)
- pphiv(ji,jj) = rn_e2deg * ( REAL( mjg0(jj)-1 , wp ) ) - 80._wp
+ pphiv(ji,jj) = rn_e2deg * ( REAL( mjg(jj,0)-1 , wp ) ) - 80._wp
pphif(ji,jj) = pphiv(ji,jj)
END_2D
!
diff --git a/tests/ISOMIP/MY_SRC/usrdef_zgr.F90 b/tests/ISOMIP/MY_SRC/usrdef_zgr.F90
index 225e1ca0f..60e89b6fc 100644
--- a/tests/ISOMIP/MY_SRC/usrdef_zgr.F90
+++ b/tests/ISOMIP/MY_SRC/usrdef_zgr.F90
@@ -15,8 +15,7 @@ MODULE usrdef_zgr
!! zgr_z1d : reference 1D z-coordinate
!!---------------------------------------------------------------------
USE oce ! ocean variables
- USE dom_oce , ONLY: mj0 , mj1 ! ocean space and time domain
- USE dom_oce , ONLY: glamt , gphit ! ocean space and time domain
+ USE dom_oce ! ocean space and time domain
USE usrdef_nam ! User defined : namelist variables
!
USE in_out_manager ! I/O manager
@@ -87,7 +86,7 @@ CONTAINS
zht (:,:) = rbathy
zhisf(:,:) = 200._wp
ij0 = 1 ; ij1 = 40+nn_hls
- DO jj = mj0(ij0), mj1(ij1)
+ DO jj = mj0(ij0,nn_hls), mj1(ij1,nn_hls)
zhisf(:,jj)=700.0_wp-(gphit(:,jj)+80.0_wp)*125.0_wp
END DO
!
diff --git a/tests/LOCK_EXCHANGE/MY_SRC/usrdef_hgr.F90 b/tests/LOCK_EXCHANGE/MY_SRC/usrdef_hgr.F90
index 62a161477..b4cac5c17 100644
--- a/tests/LOCK_EXCHANGE/MY_SRC/usrdef_hgr.F90
+++ b/tests/LOCK_EXCHANGE/MY_SRC/usrdef_hgr.F90
@@ -75,14 +75,14 @@ CONTAINS
zfact = rn_dx * 1.e-3 ! conversion in km
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
! ! longitude (west coast at lon=0°)
- plamt(ji,jj) = zfact * ( - 0.5 + REAL( mig0(ji)-1 , wp ) )
- plamu(ji,jj) = zfact * ( REAL( mig0(ji)-1 , wp ) )
+ plamt(ji,jj) = zfact * ( - 0.5 + REAL( mig(ji,0)-1 , wp ) )
+ plamu(ji,jj) = zfact * ( REAL( mig(ji,0)-1 , wp ) )
plamv(ji,jj) = plamt(ji,jj)
plamf(ji,jj) = plamu(ji,jj)
! ! latitude (south coast at lat= 0°)
- pphit(ji,jj) = zfact * ( - 0.5 + REAL( mjg0(jj)-1 , wp ) )
+ pphit(ji,jj) = zfact * ( - 0.5 + REAL( mjg(jj,0)-1 , wp ) )
pphiu(ji,jj) = pphit(ji,jj)
- pphiv(ji,jj) = zfact * ( REAL( mjg0(jj)-1 , wp ) )
+ pphiv(ji,jj) = zfact * ( REAL( mjg(jj,0)-1 , wp ) )
pphif(ji,jj) = pphiv(ji,jj)
END_2D
!
diff --git a/tests/OVERFLOW/MY_SRC/usrdef_hgr.F90 b/tests/OVERFLOW/MY_SRC/usrdef_hgr.F90
index 0abf8552b..55d8d2a61 100644
--- a/tests/OVERFLOW/MY_SRC/usrdef_hgr.F90
+++ b/tests/OVERFLOW/MY_SRC/usrdef_hgr.F90
@@ -75,14 +75,14 @@ CONTAINS
zfact = rn_dx * 1.e-3 ! conversion in km
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
! ! longitude (west coast at lon=0°)
- plamt(ji,jj) = zfact * ( - 0.5 + REAL( mig0(ji)-1 , wp ) )
- plamu(ji,jj) = zfact * ( REAL( mig0(ji)-1 , wp ) )
+ plamt(ji,jj) = zfact * ( - 0.5 + REAL( mig(ji,0)-1 , wp ) )
+ plamu(ji,jj) = zfact * ( REAL( mig(ji,0)-1 , wp ) )
plamv(ji,jj) = plamt(ji,jj)
plamf(ji,jj) = plamu(ji,jj)
! ! latitude (south coast at lat= 0°)
- pphit(ji,jj) = zfact * ( - 0.5 + REAL( mjg0(jj)-1 , wp ) )
+ pphit(ji,jj) = zfact * ( - 0.5 + REAL( mjg(jj,0)-1 , wp ) )
pphiu(ji,jj) = pphit(ji,jj)
- pphiv(ji,jj) = zfact * ( REAL( mjg0(jj)-1 , wp ) )
+ pphiv(ji,jj) = zfact * ( REAL( mjg(jj,0)-1 , wp ) )
pphif(ji,jj) = pphiv(ji,jj)
END_2D
!
diff --git a/tests/OVERFLOW/MY_SRC/usrdef_zgr.F90 b/tests/OVERFLOW/MY_SRC/usrdef_zgr.F90
index b39e22ab1..d0d126ed5 100644
--- a/tests/OVERFLOW/MY_SRC/usrdef_zgr.F90
+++ b/tests/OVERFLOW/MY_SRC/usrdef_zgr.F90
@@ -14,8 +14,7 @@ MODULE usrdef_zgr
!! zgr_z1d : reference 1D z-coordinate
!!---------------------------------------------------------------------
USE oce ! ocean variables
- USE dom_oce , ONLY: mi0, mi1 ! ocean space and time domain
- USE dom_oce , ONLY: glamt ! ocean space and time domain
+ USE dom_oce ! ocean space and time domain
USE usrdef_nam ! User defined : namelist variables
!
USE in_out_manager ! I/O manager
@@ -94,10 +93,10 @@ CONTAINS
END_2D
CALL lbc_lnk( 'usrdef_zgr', zhu, 'U', 1. ) ! boundary condition: this mask the surrouding grid-points
! ! ==>>> set by hand non-zero value on first/last columns & rows
- DO ji = mi0(1), mi1(1) ! first row of global domain only
+ DO ji = mi0(1,nn_hls), mi1(1,nn_hls) ! first row of global domain only
zhu(ji,2) = zht(ji,2)
END DO
- DO ji = mi0(jpiglo), mi1(jpiglo) ! last row of global domain only
+ DO ji = mi0(jpiglo,nn_hls), mi1(jpiglo,nn_hls) ! last row of global domain only
zhu(ji,2) = zht(ji,2)
END DO
zhu(:,1) = zhu(:,2)
diff --git a/tests/STATION_ASF/MY_SRC/icesbc.F90 b/tests/STATION_ASF/MY_SRC/icesbc.F90
index 644ad0cfb..a03ed99fd 100644
--- a/tests/STATION_ASF/MY_SRC/icesbc.F90
+++ b/tests/STATION_ASF/MY_SRC/icesbc.F90
@@ -152,13 +152,13 @@ CONTAINS
& sf(jp_slp)%fnow(:,:,1), sf(jp_qlw)%fnow(:,:,1), &
& sf(jp_prec)%fnow(:,:,1), sf(jp_snow)%fnow(:,:,1) )
!
- IF( ln_mixcpl ) CALL sbc_cpl_ice_flx( picefr=at_i_b, palbi=alb_ice, psst=sst_m, pist=t_su, phs=h_s, phi=h_i )
+ IF( ln_mixcpl ) CALL sbc_cpl_ice_flx( kt, picefr=at_i_b, palbi=alb_ice, psst=sst_m, pist=t_su, phs=h_s, phi=h_i )
IF( nn_flxdist /= -1 ) CALL ice_flx_dist ( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_flxdist )
! ! compute conduction flux and surface temperature (as in Jules surface module)
IF( ln_cndflx .AND. .NOT.ln_cndemulate ) &
& CALL blk_ice_qcn ( ln_virtual_itd, t_su, t_bo, h_s, h_i )
CASE ( jp_purecpl ) !--- coupled formulation
- CALL sbc_cpl_ice_flx( picefr=at_i_b, palbi=alb_ice, psst=sst_m, pist=t_su, phs=h_s, phi=h_i )
+ CALL sbc_cpl_ice_flx( kt, picefr=at_i_b, palbi=alb_ice, psst=sst_m, pist=t_su, phs=h_s, phi=h_i )
IF( nn_flxdist /= -1 ) CALL ice_flx_dist ( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_flxdist )
END SELECT
diff --git a/tests/STATION_ASF/MY_SRC/stpctl.F90 b/tests/STATION_ASF/MY_SRC/stpctl.F90
index c51b35041..fd5a92146 100644
--- a/tests/STATION_ASF/MY_SRC/stpctl.F90
+++ b/tests/STATION_ASF/MY_SRC/stpctl.F90
@@ -178,7 +178,7 @@ CONTAINS
iloc(1:2,2) = MAXLOC( ABS( qns(:,:) ), mask = llmsk )
iloc(1:2,3) = MINLOC( ABS( emp(:,:) ), mask = llmsk )
DO ji = 1, jptst ! local domain indices ==> global domain indices, excluding halos
- iloc(1:2,ji) = (/ mig0(iloc(1,ji)), mjg0(iloc(2,ji)) /)
+ iloc(1:2,ji) = (/ mig(iloc(1,ji),0), mjg(iloc(2,ji),0) /)
END DO
iareamin(:) = narea ; iareamax(:) = narea ; iareasum(:) = 1 ! this is local information
ENDIF
diff --git a/tests/STATION_ASF/MY_SRC/usrdef_hgr.F90 b/tests/STATION_ASF/MY_SRC/usrdef_hgr.F90
index 65d186a5b..199dce11f 100644
--- a/tests/STATION_ASF/MY_SRC/usrdef_hgr.F90
+++ b/tests/STATION_ASF/MY_SRC/usrdef_hgr.F90
@@ -13,7 +13,6 @@ MODULE usrdef_hgr
!!----------------------------------------------------------------------
!! usr_def_hgr : initialize the horizontal mesh
!!----------------------------------------------------------------------
- USE dom_oce , ONLY: nimpp, njmpp ! ocean space and time domain
USE c1d , ONLY: rn_lon1d, rn_lat1d ! ocean lon/lat define by namelist
USE par_oce ! ocean space and time domain
USE phycst ! physical constants
diff --git a/tests/STATION_ASF/MY_SRC/usrdef_nam.F90 b/tests/STATION_ASF/MY_SRC/usrdef_nam.F90
index fda9175c2..b16e92850 100644
--- a/tests/STATION_ASF/MY_SRC/usrdef_nam.F90
+++ b/tests/STATION_ASF/MY_SRC/usrdef_nam.F90
@@ -14,7 +14,6 @@ MODULE usrdef_nam
!! usr_def_nam : read user defined namelist and set global domain size
!! usr_def_hgr : initialize the horizontal mesh
!!----------------------------------------------------------------------
- USE dom_oce , ONLY: nimpp, njmpp ! ocean space and time domain
USE par_oce ! ocean space and time domain
USE phycst ! physical constants
!
diff --git a/tests/SWG/MY_SRC/usrdef_fmask.F90 b/tests/SWG/MY_SRC/usrdef_fmask.F90
index 014180924..6ad45ee16 100644
--- a/tests/SWG/MY_SRC/usrdef_fmask.F90
+++ b/tests/SWG/MY_SRC/usrdef_fmask.F90
@@ -68,22 +68,22 @@ CONTAINS
!
IF(lwp) WRITE(numout,*) ' Gibraltar '
ij0 = 101 ; ij1 = 101 ! Gibraltar strait : partial slip (pfmsk=0.5)
- ii0 = 139 ; ii1 = 140 ; pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 0.5_wp
+ ii0 = 139 ; ii1 = 140 ; pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls) , mj0(ij0,nn_hls):mj1(ij1,nn_hls) , 1:jpk ) = 0.5_wp
ij0 = 102 ; ij1 = 102
- ii0 = 139 ; ii1 = 140 ; pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 0.5_wp
+ ii0 = 139 ; ii1 = 140 ; pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls) , mj0(ij0,nn_hls):mj1(ij1,nn_hls) , 1:jpk ) = 0.5_wp
!
IF(lwp) WRITE(numout,*) ' Bab el Mandeb '
ij0 = 87 ; ij1 = 88 ! Bab el Mandeb : partial slip (pfmsk=1)
- ii0 = 160 ; ii1 = 160 ; pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 1._wp
+ ii0 = 160 ; ii1 = 160 ; pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls) , mj0(ij0,nn_hls):mj1(ij1,nn_hls) , 1:jpk ) = 1._wp
ij0 = 88 ; ij1 = 88
- ii0 = 159 ; ii1 = 159 ; pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 1._wp
+ ii0 = 159 ; ii1 = 159 ; pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls) , mj0(ij0,nn_hls):mj1(ij1,nn_hls) , 1:jpk ) = 1._wp
!
! We keep this as an example but it is instable in this case
!IF(lwp) WRITE(numout,*) ' Danish straits '
! ij0 = 115 ; ij1 = 115 ! Danish straits : strong slip (pfmsk > 2)
- ! ii0 = 145 ; ii1 = 146 ; pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 4._wp
+ ! ii0 = 145 ; ii1 = 146 ; pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls) , mj0(ij0,nn_hls):mj1(ij1,nn_hls) , 1:jpk ) = 4._wp
! ij0 = 116 ; ij1 = 116
- ! ii0 = 145 ; ii1 = 146 ; pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 4._wp
+ ! ii0 = 145 ; ii1 = 146 ; pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls) , mj0(ij0,nn_hls):mj1(ij1,nn_hls) , 1:jpk ) = 4._wp
!
CASE( 1 ) ! R1 case
IF(lwp) WRITE(numout,*)
@@ -99,35 +99,35 @@ CONTAINS
IF(lwp) WRITE(numout,*) ' orca_r1: increase friction near the following straits : '
IF(lwp) WRITE(numout,*) ' Gibraltar '
ii0 = 282 ; ii1 = 283 ! Gibraltar Strait
- ij0 = 241 - isrow ; ij1 = 241 - isrow ; pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp
+ ij0 = 241 - isrow ; ij1 = 241 - isrow ; pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls),mj0(ij0,nn_hls):mj1(ij1,nn_hls),1:jpk ) = 2._wp
!
IF(lwp) WRITE(numout,*) ' Bhosporus '
ii0 = 314 ; ii1 = 315 ! Bhosporus Strait
- ij0 = 248 - isrow ; ij1 = 248 - isrow ; pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp
+ ij0 = 248 - isrow ; ij1 = 248 - isrow ; pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls),mj0(ij0,nn_hls):mj1(ij1,nn_hls),1:jpk ) = 2._wp
!
IF(lwp) WRITE(numout,*) ' Makassar (Top) '
ii0 = 48 ; ii1 = 48 ! Makassar Strait (Top)
- ij0 = 189 - isrow ; ij1 = 190 - isrow ; pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp
+ ij0 = 189 - isrow ; ij1 = 190 - isrow ; pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls),mj0(ij0,nn_hls):mj1(ij1,nn_hls),1:jpk ) = 3._wp
!
IF(lwp) WRITE(numout,*) ' Lombok '
ii0 = 44 ; ii1 = 44 ! Lombok Strait
- ij0 = 164 - isrow ; ij1 = 165 - isrow ; pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp
+ ij0 = 164 - isrow ; ij1 = 165 - isrow ; pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls),mj0(ij0,nn_hls):mj1(ij1,nn_hls),1:jpk ) = 2._wp
!
IF(lwp) WRITE(numout,*) ' Ombai '
ii0 = 53 ; ii1 = 53 ! Ombai Strait
- ij0 = 164 - isrow ; ij1 = 165 - isrow ; pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp
+ ij0 = 164 - isrow ; ij1 = 165 - isrow ; pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls),mj0(ij0,nn_hls):mj1(ij1,nn_hls),1:jpk ) = 2._wp
!
IF(lwp) WRITE(numout,*) ' Timor Passage '
ii0 = 56 ; ii1 = 56 ! Timor Passage
- ij0 = 164 - isrow ; ij1 = 165 - isrow ; pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp
+ ij0 = 164 - isrow ; ij1 = 165 - isrow ; pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls),mj0(ij0,nn_hls):mj1(ij1,nn_hls),1:jpk ) = 2._wp
!
IF(lwp) WRITE(numout,*) ' West Halmahera '
ii0 = 58 ; ii1 = 58 ! West Halmahera Strait
- ij0 = 181 - isrow ; ij1 = 182 - isrow ; pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp
+ ij0 = 181 - isrow ; ij1 = 182 - isrow ; pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls),mj0(ij0,nn_hls):mj1(ij1,nn_hls),1:jpk ) = 3._wp
!
IF(lwp) WRITE(numout,*) ' East Halmahera '
ii0 = 55 ; ii1 = 55 ! East Halmahera Strait
- ij0 = 181 - isrow ; ij1 = 182 - isrow ; pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp
+ ij0 = 181 - isrow ; ij1 = 182 - isrow ; pfmsk( mi0(ii0,nn_hls):mi1(ii1,nn_hls),mj0(ij0,nn_hls):mj1(ij1,nn_hls),1:jpk ) = 3._wp
!
CASE DEFAULT
IF(lwp) WRITE(numout,*)
diff --git a/tests/SWG/MY_SRC/usrdef_nam.F90 b/tests/SWG/MY_SRC/usrdef_nam.F90
index 37742d765..fb95a32ef 100644
--- a/tests/SWG/MY_SRC/usrdef_nam.F90
+++ b/tests/SWG/MY_SRC/usrdef_nam.F90
@@ -14,7 +14,6 @@ MODULE usrdef_nam
!! usr_def_nam : read user defined namelist and set global domain size
!! usr_def_hgr : initialize the horizontal mesh
!!----------------------------------------------------------------------
- USE dom_oce , ONLY: nimpp, njmpp ! ocean space and time domain
USE par_oce ! ocean space and time domain
USE phycst ! physical constants
!
diff --git a/tests/TSUNAMI/MY_SRC/usrdef_hgr.F90 b/tests/TSUNAMI/MY_SRC/usrdef_hgr.F90
index 5c9921e47..d8a5d6d84 100644
--- a/tests/TSUNAMI/MY_SRC/usrdef_hgr.F90
+++ b/tests/TSUNAMI/MY_SRC/usrdef_hgr.F90
@@ -88,8 +88,8 @@ CONTAINS
#endif
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- zti = REAL( mig0(ji)-ii0, wp ) ! =0 at i=ii0 in the global grid without halos
- ztj = REAL( mjg0(jj)-ij0, wp ) ! =0 at i=ij0 in the global grid without halos
+ zti = REAL( mig(ji,0)-ii0, wp ) ! =0 at i=ii0 in the global grid without halos
+ ztj = REAL( mjg(jj,0)-ij0, wp ) ! =0 at i=ij0 in the global grid without halos
plamt(ji,jj) = rn_dx * zti
plamu(ji,jj) = rn_dx * ( zti + 0.5_wp )
diff --git a/tests/VORTEX/MY_SRC/usrdef_hgr.F90 b/tests/VORTEX/MY_SRC/usrdef_hgr.F90
index 7721821ba..c6d0003e8 100644
--- a/tests/VORTEX/MY_SRC/usrdef_hgr.F90
+++ b/tests/VORTEX/MY_SRC/usrdef_hgr.F90
@@ -93,8 +93,8 @@ CONTAINS
ENDIF
#endif
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
- zti = REAL( mig0(ji)-1, wp ) ! start at i=0 in the global grid without halos
- ztj = REAL( mjg0(jj)-1, wp ) ! start at j=0 in the global grid without halos
+ zti = REAL( mig(ji,0)-1, wp ) ! start at i=0 in the global grid without halos
+ ztj = REAL( mjg(jj,0)-1, wp ) ! start at j=0 in the global grid without halos
plamt(ji,jj) = roffsetx + rn_dx * 1.e-3 * ( zti - 0.5_wp )
plamu(ji,jj) = roffsetx + rn_dx * 1.e-3 * zti
diff --git a/tests/WAD/MY_SRC/usrdef_hgr.F90 b/tests/WAD/MY_SRC/usrdef_hgr.F90
index 38cec157e..459c26dc3 100644
--- a/tests/WAD/MY_SRC/usrdef_hgr.F90
+++ b/tests/WAD/MY_SRC/usrdef_hgr.F90
@@ -75,14 +75,14 @@ CONTAINS
zfact = rn_dx * 1.e-3 ! conversion in km
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
! ! longitude (west coast at lon=0°)
- plamt(ji,jj) = zfact * ( - 0.5 + REAL( mig0(ji)-1 , wp ) )
- plamu(ji,jj) = zfact * ( REAL( mig0(ji)-1 , wp ) )
+ plamt(ji,jj) = zfact * ( - 0.5 + REAL( mig(ji,0)-1 , wp ) )
+ plamu(ji,jj) = zfact * ( REAL( mig(ji,0)-1 , wp ) )
plamv(ji,jj) = plamt(ji,jj)
plamf(ji,jj) = plamu(ji,jj)
! ! latitude (south coast at lat= 0°)
- pphit(ji,jj) = zfact * ( - 0.5 + REAL( mjg0(jj)-1 , wp ) )
+ pphit(ji,jj) = zfact * ( - 0.5 + REAL( mjg(jj,0)-1 , wp ) )
pphiu(ji,jj) = pphit(ji,jj)
- pphiv(ji,jj) = zfact * ( REAL( mjg0(jj)-1 , wp ) )
+ pphiv(ji,jj) = zfact * ( REAL( mjg(jj,0)-1 , wp ) )
pphif(ji,jj) = pphiv(ji,jj)
END_2D
!
diff --git a/tests/WAD/MY_SRC/usrdef_istate.F90 b/tests/WAD/MY_SRC/usrdef_istate.F90
index b34b77c77..36896424d 100644
--- a/tests/WAD/MY_SRC/usrdef_istate.F90
+++ b/tests/WAD/MY_SRC/usrdef_istate.F90
@@ -13,8 +13,7 @@ MODULE usrdef_istate
!!----------------------------------------------------------------------
!! usr_def_istate : initial state in Temperature and salinity
!!----------------------------------------------------------------------
- USE par_oce ! ocean space and time domain
- USE dom_oce , ONLY : mi0, mig, mjg, glamt, gphit, ht_0
+ USE dom_oce ! ocean space and time domain
USE phycst ! physical constants
USE wet_dry ! Wetting and drying
!
@@ -44,7 +43,7 @@ CONTAINS
!! ** Purpose : Initialization of the dynamics and tracers
!! Here WAD_TEST_CASES configuration
!!
-q !! ** Method : - set temprature field
+ !! ** Method : - set temprature field
!! - set salinity field
!!----------------------------------------------------------------------
REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: pdept ! depth of t-point [m]
@@ -116,7 +115,7 @@ q !! ** Method : - set temprature field
IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Parobolic EW channel with gaussian ridge'
IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
!
- DO ji = mi0(jpiglo/2), mi0(jpiglo)
+ DO ji = mi0(jpiglo/2,nn_hls), mi1(jpiglo,nn_hls)
pts(ji,:,:,jp_sal) = 30._wp
END DO
!
@@ -230,7 +229,7 @@ q !! ** Method : - set temprature field
pssh(ji,:) = ( -2.5_wp + 5.5_wp*(50._wp-glamt(ji,1))/50._wp)*ptmask(ji,:,1)
END DO
!
- DO ji = mi0(jpiglo/2), mi0(jpiglo)
+ DO ji = mi0(jpiglo/2,nn_hls), mi1(jpiglo,nn_hls)
pssh(ji,:) = -0.1*ptmask(ji,:,1)
END DO
!
diff --git a/tests/WAD/MY_SRC/usrdef_zgr.F90 b/tests/WAD/MY_SRC/usrdef_zgr.F90
index eab2b9a32..df9970a0b 100644
--- a/tests/WAD/MY_SRC/usrdef_zgr.F90
+++ b/tests/WAD/MY_SRC/usrdef_zgr.F90
@@ -14,7 +14,7 @@ MODULE usrdef_zgr
!! zgr_z : reference 1D z-coordinate
!!---------------------------------------------------------------------
USE oce ! ocean variables
- USE dom_oce , ONLY: ht_0, mi0, mi1, mj0, mj1, glamt, gphit ! ocean space and time domain
+ USE dom_oce ! ocean space and time domain
USE usrdef_nam ! User defined : namelist variables
USE wet_dry , ONLY: rn_wdmin1, rn_wdmin2, rn_wdld ! Wetting and drying
!
@@ -101,10 +101,10 @@ CONTAINS
zi = MIN((glamt(ji,1) - 10.0)/40.0, 1.0 )
zht(ji,:) = MAX(zbathy*zi, -2.0)
END DO
- zht(mi0(1):mi1(1),:) = -4._wp
- zht(mi0(jpiglo):mi1(jpiglo),:) = -4._wp
- zht(:,mj0(1):mj1(1)) = -4._wp
- zht(:,mj0(jpjglo):mj1(jpjglo)) = -4._wp
+ zht(mi0( 1,nn_hls):mi1( 1,nn_hls),:) = -4._wp
+ zht(mi0(jpiglo,nn_hls):mi1(jpiglo,nn_hls),:) = -4._wp
+ zht(:,mj0( 1,nn_hls):mj1( 1,nn_hls)) = -4._wp
+ zht(:,mj0(jpjglo,nn_hls):mj1(jpjglo,nn_hls)) = -4._wp
! ! ====================
CASE ( 2, 3, 8 ) ! WAD 2 or 3 configuration
! ! ====================
@@ -117,11 +117,11 @@ CONTAINS
zi = MAX(1.0-((glamt(ji,1)-25.0)**2)/484.0, -0.3 )
zht(ji,:) = MAX(zbathy*zi, -2.0)
END DO
- zht(mi0(1):mi1(1),:) = -4._wp
- zht(mi0(jpiglo):mi1(jpiglo),:) = -4._wp
+ zht(mi0( 1,nn_hls):mi1( 1,nn_hls),:) = -4._wp
+ zht(mi0(jpiglo,nn_hls):mi1(jpiglo,nn_hls),:) = -4._wp
IF( nn_cfg /= 8 ) THEN
- zht(:,mj0(1):mj1(1)) = -4._wp
- zht(:,mj0(jpjglo):mj1(jpjglo)) = -4._wp
+ zht(:,mj0( 1,nn_hls):mj1( 1,nn_hls)) = -4._wp
+ zht(:,mj0(jpjglo,nn_hls):mj1(jpjglo,nn_hls)) = -4._wp
ENDIF
! ! ====================
CASE ( 4 ) ! WAD 4 configuration
@@ -138,10 +138,10 @@ CONTAINS
zht(ji,jj) = MAX(zbathy*zi*zj, -2.0)
END DO
END DO
- zht(mi0(1):mi1(1),:) = -4._wp
- zht(mi0(jpiglo):mi1(jpiglo),:) = -4._wp
- zht(:,mj0(1):mj1(1)) = -4._wp
- zht(:,mj0(jpjglo):mj1(jpjglo)) = -4._wp
+ zht(mi0(1 ,nn_hls):mi1( 1,nn_hls),:) = -4._wp
+ zht(mi0(jpiglo,nn_hls):mi1(jpiglo,nn_hls),:) = -4._wp
+ zht(:,mj0( 1,nn_hls):mj1( 1,nn_hls)) = -4._wp
+ zht(:,mj0(jpjglo,nn_hls):mj1(jpjglo,nn_hls)) = -4._wp
! ! ===========================
CASE ( 5 ) ! WAD 5 configuration
! ! ====================
@@ -168,10 +168,10 @@ CONTAINS
ENDIF
END DO
! ! ===========================
- zht(mi0(1):mi1(1),:) = -4._wp
- zht(mi0(jpiglo):mi1(jpiglo),:) = -4._wp
- zht(:,mj0(1):mj1(1)) = -4._wp
- zht(:,mj0(jpjglo):mj1(jpjglo)) = -4._wp
+ zht(mi0( 1,nn_hls):mi1( 1,nn_hls),:) = -4._wp
+ zht(mi0(jpiglo,nn_hls):mi1(jpiglo,nn_hls),:) = -4._wp
+ zht(:,mj0( 1,nn_hls):mj1( 1,nn_hls)) = -4._wp
+ zht(:,mj0(jpjglo,nn_hls):mj1(jpjglo,nn_hls)) = -4._wp
! ! ===========================
CASE ( 6 ) ! WAD 6 configuration
! ! ====================
@@ -185,10 +185,10 @@ CONTAINS
zj = 1.075*MAX(EXP(-1.0*((glamt(ji,1)-25.0)**2)/32.0) , 0.0 )
zht(ji,:) = MAX(zbathy*(zi-zj), -2.0)
END DO
- zht(mi0(1):mi1(1),:) = -4._wp
- zht(mi0(jpiglo):mi1(jpiglo),:) = -4._wp
- zht(:,mj0(1):mj1(1)) = -4._wp
- zht(:,mj0(jpjglo):mj1(jpjglo)) = -4._wp
+ zht(mi0( 1,nn_hls):mi1( 1,nn_hls),:) = -4._wp
+ zht(mi0(jpiglo,nn_hls):mi1(jpiglo,nn_hls),:) = -4._wp
+ zht(:,mj0( 1,nn_hls):mj1( 1,nn_hls)) = -4._wp
+ zht(:,mj0(jpjglo,nn_hls):mj1(jpjglo,nn_hls)) = -4._wp
! ! ===========================
CASE ( 7 ) ! WAD 7 configuration
! ! ====================
@@ -215,9 +215,9 @@ CONTAINS
ENDIF
END DO
! ! ===========================
- zht(mi0(1):mi1(1),:) = -4._wp
- zht(:,mj0(1):mj1(1)) = -4._wp
- zht(:,mj0(jpjglo):mj1(jpjglo)) = -4._wp
+ zht(mi0( 1,nn_hls):mi1( 1,nn_hls),:) = -4._wp
+ zht(:,mj0( 1,nn_hls):mj1( 1,nn_hls)) = -4._wp
+ zht(:,mj0(jpjglo,nn_hls):mj1(jpjglo,nn_hls)) = -4._wp
CASE DEFAULT
! ! ===========================
WRITE(ctmp1,*) 'WAD test with a ', nn_cfg,' option is not coded'
@@ -234,10 +234,10 @@ CONTAINS
END_2D
CALL lbc_lnk( 'usrdef_zgr', zhu, 'U', 1. ) ! boundary condition: this mask the surrounding grid-points
! ! ==>>> set by hand non-zero value on first/last columns & rows
- DO ji = mi0(1), mi1(1) ! first row of global domain only
+ DO ji = mi0( 1,nn_hls), mi1( 1,nn_hls) ! first row of global domain only
zhu(ji,:) = zht(1,:)
END DO
- DO ji = mi0(jpiglo), mi1(jpiglo) ! last row of global domain only
+ DO ji = mi0(jpiglo,nn_hls), mi1(jpiglo,nn_hls) ! last row of global domain only
zhu(ji,:) = zht(jpi,:)
END DO
! at v-point: averaging zht
@@ -246,10 +246,10 @@ CONTAINS
zhv(ji,jj) = 0.5_wp * ( zht(ji,jj) + zht(ji,jj+1) )
END_2D
CALL lbc_lnk( 'usrdef_zgr', zhv, 'V', 1. ) ! boundary condition: this mask the surrounding grid-points
- DO jj = mj0(1), mj1(1) ! first row of global domain only
+ DO jj = mj0( 1,nn_hls), mj1( 1,nn_hls) ! first row of global domain only
zhv(:,jj) = zht(:,jj)
END DO
- DO jj = mj0(jpjglo), mj1(jpjglo) ! last row of global domain only
+ DO jj = mj0(jpjglo,nn_hls), mj1(jpjglo,nn_hls) ! last row of global domain only
zhv(:,jj) = zht(:,jj)
END DO
!
@@ -261,10 +261,10 @@ CONTAINS
! no ocean cavities : top ocean level is ONE, except over land
! the ocean basin surrounnded by land (1+nn_hls grid-points) set through lbc_lnk call
z2d(:,:) = 1._wp ! surface ocean is the 1st level
- z2d(mi0(1):mi1(1),:) = 0._wp
- z2d(mi0(jpiglo):mi1(jpiglo),:) = 0._wp
- z2d(:,mj0(1):mj1(1)) = 0._wp
- z2d(:,mj0(jpjglo):mj1(jpjglo)) = 0._wp
+ z2d(mi0( 1,nn_hls):mi1( 1,nn_hls),:) = 0._wp
+ z2d(mi0(jpiglo,nn_hls):mi1(jpiglo,nn_hls),:) = 0._wp
+ z2d(:,mj0( 1,nn_hls):mj1( 1,nn_hls)) = 0._wp
+ z2d(:,mj0(jpjglo,nn_hls):mj1(jpjglo,nn_hls)) = 0._wp
CALL lbc_lnk( 'usrdef_zgr', z2d, 'T', 1. ) ! closed basin, see userdef_nam.F90
k_top(:,:) = NINT( z2d(:,:) )
--
GitLab