Skip to content
Snippets Groups Projects
Commit 02d75a13 authored by Sebastien MASSON's avatar Sebastien MASSON
Browse files

minor change in F-point North fold, #68

parent 1ae472a1
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
src/OCE/LBC/lbc_nfd_generic.h90
+ 1
− 24
View file @ 02d75a13
......@@ -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
......
src/OCE/LBC/mpp_nfd_generic.h90
+ 10
− 16
View file @ 02d75a13
......@@ -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)
......
tests/BENCH/MY_SRC/usrdef_zgr.F90
+ 4
− 4
View file @ 02d75a13
......@@ -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)
!
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment