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 @@ ...@@ -196,30 +196,7 @@
CASE ( 'T' , 'W' ) ! T-, W-point CASE ( 'T' , 'W' ) ! T-, W-point
DO jl = 1, ipl ; DO jk = 1, ipk DO jl = 1, ipl ; DO jk = 1, ipk
! !
! first: line number ipj-ihls : 3 points ! last ihls lines (from ipj to ipj-ihls+1) : full
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
DO jj = 1, ihls DO jj = 1, ihls
ij1 = ipj + 1 - jj ! ends at: ipj + 1 - ihls ij1 = ipj + 1 - jj ! ends at: ipj + 1 - ihls
ij2 = ipj - 2*ihls + jj ! ends at: ipj - 2*ihls + ihls = ipj - 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 @@ ...@@ -13,7 +13,7 @@
INTEGER :: ierr, ibuffsize, impp, ipi0 INTEGER :: ierr, ibuffsize, impp, ipi0
INTEGER :: ii1, ii2, ij1, ij2, ij3, iig, inei INTEGER :: ii1, ii2, ij1, ij2, ij3, iig, inei
INTEGER :: i0max, ilntot, iisht, ijsht, ihsz 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) :: ipi, ipj, ipj1, ipj2, ipk, ipl ! dimension of the input array
INTEGER, DIMENSION(kfld) :: ihls ! halo size INTEGER, DIMENSION(kfld) :: ihls ! halo size
INTEGER, DIMENSION(:) , ALLOCATABLE :: ireq_s, ireq_r ! for mpi_isend when avoiding mpi_allgather INTEGER, DIMENSION(:) , ALLOCATABLE :: ireq_s, ireq_r ! for mpi_isend when avoiding mpi_allgather
...@@ -47,7 +47,6 @@ ...@@ -47,7 +47,6 @@
! - c_NFtype='T', grid=U : half of the last line (jpiglo/2+1:jpiglo-nn_hls) ! - 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=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='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=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=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) ! - c_NFtype='F', grid=F : half of the last line (jpiglo/2+1:jpiglo-nn_hls-1)
...@@ -64,8 +63,7 @@ ...@@ -64,8 +63,7 @@
ALLOCATE(ipjfld(kfld)) ! how many lines do we send for each field? ALLOCATE(ipjfld(kfld)) ! how many lines do we send for each field?
IF( llfull ) THEN IF( llfull ) THEN
DO jf = 1, kfld ! Loop over the number of arrays to be processed 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' /) ) & 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 END DO
ELSE ELSE
ipjfld(:) = ihls(:) ipjfld(:) = ihls(:)
...@@ -80,8 +78,7 @@ ...@@ -80,8 +78,7 @@
ij1 = 0 ij1 = 0
DO jf = 1, kfld DO jf = 1, kfld
! !
i012 = COUNT( (/ c_NFtype == 'T' /) ) + COUNT( (/ cd_nat(jf) == 'V' .OR. cd_nat(jf) == 'F' /) ) & i012 = COUNT( (/ c_NFtype == 'T' /) ) + COUNT( (/ cd_nat(jf) == 'V' .OR. cd_nat(jf) == 'F' /) ) ! 0, 1 OR 2
& + 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) 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 jl = 1, ipl(jf) ; DO jk = 1, ipk(jf)
...@@ -171,7 +168,6 @@ ...@@ -171,7 +168,6 @@
! !
ihsz = ihls(jf) ! shorter name ihsz = ihls(jf) ! shorter name
iisht = nn_hls - ihsz 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) DO jl = 1, ipl(jf) ; DO jk = 1, ipk(jf)
! !
...@@ -187,9 +183,9 @@ ...@@ -187,9 +183,9 @@
ptab(jf)%pt4d(ji,ij1,jk,jl) = psgn(jf) * zbufr(ii2,ij2,inei) ptab(jf)%pt4d(ji,ij1,jk,jl) = psgn(jf) * zbufr(ii2,ij2,inei)
END DO END DO
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) 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 ij3 = 1
DO ji = 1, ipi(jf) DO ji = 1, ipi(jf)
ii1 = ji + iisht ii1 = ji + iisht
...@@ -215,11 +211,9 @@ ...@@ -215,11 +211,9 @@
! !
DO jf = 1, kfld DO jf = 1, kfld
! how many lines do we send for each field? ! 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' /) ) & 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? ! 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' /) ) & 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 END DO
! !
i0max = MAXVAL( nfni_0, mask = nfproc /= -1 ) ! largest value of Ni_0 among processors (we are not sending halos) i0max = MAXVAL( nfni_0, mask = nfproc /= -1 ) ! largest value of Ni_0 among processors (we are not sending halos)
...@@ -256,8 +250,8 @@ ...@@ -256,8 +250,8 @@
iisht = nn_hls - ihsz iisht = nn_hls - ihsz
ALLOCATE( ztabglo(1)%pt4d(Ni0glo+2*ihsz,ipj2(jf),ipk(jf),ipl(jf)) ) 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_TU = COUNT( (/ c_NFtype == 'F' .AND. ( cd_nat(jf) == 'U' .OR. cd_nat(jf) == 'T' ) /) ) ! F-folding and T or U grid
IF( iFU == 0 ) ztabglo(1)%pt4d(:,ipj2(jf)-ihsz,:,:) = zhuge ! flag off the line that is not fully modified 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 ! need to fill only the first ipj1(j) lines of ztabglo as lbc_nfd don't use the last ihsz lines
ijnr = 0 ijnr = 0
...@@ -319,7 +313,7 @@ ...@@ -319,7 +313,7 @@
ptab(jf)%pt4d(ji,ij1,jk,jl) = ztabglo(1)%pt4d(ii2,ij2,jk,jl) ptab(jf)%pt4d(ji,ij1,jk,jl) = ztabglo(1)%pt4d(ii2,ij2,jk,jl)
END DO END DO
END DO END DO
DO jj = ihsz, ihsz - iFU DO jj = ihsz, ihsz - iF_TU
ij1 = ipj( jf) - jj ! last ihsz+1 line ij1 = ipj( jf) - jj ! last ihsz+1 line
ij2 = ipj2(jf) - jj ! last ihsz+1 line ij2 = ipj2(jf) - jj ! last ihsz+1 line
DO ji= 1, ipi(jf) DO ji= 1, ipi(jf)
......
tests/BENCH/MY_SRC/usrdef_zgr.F90
+ 4
− 4
View file @ 02d75a13
...@@ -202,10 +202,10 @@ CONTAINS ...@@ -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 !!$ 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 !!$ ENDIF
!!$ ! !!$ !
IF( c_NFtype == 'F' ) THEN ! Must mask the 2 pivot-points !!$ 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(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 !!$ 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 !!$ ENDIF
! !
CALL lbc_lnk( 'usrdef_zgr', z2d, 'T', 1._wp ) ! set surrounding land to zero (closed boundaries) 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