Changeset 14363
- Timestamp:
- 2021-02-01T08:34:52+01:00 (3 years ago)
- Location:
- NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE
- Files:
-
- 11 edited
-
BDY/bdyini.F90 (modified) (3 diffs)
-
LBC/lbc_lnk_call_generic.h90 (modified) (3 diffs)
-
LBC/lbc_lnk_neicoll_generic.h90 (modified) (13 diffs)
-
LBC/lbc_lnk_pt2pt_generic.h90 (modified) (16 diffs)
-
LBC/lbc_nfd_generic.h90 (modified) (9 diffs)
-
LBC/lbc_nfd_nogather_generic.h90 (modified) (25 diffs)
-
LBC/lib_mpp.F90 (modified) (4 diffs)
-
LBC/mpp_nfd_generic.h90 (modified) (13 diffs)
-
LBC/mppini.F90 (modified) (15 diffs)
-
SBC/sbcblk.F90 (modified) (2 diffs)
-
lib_fortran.F90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/BDY/bdyini.F90
r14338 r14363 573 573 ! check if point has to be sent to a neighbour 574 574 ! W neighbour and on the inner left side 575 IF( ii == 2 .AND. mpi nei(jpwe) > -1 ) lsend_bdy(ib_bdy,igrd,jpwe,ir) = .TRUE.575 IF( ii == 2 .AND. mpiSnei(nn_hls,jpwe) > -1 ) lsend_bdy(ib_bdy,igrd,jpwe,ir) = .TRUE. 576 576 ! E neighbour and on the inner right side 577 IF( ii == jpi-1 .AND. mpi nei(jpea) > -1 ) lsend_bdy(ib_bdy,igrd,jpea,ir) = .TRUE.577 IF( ii == jpi-1 .AND. mpiSnei(nn_hls,jpea) > -1 ) lsend_bdy(ib_bdy,igrd,jpea,ir) = .TRUE. 578 578 ! S neighbour and on the inner down side 579 IF( ij == 2 .AND. mpi nei(jpso) > -1 ) lsend_bdy(ib_bdy,igrd,jpso,ir) = .TRUE.579 IF( ij == 2 .AND. mpiSnei(nn_hls,jpso) > -1 ) lsend_bdy(ib_bdy,igrd,jpso,ir) = .TRUE. 580 580 ! N neighbour and on the inner up side 581 IF( ij == jpj-1 .AND. mpi nei(jpno) > -1 ) lsend_bdy(ib_bdy,igrd,jpno,ir) = .TRUE.581 IF( ij == jpj-1 .AND. mpiSnei(nn_hls,jpno) > -1 ) lsend_bdy(ib_bdy,igrd,jpno,ir) = .TRUE. 582 582 ! 583 583 ! check if point has to be received from a neighbour 584 584 ! W neighbour and on the outter left side 585 IF( ii == 1 .AND. mpi nei(jpwe) > -1 ) lrecv_bdy(ib_bdy,igrd,jpwe,ir) = .TRUE.585 IF( ii == 1 .AND. mpiRnei(nn_hls,jpwe) > -1 ) lrecv_bdy(ib_bdy,igrd,jpwe,ir) = .TRUE. 586 586 ! E neighbour and on the outter right side 587 IF( ii == jpi .AND. mpi nei(jpea) > -1 ) lrecv_bdy(ib_bdy,igrd,jpea,ir) = .TRUE.587 IF( ii == jpi .AND. mpiRnei(nn_hls,jpea) > -1 ) lrecv_bdy(ib_bdy,igrd,jpea,ir) = .TRUE. 588 588 ! S neighbour and on the outter down side 589 IF( ij == 1 .AND. mpi nei(jpso) > -1 ) lrecv_bdy(ib_bdy,igrd,jpso,ir) = .TRUE.589 IF( ij == 1 .AND. mpiRnei(nn_hls,jpso) > -1 ) lrecv_bdy(ib_bdy,igrd,jpso,ir) = .TRUE. 590 590 ! N neighbour and on the outter up side 591 IF( ij == jpj .AND. mpi nei(jpno) > -1 ) lrecv_bdy(ib_bdy,igrd,jpno,ir) = .TRUE.591 IF( ij == jpj .AND. mpiRnei(nn_hls,jpno) > -1 ) lrecv_bdy(ib_bdy,igrd,jpno,ir) = .TRUE. 592 592 ! 593 593 END DO … … 746 746 ! : | x:o | neighbour limited by ... would need o | o:x | : 747 747 ! :.....|_._:_____| (1) W neighbour E neighbour (2) |_____:_._|.....: 748 IF( ii==2 .AND. mpi nei(jpwe) > -1 .AND. &748 IF( ii==2 .AND. mpiSnei(nn_hls,jpwe) > -1 .AND. & 749 749 & ( iibi==3 .OR. ii1==3 .OR. ii2==3 .OR. ii3==3 ) ) lsend_bdyint(ib_bdy,igrd,jpwe,ir) = .TRUE. 750 IF( ii==jpi-1 .AND. mpi nei(jpea) > -1 .AND. &750 IF( ii==jpi-1 .AND. mpiSnei(nn_hls,jpea) > -1 .AND. & 751 751 & ( iibi==jpi-2 .OR. ii1==jpi-2 .OR. ii2==jpi-2 .OR. ii3==jpi-2) ) lsend_bdyint(ib_bdy,igrd,jpea,ir) = .TRUE. 752 IF( ii==2 .AND. mpi nei(jpwe) > -1.AND. iibe==3 ) lsend_bdyext(ib_bdy,igrd,jpwe,ir) = .TRUE.753 IF( ii==jpi-1 .AND. mpi nei(jpea) > -1.AND. iibe==jpi-2 ) lsend_bdyext(ib_bdy,igrd,jpea,ir) = .TRUE.752 IF( ii==2 .AND. mpiSnei(nn_hls,jpwe) > -1 .AND. iibe==3 ) lsend_bdyext(ib_bdy,igrd,jpwe,ir) = .TRUE. 753 IF( ii==jpi-1 .AND. mpiSnei(nn_hls,jpea) > -1 .AND. iibe==jpi-2 ) lsend_bdyext(ib_bdy,igrd,jpea,ir) = .TRUE. 754 754 ! 755 755 ! search neighbour in the north/south direction … … 766 766 ! | |¨¨¨¨x¨¨¨¨| neighbour limited by ... would need o | |....x....| 767 767 ! :_________: (3) S neighbour N neighbour (4) v | o | 768 IF( ij==2 .AND. mpi nei(jpso) > -1 .AND. &768 IF( ij==2 .AND. mpiSnei(nn_hls,jpso) > -1 .AND. & 769 769 & ( ijbi==3 .OR. ij1==3 .OR. ij2==3 .OR. ij3==3 ) ) lsend_bdyint(ib_bdy,igrd,jpso,ir) = .TRUE. 770 IF( ij==jpj-1 .AND. mpi nei(jpno) > -1 .AND. &770 IF( ij==jpj-1 .AND. mpiSnei(nn_hls,jpno) > -1 .AND. & 771 771 & ( ijbi==jpj-2 .OR. ij1==jpj-2 .OR. ij2==jpj-2 .OR. ij3==jpj-2) ) lsend_bdyint(ib_bdy,igrd,jpno,ir) = .TRUE. 772 IF( ij==2 .AND. mpi nei(jpso) > -1.AND. ijbe==3 ) lsend_bdyext(ib_bdy,igrd,jpso,ir) = .TRUE.773 IF( ij==jpj-1 .AND. mpi nei(jpno) > -1.AND. ijbe==jpj-2 ) lsend_bdyext(ib_bdy,igrd,jpno,ir) = .TRUE.772 IF( ij==2 .AND. mpiSnei(nn_hls,jpso) > -1 .AND. ijbe==3 ) lsend_bdyext(ib_bdy,igrd,jpso,ir) = .TRUE. 773 IF( ij==jpj-1 .AND. mpiSnei(nn_hls,jpno) > -1 .AND. ijbe==jpj-2 ) lsend_bdyext(ib_bdy,igrd,jpno,ir) = .TRUE. 774 774 END DO 775 775 END DO -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC/lbc_lnk_call_generic.h90
r14349 r14363 24 24 & , pt9 , cdna9 , psgn9 , pt10, cdna10, psgn10, pt11, cdna11, psgn11, pt12, cdna12, psgn12 & 25 25 & , pt13, cdna13, psgn13, pt14, cdna14, psgn14, pt15, cdna15, psgn15, pt16, cdna16, psgn16 & 26 & , kfillmode, pfillval, lsend, lrecv, ncsten )26 & , kfillmode, pfillval, khls, lsend, lrecv, ncsten ) 27 27 !!--------------------------------------------------------------------- 28 28 CHARACTER(len=*) , INTENT(in ) :: cdname ! name of the calling subroutine … … 38 38 INTEGER , OPTIONAL , INTENT(in ) :: kfillmode ! filling method for halo over land (default = constant) 39 39 REAL(PRECISION) , OPTIONAL , INTENT(in ) :: pfillval ! background value (used at closed boundaries) 40 INTEGER , OPTIONAL , INTENT(in ) :: khls ! halo size, default = nn_hls 40 41 LOGICAL, DIMENSION(4), OPTIONAL , INTENT(in ) :: lsend, lrecv ! indicate how communications are to be carried out 41 42 LOGICAL , OPTIONAL , INTENT(in ) :: ncsten … … 70 71 ! 71 72 IF( nn_comm == 1 ) THEN 72 CALL lbc_lnk_pt2pt( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, lsend, lrecv )73 CALL lbc_lnk_pt2pt( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, khls, lsend, lrecv ) 73 74 ELSE 74 CALL lbc_lnk_neicoll( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, lsend, lrecv, ncsten )75 CALL lbc_lnk_neicoll( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, khls, lsend, lrecv, ncsten ) 75 76 ENDIF 76 77 ! -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC/lbc_lnk_neicoll_generic.h90
r14349 r14363 1 1 2 SUBROUTINE lbc_lnk_neicoll_/**/PRECISION( cdname, ptab, cd_nat, psgn, kfld, kfillmode, pfillval, lsend, lrecv, ncsten )2 SUBROUTINE lbc_lnk_neicoll_/**/PRECISION( cdname, ptab, cd_nat, psgn, kfld, kfillmode, pfillval, khls, lsend, lrecv, ncsten ) 3 3 CHARACTER(len=*) , INTENT(in ) :: cdname ! name of the calling subroutine 4 4 TYPE(PTR_4d_/**/PRECISION), DIMENSION(:), INTENT(inout) :: ptab ! pointer of arrays on which apply the b.c. … … 8 8 INTEGER , OPTIONAL, INTENT(in ) :: kfillmode ! filling method for halo over land (default = constant) 9 9 REAL(PRECISION), OPTIONAL, INTENT(in ) :: pfillval ! background value (used at closed boundaries) 10 INTEGER , OPTIONAL, INTENT(in ) :: khls ! halo size, default = nn_hls 10 11 LOGICAL, DIMENSION(4),OPTIONAL, INTENT(in ) :: lsend, lrecv ! communication with other 4 proc 11 12 LOGICAL, OPTIONAL, INTENT(in ) :: ncsten ! 5-point or 9-point stencil 12 13 ! 13 INTEGER :: ji, jj, jk, jl,jf, jn ! dummy loop indices14 INTEGER :: ip k, ipl, ipf! dimension of the input array14 INTEGER :: ji, jj, jk , jl, jf, jn ! dummy loop indices 15 INTEGER :: ipi, ipj, ipk, ipl, ipf ! dimension of the input array 15 16 INTEGER :: ip0i, ip1i, im0i, im1i 16 17 INTEGER :: ip0j, ip1j, im0j, im1j … … 18 19 INTEGER :: iszs, iszr 19 20 INTEGER :: ierr 20 INTEGER :: i dx21 INTEGER :: ihls, idx 21 22 INTEGER :: impi_nc 22 23 INTEGER :: ifill_nfd 23 24 INTEGER, DIMENSION(4) :: iwewe, issnn 24 INTEGER, DIMENSION(8) :: isizei, isht si, ishtri, ishtpi25 INTEGER, DIMENSION(8) :: isizej, isht sj, ishtrj, ishtpj25 INTEGER, DIMENSION(8) :: isizei, ishtSi, ishtRi, ishtPi 26 INTEGER, DIMENSION(8) :: isizej, ishtSj, ishtRj, ishtPj 26 27 INTEGER, DIMENSION(8) :: ifill, iszall 27 28 INTEGER, DIMENSION(:), ALLOCATABLE :: icounts, icountr ! number of elements to be sent/received … … 38 39 ! ----------------------------------------- ! 39 40 ! 41 ipi = SIZE(ptab(1)%pt4d,1) 42 ipj = SIZE(ptab(1)%pt4d,2) 40 43 ipk = SIZE(ptab(1)%pt4d,3) 41 44 ipl = SIZE(ptab(1)%pt4d,4) … … 46 49 ! take care of optional parameters 47 50 ! 48 llncall = .TRUE. 51 ihls = nn_hls ! default definition 52 IF( PRESENT( khls ) ) ihls = khls 53 IF( ihls > n_hlsmax ) THEN 54 WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk with khls > n_hlsmax : ', khls, '>', n_hlsmax 55 CALL ctl_stop( 'STOP', ctmp1 ) 56 ENDIF 57 IF( ipi /= Ni_0+2*ihls ) THEN 58 WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk with an input array which does not match ihls along i: ', ipi, ihls, Ni_0 59 CALL ctl_stop( 'STOP', ctmp1 ) 60 ENDIF 61 IF( ipj /= Nj_0+2*ihls ) THEN 62 WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk with an input array which does not match ihls along j:', ipj, ihls , Nj_0 63 CALL ctl_stop( 'STOP', ctmp1 ) 64 ENDIF 65 ! 66 llncall = .TRUE. ! default definition 49 67 IF( PRESENT(ncsten) ) llncall = ncsten 50 68 ! 51 impi_nc = mpi_nc_com4 52 IF(llncall) impi_nc = mpi_nc_com8 69 impi_nc = mpi_nc_com4(ihls) 70 IF(llncall) impi_nc = mpi_nc_com8(ihls) 53 71 ! 54 72 zland = 0._wp ! land filling value: zero by default … … 60 78 !!$ ---> llsend(:) = lsend(:) ; llrecv(:) = lrecv(:) ??? 61 79 ELSE IF( PRESENT(lsend) .OR. PRESENT(lrecv) ) THEN 62 WRITE(ctmp1,*) ' Routine ', cdname, ' is calling lbc_lnk with only one of the two arguments lsend or lrecv'80 WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk with only one of the two arguments lsend or lrecv' 63 81 CALL ctl_stop( 'STOP', ctmp1 ) 64 82 ELSE ! default neighbours 65 llsend(:) = mpi nei(:) >= 083 llsend(:) = mpiSnei(ihls,:) >= 0 66 84 IF( .NOT. llncall ) llsend(5:8) = .FALSE. ! exclude corners 67 llrecv(:) = llsend(:) 85 llrecv(:) = mpiRnei(ihls,:) >= 0 86 IF( .NOT. llncall ) llrecv(5:8) = .FALSE. ! exclude corners 68 87 END IF 69 88 ! … … 92 111 ! or used for periodocity (p). The localization is defined as "the bottom left corner - 1" in i and j directions. 93 112 ! This is a shift that will be applied later in the do loops to pick-up the appropriate part of the array 94 ! ! ________________________ 95 ip0i = 0 ! im0j = inner |__|________________|__| 96 ip1i = nn_hls ! im1j = inner - halo | |__|__________|__| | 97 im1i = Nie0-nn_hls ! | | | | | | 98 im0i = Nie0 ! | | | | | | 99 ip0j = 0 ! | | | | | | 100 ip1j = nn_hls ! | |__|__________|__| | 101 im1j = Nje0-nn_hls ! ip1j = halo |__|__|__________|__|__| 102 im0j = Nje0 ! ip0j = 0 |__|________________|__| 103 ! ! ip0i ip1i im1i im0i 113 ! 114 ! all definitions bellow do not refer to N[ij][se]0 so we can use it with any local value of ihls 115 ! ! ________________________ 116 ip0i = 0 ! im0j = inner |__|________________|__| 117 ip1i = ihls ! im1j = inner - halo | |__|__________|__| | 118 im1i = ipi-2*ihls ! | | | | | | 119 im0i = ipi - ihls ! | | | | | | 120 ip0j = 0 ! | | | | | | 121 ip1j = ihls ! | |__|__________|__| | 122 im1j = ipj-2*ihls ! ip1j = halo |__|__|__________|__|__| 123 im0j = ipj - ihls ! ip0j = 0 |__|________________|__| 124 ! ! ip0i ip1i im1i im0i 104 125 ! 105 126 iwewe(:) = (/ jpwe,jpea,jpwe,jpea /) ; issnn(:) = (/ jpso,jpso,jpno,jpno /) 106 ! sides: west east south north ;corners: so-we, so-ea, no-we, no-ea107 isizei(1:4) = (/ nn_hls, nn_hls, Ni_0, Ni_0 /) ; isizei(5:8) = nn_hls! i- count108 isizej(1:4) = (/ Nj_0, Nj_0, nn_hls, nn_hls /) ; isizej(5:8) = nn_hls! j- count109 isht si(1:4) = (/ ip1i, im1i, ip1i, ip1i /) ; ishtsi(5:8) = ishtsi( iwewe ) ! i- shift send data110 isht sj(1:4) = (/ ip1j, ip1j, ip1j, im1j /) ; ishtsj(5:8) = ishtsj( issnn ) ! j- shift send data111 isht ri(1:4) = (/ ip0i, im0i, ip1i, ip1i /) ; ishtri(5:8) = ishtri( iwewe ) ! i- shift received data location112 isht rj(1:4) = (/ ip1j, ip1j, ip0j, im0j /) ; ishtrj(5:8) = ishtrj( issnn ) ! j- shift received data location113 isht pi(1:4) = (/ im1i, ip1i, ip1i, ip1i /) ; ishtpi(5:8) = ishtpi( iwewe ) ! i- shift data used for periodicity114 isht pj(1:4) = (/ ip1j, ip1j, im1j, ip1j /) ; ishtpj(5:8) = ishtpj( issnn ) ! j- shift data used for periodicity127 ! sides: west east south north ; corners: so-we, so-ea, no-we, no-ea 128 isizei(1:4) = (/ ihls, ihls, Ni_0, Ni_0 /) ; isizei(5:8) = ihls ! i- count 129 isizej(1:4) = (/ Nj_0, Nj_0, ihls, ihls /) ; isizej(5:8) = ihls ! j- count 130 ishtSi(1:4) = (/ ip1i, im1i, ip1i, ip1i /) ; ishtSi(5:8) = ishtSi( iwewe ) ! i- shift send data 131 ishtSj(1:4) = (/ ip1j, ip1j, ip1j, im1j /) ; ishtSj(5:8) = ishtSj( issnn ) ! j- shift send data 132 ishtRi(1:4) = (/ ip0i, im0i, ip1i, ip1i /) ; ishtRi(5:8) = ishtRi( iwewe ) ! i- shift received data location 133 ishtRj(1:4) = (/ ip1j, ip1j, ip0j, im0j /) ; ishtRj(5:8) = ishtRj( issnn ) ! j- shift received data location 134 ishtPi(1:4) = (/ im1i, ip1i, ip1i, ip1i /) ; ishtPi(5:8) = ishtPi( iwewe ) ! i- shift data used for periodicity 135 ishtPj(1:4) = (/ ip1j, ip1j, im1j, ip1j /) ; ishtPj(5:8) = ishtPj( issnn ) ! j- shift data used for periodicity 115 136 ! 116 137 ! -------------------------------- ! … … 140 161 DO jn = 1, 8 141 162 IF( llsend(jn) ) THEN 142 ishti = isht si(jn)143 ishtj = isht sj(jn)163 ishti = ishtSi(jn) 164 ishtj = ishtSj(jn) 144 165 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1,isizej(jn) ; DO ji = 1,isizei(jn) 145 166 zsnd(idx) = ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) … … 163 184 idx = 1 164 185 DO jn = 1, 8 165 ishti = isht ri(jn)166 ishtj = isht rj(jn)186 ishti = ishtRi(jn) 187 ishtj = ishtRj(jn) 167 188 SELECT CASE ( ifill(jn) ) 168 189 CASE ( jpfillnothing ) ! no filling … … 173 194 END DO ; END DO ; END DO ; END DO ; END DO 174 195 CASE ( jpfillperio ) ! use periodicity 175 ishti2 = isht pi(jn)176 ishtj2 = isht pj(jn)196 ishti2 = ishtPi(jn) 197 ishtj2 = ishtPj(jn) 177 198 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1,isizej(jn) ; DO ji = 1,isizei(jn) 178 199 ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl) 179 200 END DO ; END DO ; END DO ; END DO ; END DO 180 201 CASE ( jpfillcopy ) ! filling with inner domain values 181 ishti2 = isht si(jn)182 ishtj2 = isht sj(jn)202 ishti2 = ishtSi(jn) 203 ishtj2 = ishtSj(jn) 183 204 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1,isizej(jn) ; DO ji = 1,isizei(jn) 184 205 ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl) … … 196 217 DO jn = 5, 8 197 218 IF( .NOT. l_SelfPerio(jn) .AND. l_SelfPerio(jpwe) ) THEN ! no bi-perio but ew-perio: corners indirect definition 198 ishti = isht ri(jn)199 ishtj = isht rj(jn)200 ishti2 = isht pi(jn) ! use i- shift periodicity201 ishtj2 = isht rj(jn) ! use j- shift recv location: use ew-perio -> ok as filling of the south and north halos now done219 ishti = ishtRi(jn) 220 ishtj = ishtRj(jn) 221 ishti2 = ishtPi(jn) ! use i- shift periodicity 222 ishtj2 = ishtRj(jn) ! use j- shift recv location: use ew-perio -> ok as filling of the south and north halos now done 202 223 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1,isizej(jn) ; DO ji = 1,isizei(jn) 203 224 ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl) … … 205 226 ENDIF 206 227 IF( .NOT. l_SelfPerio(jn) .AND. l_SelfPerio(jpso) ) THEN ! no bi-perio but ns-perio: corners indirect definition 207 ishti = isht ri(jn)208 ishtj = isht rj(jn)209 ishti2 = isht ri(jn) ! use i- shift recv location: use ns-perio -> ok as filling of the west and east halos now done210 ishtj2 = isht pj(jn) ! use j- shift periodicity228 ishti = ishtRi(jn) 229 ishtj = ishtRj(jn) 230 ishti2 = ishtRi(jn) ! use i- shift recv location: use ns-perio -> ok as filling of the west and east halos now done 231 ishtj2 = ishtPj(jn) ! use j- shift periodicity 211 232 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1,isizej(jn) ; DO ji = 1,isizei(jn) 212 233 ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl) … … 220 241 ! 221 242 IF( ll_IdoNFold ) THEN 222 IF( jpni == 1 ) THEN ; CALL lbc_nfd( ptab, cd_nat, psgn , i pf ) ! self NFold223 ELSE ; CALL mpp_nfd( ptab, cd_nat, psgn, ifill_nfd, zland, i pf ) ! mpi NFold243 IF( jpni == 1 ) THEN ; CALL lbc_nfd( ptab, cd_nat, psgn , ihls, ipf ) ! self NFold 244 ELSE ; CALL mpp_nfd( ptab, cd_nat, psgn, ifill_nfd, zland, ihls, ipf ) ! mpi NFold 224 245 ENDIF 225 246 ENDIF -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC/lbc_lnk_pt2pt_generic.h90
r14349 r14363 1 1 2 SUBROUTINE lbc_lnk_pt2pt_/**/PRECISION( cdname, ptab, cd_nat, psgn, kfld, kfillmode, pfillval, lsend, lrecv )2 SUBROUTINE lbc_lnk_pt2pt_/**/PRECISION( cdname, ptab, cd_nat, psgn, kfld, kfillmode, pfillval, khls, lsend, lrecv ) 3 3 CHARACTER(len=*) , INTENT(in ) :: cdname ! name of the calling subroutine 4 4 TYPE(PTR_4d_/**/PRECISION), DIMENSION(:), INTENT(inout) :: ptab ! pointer of arrays on which apply the b.c. … … 8 8 INTEGER , OPTIONAL, INTENT(in ) :: kfillmode ! filling method for halo over land (default = constant) 9 9 REAL(PRECISION), OPTIONAL, INTENT(in ) :: pfillval ! background value (used at closed boundaries) 10 INTEGER , OPTIONAL, INTENT(in ) :: khls ! halo size, default = nn_hls 10 11 LOGICAL, DIMENSION(4),OPTIONAL, INTENT(in ) :: lsend, lrecv ! communication with other 4 proc 11 12 ! 12 INTEGER :: ji, jj, jk, jl, jf, jn! dummy loop indices13 INTEGER :: ipk, ipl, ipf! dimension of the input array13 INTEGER :: ji, jj, jk, jl, jf, jn ! dummy loop indices 14 INTEGER :: ipi, ipj, ipk, ipl, ipf ! dimension of the input array 14 15 INTEGER :: ip0i, ip1i, im0i, im1i 15 16 INTEGER :: ip0j, ip1j, im0j, im1j 16 17 INTEGER :: ishti, ishtj, ishti2, ishtj2 17 18 INTEGER :: ifill_nfd, icomm, ierr 18 INTEGER :: i dxs, idxr19 INTEGER, DIMENSION(4) :: isizei, isht si, ishtri, ishtpi20 INTEGER, DIMENSION(4) :: isizej, isht sj, ishtrj, ishtpj21 INTEGER, DIMENSION(4) :: ifill, iszall, isht s, ishtr19 INTEGER :: ihls, idxs, idxr 20 INTEGER, DIMENSION(4) :: isizei, ishtSi, ishtRi, ishtPi 21 INTEGER, DIMENSION(4) :: isizej, ishtSj, ishtRj, ishtPj 22 INTEGER, DIMENSION(4) :: ifill, iszall, ishtS, ishtR 22 23 INTEGER, DIMENSION(4) :: ireq ! mpi_request id 23 24 REAL(PRECISION) :: zland … … 31 32 ! ----------------------------------------- ! 32 33 ! 34 ipi = SIZE(ptab(1)%pt4d,1) 35 ipj = SIZE(ptab(1)%pt4d,2) 33 36 ipk = SIZE(ptab(1)%pt4d,3) 34 37 ipl = SIZE(ptab(1)%pt4d,4) … … 38 41 ! 39 42 ! take care of optional parameters 43 ! 44 ihls = nn_hls ! default definition 45 IF( PRESENT( khls ) ) ihls = khls 46 IF( ihls > n_hlsmax ) THEN 47 WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk with khls > n_hlsmax : ', khls, '>', n_hlsmax 48 CALL ctl_stop( 'STOP', ctmp1 ) 49 ENDIF 50 IF( ipi /= Ni_0+2*ihls ) THEN 51 WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk with an input array which does not match ihls along i: ', ipi, ihls, Ni_0 52 CALL ctl_stop( 'STOP', ctmp1 ) 53 ENDIF 54 IF( ipj /= Nj_0+2*ihls ) THEN 55 WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk with an input array which does not match ihls along j:', ipj, ihls , Nj_0 56 CALL ctl_stop( 'STOP', ctmp1 ) 57 ENDIF 40 58 ! 41 59 zland = 0._wp ! land filling value: zero by default … … 46 64 llsend(1:4) = lsend(1:4) ; llrecv(1:4) = lrecv(1:4) 47 65 ELSE IF( PRESENT(lsend) .OR. PRESENT(lrecv) ) THEN 48 WRITE(ctmp1,*) ' Routine ', cdname, 'is calling lbc_lnk with only one of the two arguments lsend or lrecv'66 WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk with only one of the two arguments lsend or lrecv' 49 67 CALL ctl_stop( 'STOP', ctmp1 ) 50 68 ELSE ! default neighbours 51 llsend( 1:4) = mpinei(1:4) >= 052 llrecv(:) = llsend(:)69 llsend(:) = mpiSnei(ihls,1:4) >= 0 70 llrecv(:) = mpiRnei(ihls,1:4) >= 0 53 71 END IF 54 72 ! … … 72 90 ! or used for periodocity (p). The localization is defined as "the bottom left corner - 1" in i and j directions. 73 91 ! This is a shift that will be applied later in the do loops to pick-up the appropriate part of the array 74 ! ! ________________________ 75 ip0i = 0 ! im0j = inner |__|__|__________|__|__| 76 ip1i = nn_hls ! im1j = inner - halo |__|__|__________|__|__| 77 im1i = Nie0-nn_hls ! | | | | | | 78 im0i = Nie0 ! | | | | | | 79 ip0j = 0 ! | | | | | | 80 ip1j = nn_hls ! |__|__|__________|__|__| 81 im1j = Nje0-nn_hls ! ip1j = halo |__|__|__________|__|__| 82 im0j = Nje0 ! ip0j = 0 |__|__|__________|__|__| 83 ! ! ip0i ip1i im1i im0i 84 ! 85 ! sides: west east south north 86 isizei(1:4) = (/ nn_hls, nn_hls, jpi, jpi /) ! i- count 87 isizej(1:4) = (/ jpj, jpj, nn_hls, nn_hls /) ! j- count 88 ishtsi(1:4) = (/ ip1i, im1i, ip0i, ip0i /) ! i- shift send data 89 ishtsj(1:4) = (/ ip0j, ip0j, ip1j, im1j /) ! j- shift send data 90 ishtri(1:4) = (/ ip0i, im0i, ip0i, ip0i /) ! i- shift received data location 91 ishtrj(1:4) = (/ ip0j, ip0j, ip0j, im0j /) ! j- shift received data location 92 ishtpi(1:4) = (/ im1i, ip1i, ip0i, ip0i /) ! i- shift data used for periodicity 93 ishtpj(1:4) = (/ ip0j, ip0j, im1j, ip1j /) ! j- shift data used for periodicity 92 ! 93 ! all definitions bellow do not refer to N[ij][se]0 so we can use it with any local value of ihls 94 ! ! ________________________ 95 ip0i = 0 ! im0j = inner |__|__|__________|__|__| 96 ip1i = ihls ! im1j = inner - halo |__|__|__________|__|__| 97 im1i = ipi-2*ihls ! | | | | | | 98 im0i = ipi - ihls ! | | | | | | 99 ip0j = 0 ! | | | | | | 100 ip1j = ihls ! |__|__|__________|__|__| 101 im1j = ipj-2*ihls ! ip1j = halo |__|__|__________|__|__| 102 im0j = ipj - ihls ! ip0j = 0 |__|__|__________|__|__| 103 ! ! ip0i ip1i im1i im0i 104 ! 105 ! sides: west east south north 106 isizei(1:4) = (/ ihls, ihls, ipi, ipi /) ! i- count 107 isizej(1:4) = (/ ipj, ipj, ihls, ihls /) ! j- count 108 ishtSi(1:4) = (/ ip1i, im1i, ip0i, ip0i /) ! i- shift send data 109 ishtSj(1:4) = (/ ip0j, ip0j, ip1j, im1j /) ! j- shift send data 110 ishtRi(1:4) = (/ ip0i, im0i, ip0i, ip0i /) ! i- shift received data location 111 ishtRj(1:4) = (/ ip0j, ip0j, ip0j, im0j /) ! j- shift received data location 112 ishtPi(1:4) = (/ im1i, ip1i, ip0i, ip0i /) ! i- shift data used for periodicity 113 ishtPj(1:4) = (/ ip0j, ip0j, im1j, ip1j /) ! j- shift data used for periodicity 94 114 ! 95 115 ! -------------------------------- ! … … 99 119 ireq(:) = MPI_REQUEST_NULL 100 120 iszall(:) = isizei(:) * isizej(:) * ipk * ipl * ipf 101 isht s(1) = 0121 ishtS(1) = 0 102 122 DO jn = 2,4 103 isht s(jn) = ishts(jn-1) + iszall(jn-1) * COUNT( (/llsend(jn-1)/) ) ! with _alltoallv: in units of sendtype104 END DO 105 isht r(1) = 0123 ishtS(jn) = ishtS(jn-1) + iszall(jn-1) * COUNT( (/llsend(jn-1)/) ) ! with _alltoallv: in units of sendtype 124 END DO 125 ishtR(1) = 0 106 126 DO jn = 2,4 107 isht r(jn) = ishtr(jn-1) + iszall(jn-1) * COUNT( (/llrecv(jn-1)/) ) ! with _alltoallv: in units of sendtype127 ishtR(jn) = ishtR(jn-1) + iszall(jn-1) * COUNT( (/llrecv(jn-1)/) ) ! with _alltoallv: in units of sendtype 108 128 END DO 109 129 … … 119 139 DO jn = 1, 2 120 140 IF( llsend(jn) ) THEN 121 ishti = isht si(jn)122 ishtj = isht sj(jn)141 ishti = ishtSi(jn) 142 ishtj = ishtSj(jn) 123 143 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1,isizej(jn) ; DO ji = 1,isizei(jn) 124 144 zsnd(idxs) = ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) … … 134 154 ! non-blocking send of the western/eastern side using local temporary arrays 135 155 jn = jpwe 136 IF( llsend(jn) ) CALL MPI_ISEND( zsnd(isht s(jn)+1), iszall(jn), MPI_TYPE, mpinei(jn), 1, icomm, ireq(jn), ierr )156 IF( llsend(jn) ) CALL MPI_ISEND( zsnd(ishtS(jn)+1), iszall(jn), MPI_TYPE, mpiSnei(ihls,jn), 1, icomm, ireq(jn), ierr ) 137 157 jn = jpea 138 IF( llsend(jn) ) CALL MPI_ISEND( zsnd(isht s(jn)+1), iszall(jn), MPI_TYPE, mpinei(jn), 2, icomm, ireq(jn), ierr )158 IF( llsend(jn) ) CALL MPI_ISEND( zsnd(ishtS(jn)+1), iszall(jn), MPI_TYPE, mpiSnei(ihls,jn), 2, icomm, ireq(jn), ierr ) 139 159 ! blocking receive of the western/eastern halo in local temporary arrays 140 160 jn = jpwe 141 IF( llrecv(jn) ) CALL MPI_RECV( zrcv(isht r(jn)+1), iszall(jn), MPI_TYPE, mpinei(jn), 2, icomm, MPI_STATUS_IGNORE, ierr )161 IF( llrecv(jn) ) CALL MPI_RECV( zrcv(ishtR(jn)+1), iszall(jn), MPI_TYPE, mpiRnei(ihls,jn), 2, icomm, MPI_STATUS_IGNORE, ierr ) 142 162 jn = jpea 143 IF( llrecv(jn) ) CALL MPI_RECV( zrcv(isht r(jn)+1), iszall(jn), MPI_TYPE, mpinei(jn), 1, icomm, MPI_STATUS_IGNORE, ierr )163 IF( llrecv(jn) ) CALL MPI_RECV( zrcv(ishtR(jn)+1), iszall(jn), MPI_TYPE, mpiRnei(ihls,jn), 1, icomm, MPI_STATUS_IGNORE, ierr ) 144 164 ! 145 165 IF( ln_timing ) CALL tic_tac(.FALSE.) … … 152 172 idxr = 1 153 173 DO jn = 1, 2 154 ishti = isht ri(jn)155 ishtj = isht rj(jn)174 ishti = ishtRi(jn) 175 ishtj = ishtRj(jn) 156 176 SELECT CASE ( ifill(jn) ) 157 177 CASE ( jpfillnothing ) ! no filling … … 162 182 END DO ; END DO ; END DO ; END DO ; END DO 163 183 CASE ( jpfillperio ) ! use periodicity 164 ishti2 = isht pi(jn)165 ishtj2 = isht pj(jn)184 ishti2 = ishtPi(jn) 185 ishtj2 = ishtPj(jn) 166 186 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1,isizej(jn) ; DO ji = 1,isizei(jn) 167 187 ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl) 168 188 END DO ; END DO ; END DO ; END DO ; END DO 169 189 CASE ( jpfillcopy ) ! filling with inner domain values 170 ishti2 = isht si(jn)171 ishtj2 = isht sj(jn)190 ishti2 = ishtSi(jn) 191 ishtj2 = ishtSj(jn) 172 192 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1,isizej(jn) ; DO ji = 1,isizei(jn) 173 193 ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl) … … 187 207 ! 188 208 IF( ll_IdoNFold ) THEN 189 IF( jpni == 1 ) THEN ; CALL lbc_nfd( ptab, cd_nat, psgn , i pf ) ! self NFold190 ELSE ; CALL mpp_nfd( ptab, cd_nat, psgn, ifill_nfd, zland, i pf ) ! mpi NFold209 IF( jpni == 1 ) THEN ; CALL lbc_nfd( ptab, cd_nat, psgn , ihls, ipf ) ! self NFold 210 ELSE ; CALL mpp_nfd( ptab, cd_nat, psgn, ifill_nfd, zland, ihls, ipf ) ! mpi NFold 191 211 ENDIF 192 212 ENDIF … … 198 218 DO jn = 3, 4 199 219 IF( llsend(jn) ) THEN 200 ishti = isht si(jn)201 ishtj = isht sj(jn)220 ishti = ishtSi(jn) 221 ishtj = ishtSj(jn) 202 222 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1,isizej(jn) ; DO ji = 1,isizei(jn) 203 223 zsnd(idxs) = ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) … … 212 232 ! non-blocking send of the western/eastern side using local temporary arrays 213 233 jn = jpso 214 IF( llsend(jn) ) CALL MPI_ISEND( zsnd(isht s(jn)+1), iszall(jn), MPI_TYPE, mpinei(jn), 3, icomm, ireq(jn), ierr )234 IF( llsend(jn) ) CALL MPI_ISEND( zsnd(ishtS(jn)+1), iszall(jn), MPI_TYPE, mpiSnei(ihls,jn), 3, icomm, ireq(jn), ierr ) 215 235 jn = jpno 216 IF( llsend(jn) ) CALL MPI_ISEND( zsnd(isht s(jn)+1), iszall(jn), MPI_TYPE, mpinei(jn), 4, icomm, ireq(jn), ierr )236 IF( llsend(jn) ) CALL MPI_ISEND( zsnd(ishtS(jn)+1), iszall(jn), MPI_TYPE, mpiSnei(ihls,jn), 4, icomm, ireq(jn), ierr ) 217 237 ! blocking receive of the western/eastern halo in local temporary arrays 218 238 jn = jpso 219 IF( llrecv(jn) ) CALL MPI_RECV( zrcv(isht r(jn)+1), iszall(jn), MPI_TYPE, mpinei(jn), 4, icomm, MPI_STATUS_IGNORE, ierr )239 IF( llrecv(jn) ) CALL MPI_RECV( zrcv(ishtR(jn)+1), iszall(jn), MPI_TYPE, mpiRnei(ihls,jn), 4, icomm, MPI_STATUS_IGNORE, ierr ) 220 240 jn = jpno 221 IF( llrecv(jn) ) CALL MPI_RECV( zrcv(isht r(jn)+1), iszall(jn), MPI_TYPE, mpinei(jn), 3, icomm, MPI_STATUS_IGNORE, ierr )241 IF( llrecv(jn) ) CALL MPI_RECV( zrcv(ishtR(jn)+1), iszall(jn), MPI_TYPE, mpiRnei(ihls,jn), 3, icomm, MPI_STATUS_IGNORE, ierr ) 222 242 ! 223 243 IF( ln_timing ) CALL tic_tac(.FALSE.) … … 229 249 ! 230 250 DO jn = 3, 4 231 ishti = isht ri(jn)232 ishtj = isht rj(jn)251 ishti = ishtRi(jn) 252 ishtj = ishtRj(jn) 233 253 SELECT CASE ( ifill(jn) ) 234 254 CASE ( jpfillnothing ) ! no filling … … 239 259 END DO ; END DO ; END DO ; END DO ; END DO 240 260 CASE ( jpfillperio ) ! use periodicity 241 ishti2 = isht pi(jn)242 ishtj2 = isht pj(jn)261 ishti2 = ishtPi(jn) 262 ishtj2 = ishtPj(jn) 243 263 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1,isizej(jn) ; DO ji = 1,isizei(jn) 244 264 ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl) 245 265 END DO ; END DO ; END DO ; END DO ; END DO 246 266 CASE ( jpfillcopy ) ! filling with inner domain values 247 ishti2 = isht si(jn)248 ishtj2 = isht sj(jn)267 ishti2 = ishtSi(jn) 268 ishtj2 = ishtSj(jn) 249 269 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1,isizej(jn) ; DO ji = 1,isizei(jn) 250 270 ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl) -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC/lbc_nfd_generic.h90
r14349 r14363 1 1 2 SUBROUTINE lbc_nfd_/**/PRECISION( ptab, cd_nat, psgn, k fld )2 SUBROUTINE lbc_nfd_/**/PRECISION( ptab, cd_nat, psgn, khls, kfld ) 3 3 TYPE(PTR_4d_/**/PRECISION), DIMENSION(:), INTENT(inout) :: ptab ! pointer of arrays on which apply the b.c. 4 4 CHARACTER(len=1), DIMENSION(:), INTENT(in ) :: cd_nat ! nature of array grid-points 5 5 REAL(PRECISION), DIMENSION(:), INTENT(in ) :: psgn ! sign used across the north fold boundary 6 INTEGER , INTENT(in ) :: khls ! halo size, default = nn_hls 6 7 INTEGER , INTENT(in ) :: kfld ! number of pt3d arrays 7 8 ! 8 9 INTEGER :: ji, jj, jk, jl, jf ! dummy loop indices 9 INTEGER :: 10 INTEGER :: ipi, ipj, ipk, ipl, ipf ! dimension of the input array 10 11 INTEGER :: ii1, ii2, ij1, ij2 11 12 !!---------------------------------------------------------------------- 12 13 ! 14 ipi = SIZE(ptab(1)%pt4d,1) 13 15 ipj = SIZE(ptab(1)%pt4d,2) 14 16 ipk = SIZE(ptab(1)%pt4d,3) 15 17 ipl = SIZE(ptab(1)%pt4d,4) 16 18 ipf = kfld 19 ! 20 IF( ipi /= Ni0glo+2*khls ) THEN 21 WRITE(ctmp1,*) 'lbc_nfd input array does not match khls', ipi, khls, Ni0glo 22 CALL ctl_stop( 'STOP', ctmp1 ) 23 ENDIF 17 24 ! 18 25 DO jf = 1, ipf ! Loop on the number of arrays to be treated … … 24 31 DO jl = 1, ipl; DO jk = 1, ipk 25 32 ! 26 ! last nn_hls lines (from ipj to ipj-nn_hls+1) : full27 DO jj = 1, nn_hls28 ij1 = ipj - jj + 1 ! ends at: ipj - nn_hls + 129 ij2 = ipj - 2* nn_hls + jj - 1 ! ends at: ipj - 2*nn_hls + nn_hls - 1 = ipj - nn_hls - 130 ! 31 DO ji = 1, nn_hls ! first nn_hls points32 ii1 = ji ! ends at: nn_hls33 ii2 = 2* nn_hls + 2 - ji ! ends at: 2*nn_hls + 2 - nn_hls = nn_hls + 234 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 35 END DO 36 DO ji = 1, 1 ! point nn_hls+137 ii1 = nn_hls + ji33 ! last khls lines (from ipj to ipj-khls+1) : full 34 DO jj = 1, khls 35 ij1 = ipj - jj + 1 ! ends at: ipj - khls + 1 36 ij2 = ipj - 2*khls + jj - 1 ! ends at: ipj - 2*khls + khls - 1 = ipj - khls - 1 37 ! 38 DO ji = 1, khls ! first khls points 39 ii1 = ji ! ends at: khls 40 ii2 = 2*khls + 2 - ji ! ends at: 2*khls + 2 - khls = khls + 2 41 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 42 END DO 43 DO ji = 1, 1 ! point khls+1 44 ii1 = khls + ji 38 45 ii2 = ii1 39 46 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 40 47 END DO 41 DO ji = 1, Ni0glo - 1 ! points from nn_hls+2 to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls)42 ii1 = 2 + nn_hls + ji - 1 ! ends at: 2 + nn_hls + jpiglo - 2*nn_hls - 1 - 1 = jpiglo - nn_hls43 ii2 = jpiglo - nn_hls - ji + 1 ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls - 1 ) + 1 = nn_hls + 244 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 45 END DO 46 DO ji = 1, 1 ! point jpiglo - nn_hls + 147 ii1 = jpiglo - nn_hls + ji48 ii2 = nn_hls + ji49 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 50 END DO 51 DO ji = 1, nn_hls-1 ! last nn_hls-1 points52 ii1 = jpiglo - nn_hls + 1 + ji ! ends at: jpiglo - nn_hls + 1 + nn_hls - 1 = jpiglo53 ii2 = jpiglo - nn_hls + 1 - ji ! ends at: jpiglo - nn_hls + 1 - nn_hls + 1 = jpiglo - 2*nn_hls + 254 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 55 END DO 56 END DO 57 ! 58 ! line number ipj- nn_hls : right half59 DO jj = 1, 1 60 ij1 = ipj - nn_hls61 ij2 = ij1 ! same line 62 ! 63 DO ji = 1, Ni0glo/2-1 ! points from jpiglo/2+2 to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls)64 ii1 = jpiglo/2 + ji + 1 ! ends at: jpiglo/2 + (jpiglo/2 - nn_hls - 1) + 1 = jpiglo - nn_hls65 ii2 = jpiglo/2 - ji + 1 ! ends at: jpiglo/2 - (jpiglo/2 - nn_hls - 1) + 1 = nn_hls + 266 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 67 END DO 68 DO ji = 1, nn_hls ! first nn_hls points: redo them just in case (if e-w periodocity already done)69 ! ! as we just changed points jpiglo-2nn_hls+1 to jpiglo-nn_hls70 ii1 = ji ! ends at: nn_hls71 ii2 = 2* nn_hls + 2 - ji ! ends at: 2*nn_hls + 2 - nn_hls = nn_hls + 272 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 73 END DO 74 ! ! last nn_hls-1 points: have been / will done by e-w periodicity48 DO ji = 1, Ni0glo - 1 ! points from khls+2 to ipi - khls (note: Ni0glo = ipi - 2*khls) 49 ii1 = 2 + khls + ji - 1 ! ends at: 2 + khls + ipi - 2*khls - 1 - 1 = ipi - khls 50 ii2 = ipi - khls - ji + 1 ! ends at: ipi - khls - ( ipi - 2*khls - 1 ) + 1 = khls + 2 51 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 52 END DO 53 DO ji = 1, 1 ! point ipi - khls + 1 54 ii1 = ipi - khls + ji 55 ii2 = khls + ji 56 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 57 END DO 58 DO ji = 1, khls-1 ! last khls-1 points 59 ii1 = ipi - khls + 1 + ji ! ends at: ipi - khls + 1 + khls - 1 = ipi 60 ii2 = ipi - khls + 1 - ji ! ends at: ipi - khls + 1 - khls + 1 = ipi - 2*khls + 2 61 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 62 END DO 63 END DO 64 ! 65 ! line number ipj-khls : right half 66 DO jj = 1, 1 67 ij1 = ipj - khls 68 ij2 = ij1 ! same line 69 ! 70 DO ji = 1, Ni0glo/2-1 ! points from ipi/2+2 to ipi - khls (note: Ni0glo = ipi - 2*khls) 71 ii1 = ipi/2 + ji + 1 ! ends at: ipi/2 + (ipi/2 - khls - 1) + 1 = ipi - khls 72 ii2 = ipi/2 - ji + 1 ! ends at: ipi/2 - (ipi/2 - khls - 1) + 1 = khls + 2 73 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 74 END DO 75 DO ji = 1, khls ! first khls points: redo them just in case (if e-w periodocity already done) 76 ! ! as we just changed points ipi-2khls+1 to ipi-khls 77 ii1 = ji ! ends at: khls 78 ii2 = 2*khls + 2 - ji ! ends at: 2*khls + 2 - khls = khls + 2 79 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 80 END DO 81 ! ! last khls-1 points: have been / will done by e-w periodicity 75 82 END DO 76 83 ! … … 79 86 DO jl = 1, ipl; DO jk = 1, ipk 80 87 ! 81 ! last nn_hls lines (from ipj to ipj-nn_hls+1) : full82 DO jj = 1, nn_hls83 ij1 = ipj - jj + 1 ! ends at: ipj - nn_hls + 184 ij2 = ipj - 2* nn_hls + jj - 1 ! ends at: ipj - 2*nn_hls + nn_hls - 1 = ipj - nn_hls - 185 ! 86 DO ji = 1, nn_hls ! first nn_hls points87 ii1 = ji ! ends at: nn_hls88 ii2 = 2* nn_hls + 1 - ji ! ends at: 2*nn_hls + 1 - nn_hls = nn_hls + 189 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 90 END DO 91 DO ji = 1, Ni0glo ! points from nn_hls to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls)92 ii1 = nn_hls + ji ! ends at: nn_hls + jpiglo - 2*nn_hls = jpiglo - nn_hls93 ii2 = jpiglo - nn_hls - ji + 1 ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls ) + 1 = nn_hls + 194 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 95 END DO 96 DO ji = 1, nn_hls ! last nn_hls points97 ii1 = jpiglo - nn_hls + ji ! ends at: jpiglo - nn_hls + nn_hls = jpiglo98 ii2 = jpiglo - nn_hls + 1 - ji ! ends at: jpiglo - nn_hls + 1 - nn_hls = jpiglo - 2*nn_hls + 199 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 100 END DO 101 END DO 102 ! 103 ! line number ipj- nn_hls : right half104 DO jj = 1, 1 105 ij1 = ipj - nn_hls106 ij2 = ij1 ! same line 107 ! 108 DO ji = 1, Ni0glo/2 ! points from jpiglo/2+1 to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls)109 ii1 = jpiglo/2 + ji ! ends at: jpiglo/2 + (jpiglo/2 - nn_hls) = jpiglo - nn_hls110 ii2 = jpiglo/2 - ji + 1 ! ends at: jpiglo/2 - (jpiglo/2 - nn_hls) + 1 = nn_hls + 1111 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 112 END DO 113 DO ji = 1, nn_hls ! first nn_hls points: redo them just in case (if e-w periodocity already done)114 ! ! as we just changed points jpiglo-2nn_hls+1 to jpiglo-nn_hls115 ii1 = ji ! ends at: nn_hls116 ii2 = 2* nn_hls + 1 - ji ! ends at: 2*nn_hls + 1 - nn_hls = nn_hls + 1117 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 118 END DO 119 ! ! last nn_hls-1 points: have been / will done by e-w periodicity88 ! last khls lines (from ipj to ipj-khls+1) : full 89 DO jj = 1, khls 90 ij1 = ipj - jj + 1 ! ends at: ipj - khls + 1 91 ij2 = ipj - 2*khls + jj - 1 ! ends at: ipj - 2*khls + khls - 1 = ipj - khls - 1 92 ! 93 DO ji = 1, khls ! first khls points 94 ii1 = ji ! ends at: khls 95 ii2 = 2*khls + 1 - ji ! ends at: 2*khls + 1 - khls = khls + 1 96 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 97 END DO 98 DO ji = 1, Ni0glo ! points from khls to ipi - khls (note: Ni0glo = ipi - 2*khls) 99 ii1 = khls + ji ! ends at: khls + ipi - 2*khls = ipi - khls 100 ii2 = ipi - khls - ji + 1 ! ends at: ipi - khls - ( ipi - 2*khls ) + 1 = khls + 1 101 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 102 END DO 103 DO ji = 1, khls ! last khls points 104 ii1 = ipi - khls + ji ! ends at: ipi - khls + khls = ipi 105 ii2 = ipi - khls + 1 - ji ! ends at: ipi - khls + 1 - khls = ipi - 2*khls + 1 106 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 107 END DO 108 END DO 109 ! 110 ! line number ipj-khls : right half 111 DO jj = 1, 1 112 ij1 = ipj - khls 113 ij2 = ij1 ! same line 114 ! 115 DO ji = 1, Ni0glo/2 ! points from ipi/2+1 to ipi - khls (note: Ni0glo = ipi - 2*khls) 116 ii1 = ipi/2 + ji ! ends at: ipi/2 + (ipi/2 - khls) = ipi - khls 117 ii2 = ipi/2 - ji + 1 ! ends at: ipi/2 - (ipi/2 - khls) + 1 = khls + 1 118 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 119 END DO 120 DO ji = 1, khls ! first khls points: redo them just in case (if e-w periodocity already done) 121 ! ! as we just changed points ipi-2khls+1 to ipi-khls 122 ii1 = ji ! ends at: khls 123 ii2 = 2*khls + 1 - ji ! ends at: 2*khls + 1 - khls = khls + 1 124 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 125 END DO 126 ! ! last khls-1 points: have been / will done by e-w periodicity 120 127 END DO 121 128 ! … … 124 131 DO jl = 1, ipl; DO jk = 1, ipk 125 132 ! 126 ! last nn_hls+1 lines (from ipj to ipj-nn_hls) : full127 DO jj = 1, nn_hls+1128 ij1 = ipj - jj + 1 ! ends at: ipj - ( nn_hls + 1 ) + 1 = ipj - nn_hls129 ij2 = ipj - 2* nn_hls + jj - 2 ! ends at: ipj - 2*nn_hls + nn_hls + 1 - 2 = ipj - nn_hls - 1130 ! 131 DO ji = 1, nn_hls ! first nn_hls points132 ii1 = ji ! ends at: nn_hls133 ii2 = 2* nn_hls + 2 - ji ! ends at: 2*nn_hls + 2 - nn_hls = nn_hls + 2134 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 135 END DO 136 DO ji = 1, 1 ! point nn_hls+1137 ii1 = nn_hls + ji133 ! last khls+1 lines (from ipj to ipj-khls) : full 134 DO jj = 1, khls+1 135 ij1 = ipj - jj + 1 ! ends at: ipj - ( khls + 1 ) + 1 = ipj - khls 136 ij2 = ipj - 2*khls + jj - 2 ! ends at: ipj - 2*khls + khls + 1 - 2 = ipj - khls - 1 137 ! 138 DO ji = 1, khls ! first khls points 139 ii1 = ji ! ends at: khls 140 ii2 = 2*khls + 2 - ji ! ends at: 2*khls + 2 - khls = khls + 2 141 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 142 END DO 143 DO ji = 1, 1 ! point khls+1 144 ii1 = khls + ji 138 145 ii2 = ii1 139 146 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 140 147 END DO 141 DO ji = 1, Ni0glo - 1 ! points from nn_hls+2 to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls)142 ii1 = 2 + nn_hls + ji - 1 ! ends at: 2 + nn_hls + jpiglo - 2*nn_hls - 1 - 1 = jpiglo - nn_hls143 ii2 = jpiglo - nn_hls - ji + 1 ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls - 1 ) + 1 = nn_hls + 2144 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 145 END DO 146 DO ji = 1, 1 ! point jpiglo - nn_hls + 1147 ii1 = jpiglo - nn_hls + ji148 ii2 = nn_hls + ji149 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 150 END DO 151 DO ji = 1, nn_hls-1 ! last nn_hls-1 points152 ii1 = jpiglo - nn_hls + 1 + ji ! ends at: jpiglo - nn_hls + 1 + nn_hls - 1 = jpiglo153 ii2 = jpiglo - nn_hls + 1 - ji ! ends at: jpiglo - nn_hls + 1 - nn_hls + 1 = jpiglo - 2*nn_hls + 2148 DO ji = 1, Ni0glo - 1 ! points from khls+2 to ipi - khls (note: Ni0glo = ipi - 2*khls) 149 ii1 = 2 + khls + ji - 1 ! ends at: 2 + khls + ipi - 2*khls - 1 - 1 = ipi - khls 150 ii2 = ipi - khls - ji + 1 ! ends at: ipi - khls - ( ipi - 2*khls - 1 ) + 1 = khls + 2 151 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 152 END DO 153 DO ji = 1, 1 ! point ipi - khls + 1 154 ii1 = ipi - khls + ji 155 ii2 = khls + ji 156 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 157 END DO 158 DO ji = 1, khls-1 ! last khls-1 points 159 ii1 = ipi - khls + 1 + ji ! ends at: ipi - khls + 1 + khls - 1 = ipi 160 ii2 = ipi - khls + 1 - ji ! ends at: ipi - khls + 1 - khls + 1 = ipi - 2*khls + 2 154 161 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 155 162 END DO … … 160 167 DO jl = 1, ipl; DO jk = 1, ipk 161 168 ! 162 ! last nn_hls+1 lines (from ipj to ipj-nn_hls) : full163 DO jj = 1, nn_hls+1164 ij1 = ipj - jj + 1 ! ends at: ipj - ( nn_hls + 1 ) + 1 = ipj - nn_hls165 ij2 = ipj - 2* nn_hls + jj - 2 ! ends at: ipj - 2*nn_hls + nn_hls + 1 - 2 = ipj - nn_hls - 1166 ! 167 DO ji = 1, nn_hls ! first nn_hls points168 ii1 = ji ! ends at: nn_hls169 ii2 = 2* nn_hls + 1 - ji ! ends at: 2*nn_hls + 1 - nn_hls = nn_hls + 1170 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 171 END DO 172 DO ji = 1, Ni0glo ! points from nn_hls to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls)173 ii1 = nn_hls + ji ! ends at: nn_hls + jpiglo - 2*nn_hls = jpiglo - nn_hls174 ii2 = jpiglo - nn_hls - ji + 1 ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls ) + 1 = nn_hls + 1175 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 176 END DO 177 DO ji = 1, nn_hls ! last nn_hls points178 ii1 = jpiglo - nn_hls + ji ! ends at: jpiglo - nn_hls + nn_hls = jpiglo179 ii2 = jpiglo - nn_hls + 1 - ji ! ends at: jpiglo - nn_hls + 1 - nn_hls = jpiglo - 2*nn_hls + 1169 ! last khls+1 lines (from ipj to ipj-khls) : full 170 DO jj = 1, khls+1 171 ij1 = ipj - jj + 1 ! ends at: ipj - ( khls + 1 ) + 1 = ipj - khls 172 ij2 = ipj - 2*khls + jj - 2 ! ends at: ipj - 2*khls + khls + 1 - 2 = ipj - khls - 1 173 ! 174 DO ji = 1, khls ! first khls points 175 ii1 = ji ! ends at: khls 176 ii2 = 2*khls + 1 - ji ! ends at: 2*khls + 1 - khls = khls + 1 177 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 178 END DO 179 DO ji = 1, Ni0glo ! points from khls to ipi - khls (note: Ni0glo = ipi - 2*khls) 180 ii1 = khls + ji ! ends at: khls + ipi - 2*khls = ipi - khls 181 ii2 = ipi - khls - ji + 1 ! ends at: ipi - khls - ( ipi - 2*khls ) + 1 = khls + 1 182 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 183 END DO 184 DO ji = 1, khls ! last khls points 185 ii1 = ipi - khls + ji ! ends at: ipi - khls + khls = ipi 186 ii2 = ipi - khls + 1 - ji ! ends at: ipi - khls + 1 - khls = ipi - 2*khls + 1 180 187 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 181 188 END DO … … 193 200 DO jl = 1, ipl; DO jk = 1, ipk 194 201 ! 195 ! first: line number ipj- nn_hls : 3 points196 DO jj = 1, 1 197 ij1 = ipj - nn_hls198 ij2 = ij1 ! same line 199 ! 200 DO ji = 1, 1 ! points from jpiglo/2+1201 ii1 = jpiglo/2 + ji202 ii2 = jpiglo/2 - ji + 1203 ptab(jf)%pt4d(ii1,ij1,jk,jl) = 204 END DO 205 DO ji = 1, 1 ! points jpiglo - nn_hls206 ii1 = jpiglo - nn_hls + ji - 1207 ii2 = nn_hls + ji208 ptab(jf)%pt4d(ii1,ij1,jk,jl) = 209 END DO 210 DO ji = 1, 1 ! point nn_hls: redo it just in case (if e-w periodocity already done)211 ! ! as we just changed point jpiglo - nn_hls212 ii1 = nn_hls + ji - 1213 ii2 = nn_hls + ji214 ptab(jf)%pt4d(ii1,ij1,jk,jl) = 215 END DO 216 END DO 217 ! 218 ! Second: last nn_hls lines (from ipj to ipj-nn_hls+1) : full219 DO jj = 1, nn_hls220 ij1 = ipj + 1 - jj ! ends at: ipj + 1 - nn_hls221 ij2 = ipj - 2* nn_hls + jj ! ends at: ipj - 2*nn_hls + nn_hls = ipj - nn_hls222 ! 223 DO ji = 1, nn_hls ! first nn_hls points224 ii1 = ji ! ends at: nn_hls225 ii2 = 2* nn_hls + 1 - ji ! ends at: 2*nn_hls + 1 - nn_hls = nn_hls + 1226 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 227 END DO 228 DO ji = 1, Ni0glo ! points from nn_hls to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls)229 ii1 = nn_hls + ji ! ends at: nn_hls + jpiglo - 2*nn_hls = jpiglo - nn_hls230 ii2 = jpiglo - nn_hls - ji + 1 ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls ) + 1 = nn_hls + 1231 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 232 END DO 233 DO ji = 1, nn_hls ! last nn_hls points234 ii1 = jpiglo - nn_hls + ji ! ends at: jpiglo - nn_hls + nn_hls = jpiglo235 ii2 = jpiglo - nn_hls + 1 - ji ! ends at: jpiglo - nn_hls + 1 - nn_hls = jpiglo - 2*nn_hls + 1202 ! first: line number ipj-khls : 3 points 203 DO jj = 1, 1 204 ij1 = ipj - khls 205 ij2 = ij1 ! same line 206 ! 207 DO ji = 1, 1 ! points from ipi/2+1 208 ii1 = ipi/2 + ji 209 ii2 = ipi/2 - ji + 1 210 ptab(jf)%pt4d(ii1,ij1,jk,jl) = ptab(jf)%pt4d(ii2,ij2,jk,jl) ! Warning: pb with sign... 211 END DO 212 DO ji = 1, 1 ! points ipi - khls 213 ii1 = ipi - khls + ji - 1 214 ii2 = khls + ji 215 ptab(jf)%pt4d(ii1,ij1,jk,jl) = ptab(jf)%pt4d(ii2,ij2,jk,jl) ! Warning: pb with sign... 216 END DO 217 DO ji = 1, 1 ! point khls: redo it just in case (if e-w periodocity already done) 218 ! ! as we just changed point ipi - khls 219 ii1 = khls + ji - 1 220 ii2 = khls + ji 221 ptab(jf)%pt4d(ii1,ij1,jk,jl) = ptab(jf)%pt4d(ii2,ij2,jk,jl) ! Warning: pb with sign... 222 END DO 223 END DO 224 ! 225 ! Second: last khls lines (from ipj to ipj-khls+1) : full 226 DO jj = 1, khls 227 ij1 = ipj + 1 - jj ! ends at: ipj + 1 - khls 228 ij2 = ipj - 2*khls + jj ! ends at: ipj - 2*khls + khls = ipj - khls 229 ! 230 DO ji = 1, khls ! first khls points 231 ii1 = ji ! ends at: khls 232 ii2 = 2*khls + 1 - ji ! ends at: 2*khls + 1 - khls = khls + 1 233 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 234 END DO 235 DO ji = 1, Ni0glo ! points from khls to ipi - khls (note: Ni0glo = ipi - 2*khls) 236 ii1 = khls + ji ! ends at: khls + ipi - 2*khls = ipi - khls 237 ii2 = ipi - khls - ji + 1 ! ends at: ipi - khls - ( ipi - 2*khls ) + 1 = khls + 1 238 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 239 END DO 240 DO ji = 1, khls ! last khls points 241 ii1 = ipi - khls + ji ! ends at: ipi - khls + khls = ipi 242 ii2 = ipi - khls + 1 - ji ! ends at: ipi - khls + 1 - khls = ipi - 2*khls + 1 236 243 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 237 244 END DO … … 242 249 DO jl = 1, ipl; DO jk = 1, ipk 243 250 ! 244 ! last nn_hls lines (from ipj to ipj-nn_hls+1) : full245 DO jj = 1, nn_hls246 ij1 = ipj + 1 - jj ! ends at: ipj + 1 - nn_hls247 ij2 = ipj - 2* nn_hls + jj ! ends at: ipj - 2*nn_hls + nn_hls = ipj - nn_hls248 ! 249 DO ji = 1, nn_hls-1 ! first nn_hls-1 points250 ii1 = ji ! ends at: nn_hls-1251 ii2 = 2* nn_hls - ji ! ends at: 2*nn_hls - ( nn_hls - 1 ) = nn_hls + 1252 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 253 END DO 254 DO ji = 1, 1 ! point nn_hls255 ii1 = nn_hls + ji - 1256 ii2 = jpiglo- ii1257 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 258 END DO 259 DO ji = 1, Ni0glo - 1 ! points from nn_hls+1 to jpiglo - nn_hls - 1 (note: Ni0glo = jpiglo - 2*nn_hls)260 ii1 = nn_hls + ji ! ends at: nn_hls + ( jpiglo - 2*nn_hls - 1 ) = jpiglo - nn_hls - 1261 ii2 = jpiglo - nn_hls - ji ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls - 1 ) = nn_hls + 1262 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 263 END DO 264 DO ji = 1, 1 ! point jpiglo - nn_hls265 ii1 = jpiglo - nn_hls + ji - 1251 ! last khls lines (from ipj to ipj-khls+1) : full 252 DO jj = 1, khls 253 ij1 = ipj + 1 - jj ! ends at: ipj + 1 - khls 254 ij2 = ipj - 2*khls + jj ! ends at: ipj - 2*khls + khls = ipj - khls 255 ! 256 DO ji = 1, khls-1 ! first khls-1 points 257 ii1 = ji ! ends at: khls-1 258 ii2 = 2*khls - ji ! ends at: 2*khls - ( khls - 1 ) = khls + 1 259 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 260 END DO 261 DO ji = 1, 1 ! point khls 262 ii1 = khls + ji - 1 263 ii2 = ipi - ii1 264 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 265 END DO 266 DO ji = 1, Ni0glo - 1 ! points from khls+1 to ipi - khls - 1 (note: Ni0glo = ipi - 2*khls) 267 ii1 = khls + ji ! ends at: khls + ( ipi - 2*khls - 1 ) = ipi - khls - 1 268 ii2 = ipi - khls - ji ! ends at: ipi - khls - ( ipi - 2*khls - 1 ) = khls + 1 269 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 270 END DO 271 DO ji = 1, 1 ! point ipi - khls 272 ii1 = ipi - khls + ji - 1 266 273 ii2 = ii1 267 274 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 268 275 END DO 269 DO ji = 1, nn_hls ! last nn_hls points270 ii1 = jpiglo - nn_hls + ji ! ends at: jpiglo - nn_hls + nn_hls = jpiglo271 ii2 = jpiglo - nn_hls - ji ! ends at: jpiglo - nn_hls - nn_hls = jpiglo - 2*nn_hls276 DO ji = 1, khls ! last khls points 277 ii1 = ipi - khls + ji ! ends at: ipi - khls + khls = ipi 278 ii2 = ipi - khls - ji ! ends at: ipi - khls - khls = ipi - 2*khls 272 279 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 273 280 END DO … … 278 285 DO jl = 1, ipl; DO jk = 1, ipk 279 286 ! 280 ! last nn_hls lines (from ipj to ipj-nn_hls+1) : full281 DO jj = 1, nn_hls282 ij1 = ipj - jj + 1 ! ends at: ipj - nn_hls + 1283 ij2 = ipj - 2* nn_hls + jj - 1 ! ends at: ipj - 2*nn_hls + nn_hls - 1 = ipj - nn_hls - 1284 ! 285 DO ji = 1, nn_hls ! first nn_hls points286 ii1 = ji ! ends at: nn_hls287 ii2 = 2* nn_hls + 1 - ji ! ends at: 2*nn_hls + 1 - nn_hls = nn_hls + 1288 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 289 END DO 290 DO ji = 1, Ni0glo ! points from nn_hls to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls)291 ii1 = nn_hls + ji ! ends at: nn_hls + jpiglo - 2*nn_hls = jpiglo - nn_hls292 ii2 = jpiglo - nn_hls - ji + 1 ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls ) + 1 = nn_hls + 1293 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 294 END DO 295 DO ji = 1, nn_hls ! last nn_hls points296 ii1 = jpiglo - nn_hls + ji ! ends at: jpiglo - nn_hls + nn_hls = jpiglo297 ii2 = jpiglo - nn_hls + 1 - ji ! ends at: jpiglo - nn_hls + 1 - nn_hls = jpiglo - 2*nn_hls + 1287 ! last khls lines (from ipj to ipj-khls+1) : full 288 DO jj = 1, khls 289 ij1 = ipj - jj + 1 ! ends at: ipj - khls + 1 290 ij2 = ipj - 2*khls + jj - 1 ! ends at: ipj - 2*khls + khls - 1 = ipj - khls - 1 291 ! 292 DO ji = 1, khls ! first khls points 293 ii1 = ji ! ends at: khls 294 ii2 = 2*khls + 1 - ji ! ends at: 2*khls + 1 - khls = khls + 1 295 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 296 END DO 297 DO ji = 1, Ni0glo ! points from khls to ipi - khls (note: Ni0glo = ipi - 2*khls) 298 ii1 = khls + ji ! ends at: khls + ipi - 2*khls = ipi - khls 299 ii2 = ipi - khls - ji + 1 ! ends at: ipi - khls - ( ipi - 2*khls ) + 1 = khls + 1 300 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 301 END DO 302 DO ji = 1, khls ! last khls points 303 ii1 = ipi - khls + ji ! ends at: ipi - khls + khls = ipi 304 ii2 = ipi - khls + 1 - ji ! ends at: ipi - khls + 1 - khls = ipi - 2*khls + 1 298 305 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 299 306 END DO 300 307 END DO 301 308 ! 302 ! line number ipj- nn_hls : right half303 DO jj = 1, 1 304 ij1 = ipj - nn_hls305 ij2 = ij1 ! same line 306 ! 307 DO ji = 1, Ni0glo/2 ! points from jpiglo/2+1 to jpiglo - nn_hls (note: Ni0glo = jpiglo - 2*nn_hls)308 ii1 = jpiglo/2 + ji ! ends at: jpiglo/2 + (jpiglo/2 - nn_hls) = jpiglo - nn_hls309 ii2 = jpiglo/2 - ji + 1 ! ends at: jpiglo/2 - (jpiglo/2 - nn_hls) + 1 = nn_hls + 1310 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 311 END DO 312 DO ji = 1, nn_hls ! first nn_hls points: redo them just in case (if e-w periodocity already done)313 ! ! as we just changed points jpiglo-2nn_hls+1 to jpiglo-nn_hls314 ii1 = ji ! ends at: nn_hls315 ii2 = 2* nn_hls + 1 - ji ! ends at: 2*nn_hls + 1 - nn_hls = nn_hls + 1316 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 317 END DO 318 ! ! last nn_hls points: have been / will done by e-w periodicity309 ! line number ipj-khls : right half 310 DO jj = 1, 1 311 ij1 = ipj - khls 312 ij2 = ij1 ! same line 313 ! 314 DO ji = 1, Ni0glo/2 ! points from ipi/2+1 to ipi - khls (note: Ni0glo = ipi - 2*khls) 315 ii1 = ipi/2 + ji ! ends at: ipi/2 + (ipi/2 - khls) = ipi - khls 316 ii2 = ipi/2 - ji + 1 ! ends at: ipi/2 - (ipi/2 - khls) + 1 = khls + 1 317 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 318 END DO 319 DO ji = 1, khls ! first khls points: redo them just in case (if e-w periodocity already done) 320 ! ! as we just changed points ipi-2khls+1 to ipi-khls 321 ii1 = ji ! ends at: khls 322 ii2 = 2*khls + 1 - ji ! ends at: 2*khls + 1 - khls = khls + 1 323 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 324 END DO 325 ! ! last khls points: have been / will done by e-w periodicity 319 326 END DO 320 327 ! … … 323 330 DO jl = 1, ipl; DO jk = 1, ipk 324 331 ! 325 ! last nn_hls lines (from ipj to ipj-nn_hls+1) : full326 DO jj = 1, nn_hls327 ij1 = ipj - jj + 1 ! ends at: ipj - nn_hls + 1328 ij2 = ipj - 2* nn_hls + jj - 1 ! ends at: ipj - 2*nn_hls + nn_hls - 1 = ipj - nn_hls - 1329 ! 330 DO ji = 1, nn_hls-1 ! first nn_hls-1 points331 ii1 = ji ! ends at: nn_hls-1332 ii2 = 2* nn_hls - ji ! ends at: 2*nn_hls - ( nn_hls - 1 ) = nn_hls + 1333 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 334 END DO 335 DO ji = 1, 1 ! point nn_hls336 ii1 = nn_hls + ji - 1337 ii2 = jpiglo- ii1338 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 339 END DO 340 DO ji = 1, Ni0glo - 1 ! points from nn_hls+1 to jpiglo - nn_hls - 1 (note: Ni0glo = jpiglo - 2*nn_hls)341 ii1 = nn_hls + ji ! ends at: nn_hls + ( jpiglo - 2*nn_hls - 1 ) = jpiglo - nn_hls - 1342 ii2 = jpiglo - nn_hls - ji ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls - 1 ) = nn_hls + 1343 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 344 END DO 345 DO ji = 1, 1 ! point jpiglo - nn_hls346 ii1 = jpiglo - nn_hls + ji - 1332 ! last khls lines (from ipj to ipj-khls+1) : full 333 DO jj = 1, khls 334 ij1 = ipj - jj + 1 ! ends at: ipj - khls + 1 335 ij2 = ipj - 2*khls + jj - 1 ! ends at: ipj - 2*khls + khls - 1 = ipj - khls - 1 336 ! 337 DO ji = 1, khls-1 ! first khls-1 points 338 ii1 = ji ! ends at: khls-1 339 ii2 = 2*khls - ji ! ends at: 2*khls - ( khls - 1 ) = khls + 1 340 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 341 END DO 342 DO ji = 1, 1 ! point khls 343 ii1 = khls + ji - 1 344 ii2 = ipi - ii1 345 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 346 END DO 347 DO ji = 1, Ni0glo - 1 ! points from khls+1 to ipi - khls - 1 (note: Ni0glo = ipi - 2*khls) 348 ii1 = khls + ji ! ends at: khls + ( ipi - 2*khls - 1 ) = ipi - khls - 1 349 ii2 = ipi - khls - ji ! ends at: ipi - khls - ( ipi - 2*khls - 1 ) = khls + 1 350 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 351 END DO 352 DO ji = 1, 1 ! point ipi - khls 353 ii1 = ipi - khls + ji - 1 347 354 ii2 = ii1 348 355 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 349 356 END DO 350 DO ji = 1, nn_hls ! last nn_hls points351 ii1 = jpiglo - nn_hls + ji ! ends at: jpiglo - nn_hls + nn_hls = jpiglo352 ii2 = jpiglo - nn_hls - ji ! ends at: jpiglo - nn_hls - nn_hls = jpiglo - 2*nn_hls357 DO ji = 1, khls ! last khls points 358 ii1 = ipi - khls + ji ! ends at: ipi - khls + khls = ipi 359 ii2 = ipi - khls - ji ! ends at: ipi - khls - khls = ipi - 2*khls 353 360 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 354 361 END DO 355 362 END DO 356 363 ! 357 ! line number ipj- nn_hls : right half358 DO jj = 1, 1 359 ij1 = ipj - nn_hls360 ij2 = ij1 ! same line 361 ! 362 DO ji = 1, Ni0glo/2-1 ! points from jpiglo/2+1 to jpiglo - nn_hls-1 (note: Ni0glo = jpiglo - 2*nn_hls)363 ii1 = jpiglo/2 + ji ! ends at: jpiglo/2 + (jpiglo/2 - nn_hls) = jpiglo - nn_hls364 ii2 = jpiglo/2 - ji ! ends at: jpiglo/2 - (jpiglo/2 - nn_hls - 1 ) = nn_hls + 1365 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 366 END DO 367 DO ji = 1, nn_hls-1 ! first nn_hls-1 points: redo them just in case (if e-w periodocity already done)368 ! ! as we just changed points jpiglo-2nn_hls+1 to jpiglo-nn_hl-1369 ii1 = ji ! ends at: nn_hls370 ii2 = 2* nn_hls - ji ! ends at: 2*nn_hls - ( nn_hls - 1 ) = nn_hls + 1371 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 372 END DO 373 ! ! last nn_hls points: have been / will done by e-w periodicity364 ! line number ipj-khls : right half 365 DO jj = 1, 1 366 ij1 = ipj - khls 367 ij2 = ij1 ! same line 368 ! 369 DO ji = 1, Ni0glo/2-1 ! points from ipi/2+1 to ipi - khls-1 (note: Ni0glo = ipi - 2*khls) 370 ii1 = ipi/2 + ji ! ends at: ipi/2 + (ipi/2 - khls) = ipi - khls 371 ii2 = ipi/2 - ji ! ends at: ipi/2 - (ipi/2 - khls - 1 ) = khls + 1 372 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 373 END DO 374 DO ji = 1, khls-1 ! first khls-1 points: redo them just in case (if e-w periodocity already done) 375 ! ! as we just changed points ipi-2khls+1 to ipi-nn_hl-1 376 ii1 = ji ! ends at: khls 377 ii2 = 2*khls - ji ! ends at: 2*khls - ( khls - 1 ) = khls + 1 378 ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl) 379 END DO 380 ! ! last khls points: have been / will done by e-w periodicity 374 381 END DO 375 382 ! -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC/lbc_nfd_nogather_generic.h90
r14349 r14363 1 1 2 SUBROUTINE lbc_nfd_nogather_/**/PRECISION( ptab, ptab2, cd_nat, psgn )2 SUBROUTINE lbc_nfd_nogather_/**/PRECISION( ptab, ptab2, cd_nat, psgn, khls ) 3 3 !!---------------------------------------------------------------------- 4 4 !! … … 11 11 CHARACTER(len=1) , INTENT(in ) :: cd_nat ! nature of array grid-points 12 12 REAL(PRECISION) , INTENT(in ) :: psgn ! sign used across the north fold boundary 13 INTEGER , INTENT(in ) :: khls ! halo size, default = nn_hls 13 14 ! 14 15 INTEGER :: ji, jj, jk, jn, jl, jh ! dummy loop indices … … 29 30 CASE ( 'T' , 'W' ) ! T-, W-point 30 31 IF ( nimpp /= 1 ) THEN ; startloop = 1 31 ELSE ; startloop = 1 + nn_hls32 ENDIF 33 ! 34 DO jl = 1, ipl; DO jk = 1, ipk 35 DO jj = 1, nn_hls32 ELSE ; startloop = 1 + khls 33 ENDIF 34 ! 35 DO jl = 1, ipl; DO jk = 1, ipk 36 DO jj = 1, khls 36 37 ijj = jpj -jj +1 37 38 DO ji = startloop, jpi … … 43 44 IF( nimpp == 1 ) THEN 44 45 DO jl = 1, ipl; DO jk = 1, ipk 45 DO jj = 1, nn_hls46 DO jj = 1, khls 46 47 ijj = jpj -jj +1 47 DO ii = 0, nn_hls-148 ptab(ii+1,ijj,jk,jl) = psgn * ptab(2* nn_hls-ii+1,jpj-2*nn_hls+jj-1,jk,jl)48 DO ii = 0, khls-1 49 ptab(ii+1,ijj,jk,jl) = psgn * ptab(2*khls-ii+1,jpj-2*khls+jj-1,jk,jl) 49 50 END DO 50 51 END DO … … 56 57 startloop = 1 57 58 ELSEIF( nimpp+jpi-1 >= Ni0glo/2+2 .AND. nimpp < Ni0glo/2+2 ) THEN 58 startloop = Ni0glo/2+2 - nimpp + nn_hls59 startloop = Ni0glo/2+2 - nimpp + khls 59 60 ELSE 60 61 startloop = jpi + 1 … … 67 68 ijta = jpiglo - jia + 2 68 69 IF( ijta >= startloop+nimpp-1 .AND. ijta < jia ) THEN 69 ptab(ji,jpj- nn_hls,jk,jl) = psgn * ptab(ijta-nimpp+nn_hls,jpj-nn_hls,jk,jl)70 ptab(ji,jpj-khls,jk,jl) = psgn * ptab(ijta-nimpp+khls,jpj-khls,jk,jl) 70 71 ELSE 71 ptab(ji,jpj- nn_hls,jk,jl) = psgn * ptab2(ijt,nn_hls+1,jk,jl)72 ptab(ji,jpj-khls,jk,jl) = psgn * ptab2(ijt,khls+1,jk,jl) 72 73 ENDIF 73 74 END DO … … 79 80 endloop = jpi 80 81 ELSE 81 endloop = jpi - nn_hls82 ENDIF 83 DO jl = 1, ipl; DO jk = 1, ipk 84 DO jj = 1, nn_hls82 endloop = jpi - khls 83 ENDIF 84 DO jl = 1, ipl; DO jk = 1, ipk 85 DO jj = 1, khls 85 86 ijj = jpj -jj +1 86 87 DO ji = 1, endloop … … 91 92 END DO; END DO 92 93 IF (nimpp .eq. 1) THEN 93 DO jj = 1, nn_hls94 ijj = jpj -jj +1 95 DO ii = 0, nn_hls-196 ptab(ii+1,ijj,:,:) = psgn * ptab(2* nn_hls-ii,jpj-2*nn_hls+jj-1,:,:)94 DO jj = 1, khls 95 ijj = jpj -jj +1 96 DO ii = 0, khls-1 97 ptab(ii+1,ijj,:,:) = psgn * ptab(2*khls-ii,jpj-2*khls+jj-1,:,:) 97 98 END DO 98 99 END DO 99 100 ENDIF 100 101 IF((nimpp + jpi - 1) .eq. jpiglo) THEN 101 DO jj = 1, nn_hls102 ijj = jpj -jj +1 103 DO ii = 1, nn_hls104 ptab(jpi-ii+1,ijj,:,:) = psgn * ptab(jpi-2* nn_hls+ii,jpj-2*nn_hls+jj-1,:,:)102 DO jj = 1, khls 103 ijj = jpj -jj +1 104 DO ii = 1, khls 105 ptab(jpi-ii+1,ijj,:,:) = psgn * ptab(jpi-2*khls+ii,jpj-2*khls+jj-1,:,:) 105 106 END DO 106 107 END DO … … 111 112 endloop = jpi 112 113 ELSE 113 endloop = jpi - nn_hls114 endloop = jpi - khls 114 115 ENDIF 115 116 IF( nimpp >= Ni0glo/2+1 ) THEN 116 startloop = nn_hls117 startloop = khls 117 118 ELSEIF( ( nimpp + jpi - 1 >= Ni0glo/2+1 ) .AND. ( nimpp < Ni0glo/2+1 ) ) THEN 118 startloop = Ni0glo/2+1 - nimpp + nn_hls119 startloop = Ni0glo/2+1 - nimpp + khls 119 120 ELSE 120 121 startloop = endloop + 1 … … 127 128 ijua = jpiglo - jia + 1 128 129 IF( ijua >= startloop+nimpp-1 .AND. ijua < jia ) THEN 129 ptab(ji,jpj- nn_hls,jk,jl) = psgn * ptab(ijua-nimpp+1,jpj-nn_hls,jk,jl)130 ptab(ji,jpj-khls,jk,jl) = psgn * ptab(ijua-nimpp+1,jpj-khls,jk,jl) 130 131 ELSE 131 ptab(ji,jpj- nn_hls,jk,jl) = psgn * ptab2(iju,nn_hls+1,jk,jl)132 ptab(ji,jpj-khls,jk,jl) = psgn * ptab2(iju,khls+1,jk,jl) 132 133 ENDIF 133 134 END DO … … 140 141 startloop = 1 141 142 ELSE 142 startloop = 1 + nn_hls143 ENDIF 144 IF ( .NOT. l_fast_exchanges ) THEN 145 DO jl = 1, ipl; DO jk = 1, ipk 146 DO jj = 2, nn_hls+1143 startloop = 1 + khls 144 ENDIF 145 IF ( .NOT. l_fast_exchanges ) THEN 146 DO jl = 1, ipl; DO jk = 1, ipk 147 DO jj = 2, khls+1 147 148 ijj = jpj -jj +1 148 149 DO ji = startloop, jpi … … 160 161 END DO; END DO 161 162 IF (nimpp .eq. 1) THEN 162 DO jj = 1, nn_hls163 DO jj = 1, khls 163 164 ijj = jpj-jj+1 164 DO ii = 0, nn_hls-1165 ptab(ii+1,ijj,:,:) = psgn * ptab(2* nn_hls-ii+1,jpj-2*nn_hls+jj-1,:,:)165 DO ii = 0, khls-1 166 ptab(ii+1,ijj,:,:) = psgn * ptab(2*khls-ii+1,jpj-2*khls+jj-1,:,:) 166 167 END DO 167 168 END DO … … 171 172 endloop = jpi 172 173 ELSE 173 endloop = jpi - nn_hls174 ENDIF 175 IF ( .NOT. l_fast_exchanges ) THEN 176 DO jl = 1, ipl; DO jk = 1, ipk 177 DO jj = 2, nn_hls+1174 endloop = jpi - khls 175 ENDIF 176 IF ( .NOT. l_fast_exchanges ) THEN 177 DO jl = 1, ipl; DO jk = 1, ipk 178 DO jj = 2, khls+1 178 179 ijj = jpj -jj +1 179 180 DO ji = 1, endloop … … 191 192 END DO; END DO 192 193 IF (nimpp .eq. 1) THEN 193 DO ii = 1, nn_hls194 ptab(ii,jpj,:,:) = psgn * ptab(2* nn_hls-ii,jpj-2*nn_hls-1,:,:)194 DO ii = 1, khls 195 ptab(ii,jpj,:,:) = psgn * ptab(2*khls-ii,jpj-2*khls-1,:,:) 195 196 END DO 196 197 IF ( .NOT. l_fast_exchanges ) THEN 197 DO jj = 1, nn_hls198 DO jj = 1, khls 198 199 ijj = jpj -jj 199 DO ii = 0, nn_hls-1200 ptab(ii+1,ijj,:,:) = psgn * ptab(2* nn_hls-ii,jpj-2*nn_hls+jj-1,:,:)200 DO ii = 0, khls-1 201 ptab(ii+1,ijj,:,:) = psgn * ptab(2*khls-ii,jpj-2*khls+jj-1,:,:) 201 202 END DO 202 203 END DO … … 204 205 ENDIF 205 206 IF((nimpp + jpi - 1 ) .eq. jpiglo) THEN 206 DO ii = 1, nn_hls207 ptab(jpi-ii+1,jpj,:,:) = psgn * ptab(jpi-2* nn_hls+ii,jpj-2*nn_hls-1,:,:)207 DO ii = 1, khls 208 ptab(jpi-ii+1,jpj,:,:) = psgn * ptab(jpi-2*khls+ii,jpj-2*khls-1,:,:) 208 209 END DO 209 210 IF ( .NOT. l_fast_exchanges ) THEN 210 DO jj = 1, nn_hls211 DO jj = 1, khls 211 212 ijj = jpj -jj 212 DO ii = 1, nn_hls213 ptab(jpi-ii+1,ijj,:,:) = psgn * ptab(jpi-2* nn_hls+ii,jpj-2*nn_hls+jj-1,:,:)213 DO ii = 1, khls 214 ptab(jpi-ii+1,ijj,:,:) = psgn * ptab(jpi-2*khls+ii,jpj-2*khls+jj-1,:,:) 214 215 END DO 215 216 END DO … … 226 227 CASE ( 'T' , 'W' ) ! T-, W-point 227 228 DO jl = 1, ipl; DO jk = 1, ipk 228 DO jj = 1, nn_hls229 DO jj = 1, khls 229 230 ijj = jpj-jj+1 230 231 DO ji = 1, jpi … … 239 240 endloop = jpi 240 241 ELSE 241 endloop = jpi - nn_hls242 ENDIF 243 DO jl = 1, ipl; DO jk = 1, ipk 244 DO jj = 1, nn_hls242 endloop = jpi - khls 243 ENDIF 244 DO jl = 1, ipl; DO jk = 1, ipk 245 DO jj = 1, khls 245 246 ijj = jpj-jj+1 246 247 DO ji = 1, endloop … … 252 253 IF(nimpp + jpi - 1 .eq. jpiglo) THEN 253 254 DO jl = 1, ipl; DO jk = 1, ipk 254 DO jj = 1, nn_hls255 DO jj = 1, khls 255 256 ijj = jpj-jj+1 256 DO ii = 1, nn_hls257 DO ii = 1, khls 257 258 iij = jpi-ii+1 258 ptab(iij,ijj,jk,jl) = psgn * ptab(jpi-2* nn_hls+ii-1,jpj-2*nn_hls+jj,jk,jl)259 ptab(iij,ijj,jk,jl) = psgn * ptab(jpi-2*khls+ii-1,jpj-2*khls+jj,jk,jl) 259 260 END DO 260 261 END DO … … 264 265 CASE ( 'V' ) ! V-point 265 266 DO jl = 1, ipl; DO jk = 1, ipk 266 DO jj = 1, nn_hls267 DO jj = 1, khls 267 268 ijj = jpj -jj +1 268 269 DO ji = 1, jpi … … 277 278 startloop = 1 278 279 ELSEIF( nimpp+jpi-1 >= Ni0glo/2+2 .AND. nimpp < Ni0glo/2+2 ) THEN 279 startloop = Ni0glo/2+2 - nimpp + nn_hls280 startloop = Ni0glo/2+2 - nimpp + khls 280 281 ELSE 281 282 startloop = jpi + 1 … … 285 286 DO ji = startloop, jpi 286 287 ijt = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3 287 ptab(ji,jpj- nn_hls,jk,jl) = psgn * ptab2(ijt,nn_hls+1,jk,jl)288 ptab(ji,jpj-khls,jk,jl) = psgn * ptab2(ijt,khls+1,jk,jl) 288 289 END DO 289 290 END DO; END DO … … 295 296 endloop = jpi 296 297 ELSE 297 endloop = jpi - nn_hls298 ENDIF 299 DO jl = 1, ipl; DO jk = 1, ipk 300 DO jj = 1, nn_hls298 endloop = jpi - khls 299 ENDIF 300 DO jl = 1, ipl; DO jk = 1, ipk 301 DO jj = 1, khls 301 302 ijj = jpj -jj +1 302 303 DO ji = 1, endloop … … 308 309 IF((nimpp + jpi - 1) .eq. jpiglo) THEN 309 310 DO jl = 1, ipl; DO jk = 1, ipk 310 DO jj = 1, nn_hls311 DO jj = 1, khls 311 312 ijj = jpj -jj +1 312 DO ii = 1, nn_hls313 DO ii = 1, khls 313 314 iij = jpi -ii+1 314 ptab(iij,ijj,jk,jl) = psgn * ptab(jpi-2* nn_hls+ii-1,jpj-2*nn_hls+jj-1,jk,jl)315 ptab(iij,ijj,jk,jl) = psgn * ptab(jpi-2*khls+ii-1,jpj-2*khls+jj-1,jk,jl) 315 316 END DO 316 317 END DO … … 322 323 endloop = jpi 323 324 ELSE 324 endloop = jpi - nn_hls325 endloop = jpi - khls 325 326 ENDIF 326 327 IF( nimpp >= Ni0glo/2+2 ) THEN 327 328 startloop = 1 328 329 ELSEIF( nimpp+jpi-1 >= Ni0glo/2+2 .AND. nimpp < Ni0glo/2+2 ) THEN 329 startloop = Ni0glo/2+2 - nimpp + nn_hls330 startloop = Ni0glo/2+2 - nimpp + khls 330 331 ELSE 331 332 startloop = endloop + 1 … … 335 336 DO ji = startloop, endloop 336 337 iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 2 337 ptab(ji,jpj- nn_hls,jk,jl) = psgn * ptab2(iju,nn_hls+1,jk,jl)338 ptab(ji,jpj-khls,jk,jl) = psgn * ptab2(iju,khls+1,jk,jl) 338 339 END DO 339 340 END DO; END DO -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC/lib_mpp.F90
r14349 r14363 139 139 140 140 ! Neighbourgs informations 141 INTEGER, DIMENSION(8), PUBLIC :: mpinei !: 8-neighbourg MPI indexes (starting at 0, -1 if no neighbourg) 141 INTEGER, PARAMETER, PUBLIC :: n_hlsmax = 3 142 INTEGER, DIMENSION( 8), PUBLIC :: mpinei !: 8-neighbourg MPI indexes (starting at 0, -1 if no neighbourg) 143 INTEGER, DIMENSION(n_hlsmax,8), PUBLIC :: mpiSnei !: 8-neighbourg Send MPI indexes (starting at 0, -1 if no neighbourg) 144 INTEGER, DIMENSION(n_hlsmax,8), PUBLIC :: mpiRnei !: 8-neighbourg Recv MPI indexes (starting at 0, -1 if no neighbourg) 142 145 INTEGER, PARAMETER, PUBLIC :: jpwe = 1 !: WEst 143 146 INTEGER, PARAMETER, PUBLIC :: jpea = 2 !: EAst … … 160 163 161 164 ! variables used for MPI3 neighbourhood collectives 162 INTEGER, PUBLIC :: mpi_nc_com4 ! MPI3 neighbourhood collectives communicator163 INTEGER, PUBLIC :: mpi_nc_com8 ! MPI3 neighbourhood collectives communicator (with diagionals)165 INTEGER, DIMENSION(n_hlsmax), PUBLIC :: mpi_nc_com4 ! MPI3 neighbourhood collectives communicator 166 INTEGER, DIMENSION(n_hlsmax), PUBLIC :: mpi_nc_com8 ! MPI3 neighbourhood collectives communicator (with diagionals) 164 167 165 168 ! North fold condition in mpp_mpi with jpni > 1 (PUBLIC for TAM) … … 1100 1103 1101 1104 1102 SUBROUTINE mpp_ini_nc 1105 SUBROUTINE mpp_ini_nc( khls ) 1103 1106 !!---------------------------------------------------------------------- 1104 1107 !! *** routine mpp_ini_nc *** … … 1114 1117 !! mpi_nc_com8 = MPI3 neighbourhood collectives communicator (with diagonals) 1115 1118 !!---------------------------------------------------------------------- 1116 INTEGER, DIMENSION(:), ALLOCATABLE :: inei4, inei8 1117 INTEGER :: icnt4, icnt8 1118 INTEGER :: ierr 1119 LOGICAL, PARAMETER :: ireord = .FALSE. 1119 INTEGER, INTENT(in ) :: khls ! halo size, default = nn_hls 1120 ! 1121 INTEGER, DIMENSION(:), ALLOCATABLE :: iSnei4, iRnei4, iSnei8, iRnei8 1122 INTEGER :: iScnt4, iRcnt4, iScnt8, iRcnt8 1123 INTEGER :: ierr 1124 LOGICAL, PARAMETER :: ireord = .FALSE. 1120 1125 !!---------------------------------------------------------------------- 1121 1126 #if ! defined key_mpi_off && ! defined key_mpi2 1122 1127 1123 icnt4 = COUNT( mpinei(1:4) >= 0 ) 1124 icnt8 = COUNT( mpinei(1:8) >= 0 ) 1125 1126 ALLOCATE( inei4(icnt4), inei8(icnt8) ) ! ok if icnt4 or icnt8 = 0 1127 1128 inei4 = PACK( mpinei(1:4), mask = mpinei(1:4) >= 0 ) 1129 inei8 = PACK( mpinei(1:8), mask = mpinei(1:8) >= 0 ) 1130 1131 CALL MPI_Dist_graph_create_adjacent(mpi_comm_oce, icnt4, inei4, MPI_UNWEIGHTED, & 1132 & icnt4, inei4, MPI_UNWEIGHTED, MPI_INFO_NULL, ireord, mpi_nc_com4, ierr) 1133 CALL MPI_Dist_graph_create_adjacent(mpi_comm_oce, icnt8, inei8, MPI_UNWEIGHTED, & 1134 & icnt8, inei8, MPI_UNWEIGHTED, MPI_INFO_NULL, ireord, mpi_nc_com8, ierr) 1135 1136 DEALLOCATE (inei4, inei8) 1128 iScnt4 = COUNT( mpiSnei(khls,1:4) >= 0 ) 1129 iRcnt4 = COUNT( mpiRnei(khls,1:4) >= 0 ) 1130 iScnt8 = COUNT( mpiSnei(khls,1:8) >= 0 ) 1131 iRcnt8 = COUNT( mpiRnei(khls,1:8) >= 0 ) 1132 1133 ALLOCATE( iSnei4(iScnt4), iRnei4(iRcnt4), iSnei8(iScnt8), iRnei8(iRcnt8) ) ! ok if icnt4 or icnt8 = 0 1134 1135 iSnei4 = PACK( mpiSnei(khls,1:4), mask = mpiSnei(khls,1:4) >= 0 ) 1136 iRnei4 = PACK( mpiRnei(khls,1:4), mask = mpiRnei(khls,1:4) >= 0 ) 1137 iSnei8 = PACK( mpiSnei(khls,1:8), mask = mpiSnei(khls,1:8) >= 0 ) 1138 iRnei8 = PACK( mpiRnei(khls,1:8), mask = mpiRnei(khls,1:8) >= 0 ) 1139 1140 CALL MPI_Dist_graph_create_adjacent( mpi_comm_oce, iScnt4, iSnei4, MPI_UNWEIGHTED, iRcnt4, iRnei4, MPI_UNWEIGHTED, & 1141 & MPI_INFO_NULL, ireord, mpi_nc_com4(khls), ierr ) 1142 CALL MPI_Dist_graph_create_adjacent( mpi_comm_oce, iScnt8, iSnei8, MPI_UNWEIGHTED, iRcnt8, iRnei8, MPI_UNWEIGHTED, & 1143 & MPI_INFO_NULL, ireord, mpi_nc_com8(khls), ierr) 1144 1145 DEALLOCATE( iSnei4, iRnei4, iSnei8, iRnei8 ) 1137 1146 #endif 1138 1147 END SUBROUTINE mpp_ini_nc -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC/mpp_nfd_generic.h90
r14349 r14363 1 1 2 SUBROUTINE mpp_nfd_/**/PRECISION( ptab, cd_nat, psgn, kfillmode, pfillval, k fld )2 SUBROUTINE mpp_nfd_/**/PRECISION( ptab, cd_nat, psgn, kfillmode, pfillval, khls, kfld ) 3 3 TYPE(PTR_4d_/**/PRECISION), DIMENSION(:), INTENT(inout) :: ptab ! pointer of arrays on which apply the b.c. 4 4 CHARACTER(len=1), DIMENSION(:), INTENT(in ) :: cd_nat ! nature of array grid-points … … 6 6 INTEGER , INTENT(in ) :: kfillmode ! filling method for halo over land 7 7 REAL(PRECISION) , INTENT(in ) :: pfillval ! background value (used at closed boundaries) 8 INTEGER , INTENT(in ) :: khls ! halo size, default = nn_hls 8 9 INTEGER , INTENT(in ) :: kfld ! number of pt3d arrays 9 10 ! … … 64 65 IF( ll_add_line ) THEN 65 66 DO jf = 1, ipf ! Loop over the number of arrays to be processed 66 ipj_s(jf) = nn_hls + COUNT( (/ c_NFtype == 'T' .OR. cd_nat(jf) == 'V' .OR. cd_nat(jf) == 'F' /) )67 ipj_s(jf) = khls + COUNT( (/ c_NFtype == 'T' .OR. cd_nat(jf) == 'V' .OR. cd_nat(jf) == 'F' /) ) 67 68 END DO 68 69 ELSE 69 ipj_s(:) = nn_hls70 ipj_s(:) = khls 70 71 ENDIF 71 72 … … 94 95 ij1 = ij1 + 1 95 96 jj_b(jj,jf) = ij1 96 jj_s(jj,jf) = jpj - 2* nn_hls + jj - i01297 jj_s(jj,jf) = jpj - 2*khls + jj - i012 97 98 END DO 98 99 ! … … 137 138 ipi = nfjpi (ipni) 138 139 ! 139 IF( ipni == 1 ) THEN ; iis0 = 1 140 ELSE ; iis0 = 1 + nn_hls ! default: -> from inner domain141 ENDIF 142 IF( ipni == jpni ) THEN ; iie0 = ipi 143 ELSE ; iie0 = ipi - nn_hls ! default: -> until inner domain140 IF( ipni == 1 ) THEN ; iis0 = 1 ! domain left side: as e-w comm already done -> from 1st column 141 ELSE ; iis0 = 1 + khls ! default: -> from inner domain 142 ENDIF 143 IF( ipni == jpni ) THEN ; iie0 = ipi ! domain right side: as e-w comm already done -> until last column 144 ELSE ; iie0 = ipi - khls ! default: -> until inner domain 144 145 ENDIF 145 146 impp = nfimpp(ipni) - nfimpp(isendto(1)) … … 205 206 ij1 = jj_b( 1 ,jf) 206 207 ij2 = jj_b(ipj_s(jf),jf) 207 CALL lbc_nfd_nogather( ptab(jf)%pt4d(:,:,:,:), ztabr(:,ij1:ij2,:,:), cd_nat(jf), psgn(jf) )208 CALL lbc_nfd_nogather( ptab(jf)%pt4d(:,:,:,:), ztabr(:,ij1:ij2,:,:), cd_nat(jf), psgn(jf), khls ) 208 209 END DO 209 210 ! … … 221 222 ! 222 223 ! how many lines do we exchange at max? -> ipj (no further optimizations in this case...) 223 ipj = nn_hls + 2224 ipj = khls + 2 224 225 ! how many lines do we need at max? -> ipj2 (no further optimizations in this case...) 225 ipj2 = 2 * nn_hls + 2226 ! 227 i0max = jpimax - 2 * nn_hls226 ipj2 = 2 * khls + 2 227 ! 228 i0max = jpimax - 2 * khls 228 229 ibuffsize = i0max * ipj * ipk * ipl * ipf 229 230 ALLOCATE( znorthloc(i0max,ipj,ipk,ipl,ipf), znorthglo(i0max,ipj,ipk,ipl,ipf,ndim_rank_north) ) … … 255 256 END DO 256 257 ! 257 ! need to fill only the first ipj lines of ztabglo as lbc_nfd don't use the last nn_hls lines258 ! need to fill only the first ipj lines of ztabglo as lbc_nfd don't use the last khls lines 258 259 ijnr = 0 259 260 DO jr = 1, jpni ! recover the global north array 260 261 iproc = nfproc(jr) 261 262 impp = nfimpp(jr) 262 ipi = nfjpi( jr) - 2 * nn_hls ! corresponds to Ni_0 but for subdomain iproc263 ipi = nfjpi( jr) - 2 * khls ! corresponds to Ni_0 but for subdomain iproc 263 264 IF( iproc == -1 ) THEN ! No neighbour (land proc that was suppressed) 264 265 ! … … 270 271 ij2 = jpj - ipj2 + jj ! the first ipj lines of the last ipj2 lines 271 272 DO ji = 1, ipi 272 ii1 = impp + nn_hls + ji - 1 ! corresponds to mig(nn_hls + ji) but for subdomain iproc273 ii1 = impp + khls + ji - 1 ! corresponds to mig(khls + ji) but for subdomain iproc 273 274 ztabglo(jf)%pt4d(ii1,jj,jk,jl) = ptab(jf)%pt4d(Nis0,ij2,jk,jl) ! chose to take the 1st inner domain point 274 275 END DO … … 279 280 DO jj = 1, ipj 280 281 DO ji = 1, ipi 281 ii1 = impp + nn_hls + ji - 1 ! corresponds to mig(nn_hls + ji) but for subdomain iproc282 ii1 = impp + khls + ji - 1 ! corresponds to mig(khls + ji) but for subdomain iproc 282 283 ztabglo(jf)%pt4d(ii1,jj,jk,jl) = pfillval 283 284 END DO … … 291 292 DO jj = 1, ipj 292 293 DO ji = 1, ipi 293 ii1 = impp + nn_hls + ji - 1 ! corresponds to mig(nn_hls + ji) but for subdomain iproc294 ii1 = impp + khls + ji - 1 ! corresponds to mig(khls + ji) but for subdomain iproc 294 295 ztabglo(jf)%pt4d(ii1,jj,jk,jl) = znorthglo(ji,jj,jk,jl,jf,ijnr) 295 296 END DO … … 302 303 ! 303 304 DO jf = 1, ipf 304 CALL lbc_nfd( ztabglo(jf:jf), cd_nat(jf:jf), psgn(jf:jf), 1 ) ! North fold boundary condition305 CALL lbc_nfd( ztabglo(jf:jf), cd_nat(jf:jf), psgn(jf:jf), khls, 1 ) ! North fold boundary condition 305 306 DO jl = 1, ipl ; DO jk = 1, ipk ! e-w periodicity 306 DO jj = 1, nn_hls + 1307 ij1 = ipj2 - ( nn_hls + 1) + jj ! need only the last nn_hls + 1 lines until ipj2308 ztabglo(jf)%pt4d( 1:nn_hls,ij1,jk,jl) = ztabglo(jf)%pt4d(jpiglo-2*nn_hls+1:jpiglo-nn_hls,ij1,jk,jl)309 ztabglo(jf)%pt4d(jpiglo- nn_hls+1:jpiglo,ij1,jk,jl) = ztabglo(jf)%pt4d( nn_hls+1: 2*nn_hls,ij1,jk,jl)307 DO jj = 1, khls + 1 308 ij1 = ipj2 - (khls + 1) + jj ! need only the last khls + 1 lines until ipj2 309 ztabglo(jf)%pt4d( 1: khls,ij1,jk,jl) = ztabglo(jf)%pt4d(jpiglo-2*khls+1:jpiglo-khls,ij1,jk,jl) 310 ztabglo(jf)%pt4d(jpiglo-khls+1:jpiglo,ij1,jk,jl) = ztabglo(jf)%pt4d( khls+1: 2*khls,ij1,jk,jl) 310 311 END DO 311 312 END DO ; END DO … … 313 314 ! 314 315 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ! Scatter back to ARRAY_IN 315 DO jj = 1, nn_hls + 1316 ij1 = jpj - ( nn_hls + 1) + jj ! last nn_hls + 1 lines until jpj317 ij2 = ipj2 - ( nn_hls + 1) + jj ! last nn_hls + 1 lines until ipj2316 DO jj = 1, khls + 1 317 ij1 = jpj - (khls + 1) + jj ! last khls + 1 lines until jpj 318 ij2 = ipj2 - (khls + 1) + jj ! last khls + 1 lines until ipj2 318 319 DO ji= 1, jpi 319 320 ii2 = mig(ji) -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC/mppini.F90
r14338 r14363 121 121 !! mpinei : number of neighboring domains (starting at 0, -1 if no neighbourg) 122 122 !!---------------------------------------------------------------------- 123 INTEGER :: ji, jj, jn, jp 123 INTEGER :: ji, jj, jn, jp, jh 124 124 INTEGER :: ii, ij, ii2, ij2 125 125 INTEGER :: inijmin ! number of oce subdomains … … 128 128 INTEGER :: ierr, ios 129 129 INTEGER :: inbi, inbj, iimax, ijmax, icnt1, icnt2 130 INTEGER, DIMENSION(16*n_hlsmax) :: ichanged 130 131 INTEGER, ALLOCATABLE, DIMENSION(: ) :: iin, ijn 131 132 INTEGER, ALLOCATABLE, DIMENSION(:,: ) :: iimppt, ijpi, ipproc … … 441 442 WRITE(inum,'(a)') ' jpnij jpimax jpjmax jpk jpiglo jpjglo ( local: narea jpi jpj )' 442 443 WRITE(inum,'(6i7,a,3i7,a)') jpnij,jpimax,jpjmax,jpk,jpiglo,jpjglo,' ( local: ',narea,jpi,jpj,' )' 443 WRITE(inum,'(a)') ' narea ii ij jpi jpj nimpp njmpp mpiwe mpiea mpiso mpino mpisw mpise mpinw mpine' 444 WRITE(inum,*) 445 WRITE(inum, *) '------------------------------------' 446 WRITE(inum,'(a,i2)') ' Mapping of the default neighnourgs ' 447 WRITE(inum, *) '------------------------------------' 448 WRITE(inum,*) 449 WRITE(inum,'(a)') ' rank ii ij jpi jpj nimpp njmpp mpiwe mpiea mpiso mpino mpisw mpise mpinw mpine' 444 450 DO jp = 1, jpnij 445 451 ii = iin(jp) 446 452 ij = ijn(jp) 447 WRITE(inum,'(15i6)') jp , ii, ij, ijpi(ii,ij),ijpj(ii,ij), iimppt(ii,ij), ijmppt(ii,ij), inei(:,ii,ij)453 WRITE(inum,'(15i6)') jp-1, ii, ij, ijpi(ii,ij), ijpj(ii,ij), iimppt(ii,ij), ijmppt(ii,ij), inei(:,ii,ij) 448 454 END DO 449 455 END IF … … 479 485 ! set default neighbours 480 486 mpinei(:) = impi(:,narea) 487 DO jh = 1, n_hlsmax 488 mpiSnei(jh,:) = impi(:,narea) ! default definition 489 mpiRnei(jh,:) = impi(:,narea) 490 END DO 481 491 ! 482 492 IF(lwp) THEN … … 489 499 WRITE(numout,*) ' mpi nei no-we = ', mpinei(jpnw) , ' mpi nei no-ea = ', mpinei(jpne) 490 500 ENDIF 491 !492 501 ! ! Prepare mpp north fold 493 502 ! … … 501 510 WRITE(numout,*) ' ==>>> North fold boundary prepared for jpni >1' 502 511 ENDIF 503 IF (llwrtlay) THEN ! additional prints in layout.dat512 IF (llwrtlay) THEN ! additional prints in layout.dat 504 513 WRITE(inum,*) 505 514 WRITE(inum,*) 506 WRITE(inum,*) ' number of subdomains located along the north fold : ', ndim_rank_north515 WRITE(inum,*) 'Number of subdomains located along the north fold : ', ndim_rank_north 507 516 WRITE(inum,*) 'Rank of the subdomains located along the north fold : ', ndim_rank_north 508 517 DO jp = 1, ndim_rank_north, 5 … … 521 530 ENDIF 522 531 ! 523 CALL mpp_ini_nc ! Initialize communicator for neighbourhood collective communications 524 ! 525 CALL init_ioipsl ! Prepare NetCDF output file (if necessary) 532 CALL mpp_ini_nc(nn_hls) ! Initialize communicator for neighbourhood collective communications 533 DO jh = 1, n_hlsmax 534 mpi_nc_com4(jh) = mpi_nc_com4(nn_hls) ! default definition 535 mpi_nc_com8(jh) = mpi_nc_com8(nn_hls) 536 END DO 537 ! 538 CALL init_excl_landpt ! exclude exchanges which contain only land points 539 ! 540 ! Save processor layout changes in ascii file 541 DO jh = 1, n_hlsmax ! different halo size 542 DO ji = 1, 8 543 ichanged(16*(jh-1) +ji) = COUNT( mpinei(ji:ji) /= mpiSnei(jh,ji:ji) ) 544 ichanged(16*(jh-1)+8+ji) = COUNT( mpinei(ji:ji) /= mpiRnei(jh,ji:ji) ) 545 END DO 546 END DO 547 CALL mpp_sum( "mpp_init", ichanged ) ! must be called by all processes 548 IF (llwrtlay) THEN 549 WRITE(inum,*) 550 WRITE(inum, *) '----------------------------------------------------------------------' 551 WRITE(inum,'(a,i2)') ' Mapping of the neighnourgs once excluding comm with only land points ' 552 WRITE(inum, *) '----------------------------------------------------------------------' 553 DO jh = 1, n_hlsmax ! different halo size 554 WRITE(inum,*) 555 WRITE(inum,'(a,i2)') 'halo size: ', jh 556 WRITE(inum, *) '---------' 557 WRITE(inum,'(a)') ' rank ii ij mpiwe mpiea mpiso mpino mpisw mpise mpinw mpine' 558 WRITE(inum, '(11i6,a)') narea-1, iin(narea), ijn(narea), mpinei(:), ' <- Org' 559 WRITE(inum,'(18x,8i6,a,i1,a)') mpiSnei(jh,:), ' <- Send ', COUNT( mpinei(:) /= mpiSnei(jh,:) ), ' modif' 560 WRITE(inum,'(18x,8i6,a,i1,a)') mpiRnei(jh,:), ' <- Recv ', COUNT( mpinei(:) /= mpiRnei(jh,:) ), ' modif' 561 WRITE(inum,*) ' total changes among all mpi tasks:' 562 WRITE(inum,*) ' mpiwe mpiea mpiso mpino mpisw mpise mpinw mpine' 563 WRITE(inum,'(a,8i6)') ' Send: ', ichanged(jh*16-15:jh*16-8) 564 WRITE(inum,'(a,8i6)') ' Recv: ', ichanged(jh*16 -7:jh*16 ) 565 END DO 566 END IF 567 ! 568 CALL init_ioipsl ! Prepare NetCDF output file (if necessary) 526 569 ! 527 570 IF (llwrtlay) CLOSE(inum) … … 878 921 ! 879 922 ALLOCATE( lloce(Ni0glo, ijsz) ) ! allocate the strip 880 CALL read bot_strip( ijstr, ijsz, lloce )923 CALL read_mask( 1, ijstr, Ni0glo, ijsz, lloce ) 881 924 inboce = COUNT(lloce) ! number of ocean point in the stripe 882 925 DEALLOCATE(lloce) … … 948 991 inry = iny - COUNT( (/ iarea == 1, iarea == inbj /) ) ! number of point to read in y-direction 949 992 isty = 1 + COUNT( (/ iarea == 1 /) ) ! read from the first or the second line? 950 CALL read bot_strip( ijmppt(1,iarea) - 2 + isty, inry, lloce(2:inx-1, isty:inry+isty-1) ) ! read the strip993 CALL read_mask( 1, ijmppt(1,iarea) - 2 + isty, Ni0glo, inry, lloce(2:inx-1, isty:inry+isty-1) ) ! read the strip 951 994 ! 952 995 IF( iarea == 1 ) THEN ! the first line was not read 953 996 IF( l_Jperio ) THEN ! north-south periodocity 954 CALL read bot_strip( Nj0glo, 1, lloce(2:inx-1, 1) ) ! read the last line -> first line of lloce997 CALL read_mask( 1, Nj0glo, Ni0glo, 1, lloce(2:inx-1, 1) ) ! read the last line -> first line of lloce 955 998 ELSE 956 999 lloce(2:inx-1, 1) = .FALSE. ! closed boundary … … 959 1002 IF( iarea == inbj ) THEN ! the last line was not read 960 1003 IF( l_Jperio ) THEN ! north-south periodocity 961 CALL read bot_strip( 1, 1, lloce(2:inx-1,iny) )! read the first line -> last line of lloce1004 CALL read_mask( 1, 1, Ni0glo, 1, lloce(2:inx-1,iny) ) ! read the first line -> last line of lloce 962 1005 ELSEIF( c_NFtype == 'T' ) THEN ! north-pole folding T-pivot, T-point 963 1006 lloce(2,iny) = lloce(2,iny-2) ! here we have 1 halo (even if nn_hls>1) … … 1004 1047 1005 1048 1006 SUBROUTINE read bot_strip( kjstr, kjcnt, ldoce )1007 !!---------------------------------------------------------------------- 1008 !! *** ROUTINE read bot_strip***1049 SUBROUTINE read_mask( kistr, kjstr, kicnt, kjcnt, ldoce ) 1050 !!---------------------------------------------------------------------- 1051 !! *** ROUTINE read_mask *** 1009 1052 !! 1010 1053 !! ** Purpose : Read relevant bathymetric information in order to … … 1014 1057 !! ** Method : read stipe of size (Ni0glo,...) 1015 1058 !!---------------------------------------------------------------------- 1016 INTEGER , INTENT(in ) :: kjstr ! startingj position of the reading1017 INTEGER , INTENT(in ) :: kjcnt ! number of lines to read1018 LOGICAL, DIMENSION( Ni0glo,kjcnt), INTENT( out) :: ldoce! ldoce(i,j) = .true. if the point (i,j) is ocean1019 ! 1020 INTEGER :: inumsave! local logical unit1021 REAL(wp), DIMENSION( Ni0glo,kjcnt) :: zbot, zbdy1059 INTEGER , INTENT(in ) :: kistr, kjstr ! starting i and j position of the reading 1060 INTEGER , INTENT(in ) :: kicnt, kjcnt ! number of points to read in i and j directions 1061 LOGICAL, DIMENSION(kicnt,kjcnt), INTENT( out) :: ldoce ! ldoce(i,j) = .true. if the point (i,j) is ocean 1062 ! 1063 INTEGER :: inumsave ! local logical unit 1064 REAL(wp), DIMENSION(kicnt,kjcnt) :: zbot, zbdy 1022 1065 !!---------------------------------------------------------------------- 1023 1066 ! … … 1025 1068 ! 1026 1069 IF( numbot /= -1 ) THEN 1027 CALL iom_get( numbot, jpdom_unknown, 'bottom_level', zbot, kstart = (/ 1,kjstr/), kcount = (/Ni0glo, kjcnt/) )1070 CALL iom_get( numbot, jpdom_unknown, 'bottom_level', zbot, kstart = (/kistr,kjstr/), kcount = (/kicnt, kjcnt/) ) 1028 1071 ELSE 1029 1072 zbot(:,:) = 1._wp ! put a non-null value … … 1031 1074 ! 1032 1075 IF( numbdy /= -1 ) THEN ! Adjust with bdy_msk if it exists 1033 CALL iom_get ( numbdy, jpdom_unknown, 'bdy_msk', zbdy, kstart = (/ 1,kjstr/), kcount = (/Ni0glo, kjcnt/) )1076 CALL iom_get ( numbdy, jpdom_unknown, 'bdy_msk', zbdy, kstart = (/kistr,kjstr/), kcount = (/kicnt, kjcnt/) ) 1034 1077 zbot(:,:) = zbot(:,:) * zbdy(:,:) 1035 1078 ENDIF 1036 1079 ! 1037 ldoce(:,:) = zbot(:,:) > 0._wp1080 ldoce(:,:) = NINT(zbot(:,:)) > 0 1038 1081 numout = inumsave 1039 1082 ! 1040 END SUBROUTINE read bot_strip1083 END SUBROUTINE read_mask 1041 1084 1042 1085 … … 1092 1135 ! 1093 1136 END SUBROUTINE mpp_getnum 1137 1138 1139 SUBROUTINE init_excl_landpt 1140 !!---------------------------------------------------------------------- 1141 !! *** ROUTINE *** 1142 !! 1143 !! ** Purpose : exclude exchanges which contain only land points 1144 !! 1145 !! ** Method : if a send or receive buffer constains only land point we 1146 !! flag off the corresponding communication 1147 !! Warning: this selection depend on the halo size -> loop on halo size 1148 !! 1149 !!---------------------------------------------------------------------- 1150 INTEGER :: inumsave 1151 INTEGER :: jh 1152 INTEGER :: ipi, ipj 1153 INTEGER :: iiwe, iiea, iist, iisz 1154 INTEGER :: ijso, ijno, ijst, ijsz 1155 LOGICAL :: llsave 1156 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zmsk 1157 LOGICAL , DIMENSION(Ni_0,Nj_0,1) :: lloce 1158 !!---------------------------------------------------------------------- 1159 ! 1160 ! read the land-sea mask on the inner domain 1161 CALL read_mask( nimpp, njmpp, Ni_0, Nj_0, lloce(:,:,1) ) 1162 ! 1163 ! Here we look only at communications excluding the NP folding. 1164 ! As lbcnfd not validated if halo size /= nn_hls, we switch if off temporary... 1165 llsave = l_IdoNFold 1166 l_IdoNFold = .FALSE. 1167 ! 1168 DO jh = 1, n_hlsmax ! different halo size 1169 ! 1170 ipi = Ni_0 + 2*jh ! local domain size 1171 ipj = Nj_0 + 2*jh 1172 ! 1173 ALLOCATE( zmsk(ipi,ipj) ) 1174 zmsk(jh+1:jh+Ni_0,jh+1:jh+Nj_0) = REAL(COUNT(lloce, dim = 3), wp) ! define inner domain -> need REAL to use lbclnk 1175 CALL lbc_lnk('mppini', zmsk, 'T', 1._wp, khls = jh) ! fill halos 1176 ! 1177 iiwe = jh ; iiea = Ni_0 ! bottom-left corfer - 1 of the sent data 1178 ijso = jh ; ijno = Nj_0 1179 IF( nn_comm == 1 ) THEN 1180 iist = 0 ; iisz = ipi 1181 ijst = 0 ; ijsz = ipj 1182 ELSE 1183 iist = jh ; iisz = Ni_0 1184 ijst = jh ; ijsz = Nj_0 1185 ENDIF 1186 IF( nn_comm == 1 ) THEN ! SM: NOT WORKING FOR NEIGHBOURHOOD COLLECTIVE COMMUNICATIONS, I DON'T KNOW WHY... 1187 ! do not send if we send only land points 1188 IF( NINT(SUM( zmsk(iiwe+1:iiwe+jh ,ijst+1:ijst+ijsz) )) == 0 ) mpiSnei(jh,jpwe) = -1 1189 IF( NINT(SUM( zmsk(iiea+1:iiea+jh ,ijst+1:ijst+ijsz) )) == 0 ) mpiSnei(jh,jpea) = -1 1190 IF( NINT(SUM( zmsk(iist+1:iist+iisz,ijso+1:ijso+jh ) )) == 0 ) mpiSnei(jh,jpso) = -1 1191 IF( NINT(SUM( zmsk(iist+1:iist+iisz,ijno+1:ijno+jh ) )) == 0 ) mpiSnei(jh,jpno) = -1 1192 IF( NINT(SUM( zmsk(iiwe+1:iiwe+jh ,ijso+1:ijso+jh ) )) == 0 ) mpiSnei(jh,jpsw) = -1 1193 IF( NINT(SUM( zmsk(iiea+1:iiea+jh ,ijso+1:ijso+jh ) )) == 0 ) mpiSnei(jh,jpse) = -1 1194 IF( NINT(SUM( zmsk(iiwe+1:iiwe+jh ,ijno+1:ijno+jh ) )) == 0 ) mpiSnei(jh,jpnw) = -1 1195 IF( NINT(SUM( zmsk(iiea+1:iiea+jh ,ijno+1:ijno+jh ) )) == 0 ) mpiSnei(jh,jpne) = -1 1196 ! 1197 iiwe = iiwe-jh ; iiea = iiea+jh ! bottom-left corfer - 1 of the received data 1198 ijso = ijso-jh ; ijno = ijno+jh 1199 ! do not send if we send only land points 1200 IF( NINT(SUM( zmsk(iiwe+1:iiwe+jh ,ijst+1:ijst+ijsz) )) == 0 ) mpiRnei(jh,jpwe) = -1 1201 IF( NINT(SUM( zmsk(iiea+1:iiea+jh ,ijst+1:ijst+ijsz) )) == 0 ) mpiRnei(jh,jpea) = -1 1202 IF( NINT(SUM( zmsk(iist+1:iist+iisz,ijso+1:ijso+jh ) )) == 0 ) mpiRnei(jh,jpso) = -1 1203 IF( NINT(SUM( zmsk(iist+1:iist+iisz,ijno+1:ijno+jh ) )) == 0 ) mpiRnei(jh,jpno) = -1 1204 IF( NINT(SUM( zmsk(iiwe+1:iiwe+jh ,ijso+1:ijso+jh ) )) == 0 ) mpiRnei(jh,jpsw) = -1 1205 IF( NINT(SUM( zmsk(iiea+1:iiea+jh ,ijso+1:ijso+jh ) )) == 0 ) mpiRnei(jh,jpse) = -1 1206 IF( NINT(SUM( zmsk(iiwe+1:iiwe+jh ,ijno+1:ijno+jh ) )) == 0 ) mpiRnei(jh,jpnw) = -1 1207 IF( NINT(SUM( zmsk(iiea+1:iiea+jh ,ijno+1:ijno+jh ) )) == 0 ) mpiRnei(jh,jpne) = -1 1208 ENDIF 1209 ! 1210 DEALLOCATE( zmsk ) 1211 ! 1212 CALL mpp_ini_nc(jh) ! Initialize/Update communicator for neighbourhood collective communications 1213 ! 1214 END DO 1215 l_IdoNFold = llsave 1216 1217 END SUBROUTINE init_excl_landpt 1094 1218 1095 1219 -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/SBC/sbcblk.F90
r14338 r14363 501 501 !!---------------------------------------------------------------------- 502 502 REAL(wp), DIMENSION(jpi,jpj) :: zssq, zcd_du, zsen, zlat, zevp 503 REAL(wp) :: ztmp 503 REAL(wp) :: ztst 504 LOGICAL :: llerr 504 505 !!---------------------------------------------------------------------- 505 506 ! … … 512 513 IF(lwp) WRITE(numout,*) ' === AGRIF => Sanity/consistence test on air humidity SKIPPED! :( ===' 513 514 #else 514 ztmp = SUM(tmask(:,:,1)) ! number of ocean points on local proc domain 515 IF( ztmp > 8._wp ) THEN ! test only on proc domains with at least 8 ocean points! 516 ztmp = SUM(sf(jp_humi)%fnow(:,:,1)*tmask(:,:,1))/ztmp ! mean humidity over ocean on proc 515 ztst = SUM(tmask(:,:,1)) ! number of ocean points on local proc domain 516 IF( ztst > 8._wp ) THEN ! test only on proc domains with at least 8 ocean points! 517 ztst = SUM(sf(jp_humi)%fnow(:,:,1)*tmask(:,:,1))/ztst ! mean humidity over ocean on proc 518 llerr = .FALSE. 517 519 SELECT CASE( nhumi ) 518 520 CASE( np_humi_sph ) ! specific humidity => expect: 0. <= something < 0.065 [kg/kg] (0.061 is saturation at 45degC !!!) 519 IF( (ztmp < 0._wp) .OR. (ztmp > 0.065) ) ztmp = -1._wp521 IF( (ztst < 0._wp) .OR. (ztst > 0.065_wp) ) llerr = .TRUE. 520 522 CASE( np_humi_dpt ) ! dew-point temperature => expect: 110. <= something < 320. [K] 521 IF( (zt mp < 110._wp).OR.(ztmp > 320._wp) ) ztmp = -1._wp523 IF( (ztst < 110._wp) .OR. (ztst > 320._wp) ) llerr = .TRUE. 522 524 CASE( np_humi_rlh ) ! relative humidity => expect: 0. <= something < 100. [%] 523 IF( (ztmp < 0._wp) .OR.(ztmp > 100._wp) ) ztmp = -1._wp525 IF( (ztst < 0._wp) .OR. (ztst > 100._wp) ) llerr = .TRUE. 524 526 END SELECT 525 IF( ztmp < 0._wp) THEN526 IF (lwp) WRITE(numout,'(" Mean humidity value found on proc #",i6.6," is: ",f10.5)') narea, ztmp527 CALL ctl_stop( 'STOP', 'Something is wrong with air humidity!!!', &527 IF(llerr) THEN 528 WRITE(ctmp1,'(" Error on mean humidity value: ",f10.5)') ztst 529 CALL ctl_stop( 'STOP', ctmp1, 'Something is wrong with air humidity!!!', & 528 530 & ' ==> check the unit in your input files' , & 529 531 & ' ==> check consistence of namelist choice: specific? relative? dew-point?', & -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/lib_fortran.F90
r14314 r14363 232 232 ! no need for 2nd exchange when nn_hls > 1 233 233 IF( nn_hls == 1 ) THEN 234 IF( mpi nei(jpwe) > -1 ) THEN ! 1st column was changed beacuse of an MPI communicationduring the previous call to lbc_lnk234 IF( mpiRnei(nn_hls,jpwe) > -1 ) THEN ! 1st column was changed during the previous call to lbc_lnk 235 235 IF( MOD(mig( 1), 3) == 1 ) & ! 1st box start at i=1 -> column 1 to 3 correctly computed locally 236 236 p2d( 1,:) = p2d( 2,:) ! previous lbc_lnk corrupted column 1 -> put it back using column 2 … … 238 238 p2d( 2,:) = p2d( 1,:) ! previous lbc_lnk fix column 1 -> copy it to column 2 239 239 ENDIF 240 IF( mpi nei(jpea) > -1 ) THEN240 IF( mpiRnei(nn_hls,jpea) > -1 ) THEN 241 241 IF( MOD(mig(jpi-2), 3) == 1 ) p2d( jpi,:) = p2d(jpi-1,:) 242 242 IF( MOD(mig(jpi-2), 3) == 0 ) p2d(jpi-1,:) = p2d( jpi,:) 243 243 ENDIF 244 IF( mpi nei(jpso) > -1 ) THEN244 IF( mpiRnei(nn_hls,jpso) > -1 ) THEN 245 245 IF( MOD(mjg( 1), 3) == 1 ) p2d(:, 1) = p2d(:, 2) 246 246 IF( MOD(mjg( 1), 3) == 2 ) p2d(:, 2) = p2d(:, 1) 247 247 ENDIF 248 IF( mpi nei(jpno) > -1 ) THEN248 IF( mpiRnei(nn_hls,jpno) > -1 ) THEN 249 249 IF( MOD(mjg(jpj-2), 3) == 1 ) p2d(:, jpj) = p2d(:,jpj-1) 250 250 IF( MOD(mjg(jpj-2), 3) == 0 ) p2d(:,jpj-1) = p2d(:, jpj) … … 289 289 ! no need for 2nd exchange when nn_hls > 1 290 290 IF( nn_hls == 1 ) THEN 291 IF( mpi nei(jpwe) > -1 ) THEN ! 1st column was changed beacuse of an MPI communicationduring the previous call to lbc_lnk291 IF( mpiRnei(nn_hls,jpwe) > -1 ) THEN ! 1st column was changed during the previous call to lbc_lnk 292 292 IF( MOD(mig( 1), 3) == 1 ) & ! 1st box start at i=1 -> column 1 to 3 correctly computed locally 293 293 p3d( 1,:,:) = p3d( 2,:,:) ! previous lbc_lnk corrupted column 1 -> put it back using column 2 … … 295 295 p3d( 2,:,:) = p3d( 1,:,:) ! previous lbc_lnk fix column 1 -> copy it to column 2 296 296 ENDIF 297 IF( mpi nei(jpea) > -1 ) THEN297 IF( mpiRnei(nn_hls,jpea) > -1 ) THEN 298 298 IF( MOD(mig(jpi-2), 3) == 1 ) p3d( jpi,:,:) = p3d(jpi-1,:,:) 299 299 IF( MOD(mig(jpi-2), 3) == 0 ) p3d(jpi-1,:,:) = p3d( jpi,:,:) 300 300 ENDIF 301 IF( mpi nei(jpso) > -1 ) THEN301 IF( mpiRnei(nn_hls,jpso) > -1 ) THEN 302 302 IF( MOD(mjg( 1), 3) == 1 ) p3d(:, 1,:) = p3d(:, 2,:) 303 303 IF( MOD(mjg( 1), 3) == 2 ) p3d(:, 2,:) = p3d(:, 1,:) 304 304 ENDIF 305 IF( mpi nei(jpno) > -1 ) THEN305 IF( mpiRnei(nn_hls,jpno) > -1 ) THEN 306 306 IF( MOD(mjg(jpj-2), 3) == 1 ) p3d(:, jpj,:) = p3d(:,jpj-1,:) 307 307 IF( MOD(mjg(jpj-2), 3) == 0 ) p3d(:,jpj-1,:) = p3d(:, jpj,:)
Note: See TracChangeset
for help on using the changeset viewer.
