From 02d75a13a5e6712d7a240997884db86cefd72381 Mon Sep 17 00:00:00 2001
From: Sebastien MASSON <massons@irene150.c-irene.tgcc.ccc.cea.fr>
Date: Fri, 23 Sep 2022 16:35:42 +0200
Subject: [PATCH] minor change in F-point North fold, #68
---
src/OCE/LBC/lbc_nfd_generic.h90 | 25 +------------------------
src/OCE/LBC/mpp_nfd_generic.h90 | 26 ++++++++++----------------
tests/BENCH/MY_SRC/usrdef_zgr.F90 | 8 ++++----
3 files changed, 15 insertions(+), 44 deletions(-)
diff --git a/src/OCE/LBC/lbc_nfd_generic.h90 b/src/OCE/LBC/lbc_nfd_generic.h90
index fdfa8b62b..fa20805f5 100644
--- a/src/OCE/LBC/lbc_nfd_generic.h90
+++ b/src/OCE/LBC/lbc_nfd_generic.h90
@@ -196,30 +196,7 @@
CASE ( 'T' , 'W' ) ! T-, W-point
DO jl = 1, ipl ; DO jk = 1, ipk
!
- ! first: line number ipj-ihls : 3 points
- DO jj = 1, 1
- ij1 = ipj - ihls
- ij2 = ij1 ! same line
- !
- DO ji = 1, 1 ! points from ipi/2+1
- ii1 = ipi/2 + ji
- 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 - 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, 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 ihls lines (from ipj to ipj-ihls+1) : full
+ ! 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
diff --git a/src/OCE/LBC/mpp_nfd_generic.h90 b/src/OCE/LBC/mpp_nfd_generic.h90
index b6bee828e..20ecf8ac2 100644
--- a/src/OCE/LBC/mpp_nfd_generic.h90
+++ b/src/OCE/LBC/mpp_nfd_generic.h90
@@ -13,7 +13,7 @@
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 :: iproc, ijnr, ipjtot, iF_TU, 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
@@ -47,7 +47,6 @@
! - c_NFtype='T', grid=U : half of the last line (jpiglo/2+1:jpiglo-nn_hls)
! - c_NFtype='T', grid=V : all the last line nn_hls+1 and (nn_hls+2:jpiglo-nn_hls)
! - c_NFtype='T', grid=F : all the last line (nn_hls+1:jpiglo-nn_hls)
- ! - c_NFtype='F', grid=T : 2 points of the last line (jpiglo/2+1 and jpglo-nn_hls)
! - c_NFtype='F', grid=U : no points are duplicated
! - c_NFtype='F', grid=V : half of the last line (jpiglo/2+1:jpiglo-nn_hls)
! - c_NFtype='F', grid=F : half of the last line (jpiglo/2+1:jpiglo-nn_hls-1)
@@ -64,8 +63,7 @@
ALLOCATE(ipjfld(kfld)) ! how many lines do we send for each field?
IF( llfull ) THEN
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 /) )
+ ipjfld(jf) = ihls(jf) + COUNT( (/ c_NFtype == 'T' .OR. cd_nat(jf) == 'V' .OR. cd_nat(jf) == 'F' /) )
END DO
ELSE
ipjfld(:) = ihls(:)
@@ -80,8 +78,7 @@
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
+ i012 = COUNT( (/ c_NFtype == 'T' /) ) + COUNT( (/ cd_nat(jf) == 'V' .OR. cd_nat(jf) == '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)
@@ -171,7 +168,6 @@
!
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)
!
@@ -187,9 +183,9 @@
ptab(jf)%pt4d(ji,ij1,jk,jl) = psgn(jf) * zbufr(ii2,ij2,inei)
END DO
END DO
- DO jj = ihsz+1, ipjfld(jf)+iFT ! NP folding for line ipj-ihsz that can be partially modified
+ DO jj = ihsz+1, ipjfld(jf) ! 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
+ ij2 = ij2 + 1
ij3 = 1
DO ji = 1, ipi(jf)
ii1 = ji + iisht
@@ -215,11 +211,9 @@
!
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 /) )
+ ipj1(jf) = ihls(jf) + COUNT( (/ c_NFtype == 'T' .OR. cd_nat(jf) == 'V' .OR. cd_nat(jf) == 'F' /) )
! 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 /) )
+ ipj2(jf) = 2 * ihls(jf) + COUNT( (/ c_NFtype == 'T' /) ) + COUNT( (/ cd_nat(jf) == 'V' .OR. cd_nat(jf) == 'F' /) )
END DO
!
i0max = MAXVAL( nfni_0, mask = nfproc /= -1 ) ! largest value of Ni_0 among processors (we are not sending halos)
@@ -256,8 +250,8 @@
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
+ iF_TU = COUNT( (/ c_NFtype == 'F' .AND. ( cd_nat(jf) == 'U' .OR. cd_nat(jf) == 'T' ) /) ) ! F-folding and T or U grid
+ IF( iF_TU == 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
@@ -319,7 +313,7 @@
ptab(jf)%pt4d(ji,ij1,jk,jl) = ztabglo(1)%pt4d(ii2,ij2,jk,jl)
END DO
END DO
- DO jj = ihsz, ihsz - iFU
+ DO jj = ihsz, ihsz - iF_TU
ij1 = ipj( jf) - jj ! last ihsz+1 line
ij2 = ipj2(jf) - jj ! last ihsz+1 line
DO ji= 1, ipi(jf)
diff --git a/tests/BENCH/MY_SRC/usrdef_zgr.F90 b/tests/BENCH/MY_SRC/usrdef_zgr.F90
index fe5d7de80..3a3818bfe 100644
--- a/tests/BENCH/MY_SRC/usrdef_zgr.F90
+++ b/tests/BENCH/MY_SRC/usrdef_zgr.F90
@@ -202,10 +202,10 @@ CONTAINS
!!$ 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,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
+!!$ IF( c_NFtype == 'F' ) THEN ! Must mask the 2 pivot-points
+!!$ 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)
!
--
GitLab