Changeset 14366
- Timestamp:
- 2021-02-01T18:06:01+01:00 (4 years ago)
- Location:
- NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE
- Files:
-
- 6 edited
-
LBC/lbc_lnk_call_generic.h90 (modified) (3 diffs)
-
LBC/lbc_lnk_neicoll_generic.h90 (modified) (7 diffs)
-
LBC/lbc_lnk_pt2pt_generic.h90 (modified) (17 diffs)
-
LBC/lbclnk.F90 (modified) (1 diff)
-
LBC/mppini.F90 (modified) (6 diffs)
-
module_example.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC/lbc_lnk_call_generic.h90
r14363 r14366 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, khls, lsend, lrecv, ncsten)26 & , kfillmode, pfillval, khls, lsend, lrecv, ld4only ) 27 27 !!--------------------------------------------------------------------- 28 28 CHARACTER(len=*) , INTENT(in ) :: cdname ! name of the calling subroutine … … 40 40 INTEGER , OPTIONAL , INTENT(in ) :: khls ! halo size, default = nn_hls 41 41 LOGICAL, DIMENSION(4), OPTIONAL , INTENT(in ) :: lsend, lrecv ! indicate how communications are to be carried out 42 LOGICAL , OPTIONAL , INTENT(in ) :: ncsten42 LOGICAL , OPTIONAL , INTENT(in ) :: ld4only ! if .T., do only 4-neighbour comm (ignore corners) 43 43 !! 44 44 INTEGER :: kfld ! number of elements that will be attributed … … 71 71 ! 72 72 IF( nn_comm == 1 ) THEN 73 CALL lbc_lnk_pt2pt( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, khls, lsend, lrecv )73 CALL lbc_lnk_pt2pt( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, khls, lsend, lrecv, ld4only ) 74 74 ELSE 75 CALL lbc_lnk_neicoll( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, khls, lsend, lrecv, ncsten)75 CALL lbc_lnk_neicoll( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, khls, lsend, lrecv, ld4only ) 76 76 ENDIF 77 77 ! -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC/lbc_lnk_neicoll_generic.h90
r14363 r14366 1 1 2 SUBROUTINE lbc_lnk_neicoll_/**/PRECISION( cdname, ptab, cd_nat, psgn, kfld, kfillmode, pfillval, khls, lsend, lrecv, ncsten)2 SUBROUTINE lbc_lnk_neicoll_/**/PRECISION( cdname, ptab, cd_nat, psgn, kfld, kfillmode, pfillval, khls, lsend, lrecv, ld4only ) 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. … … 10 10 INTEGER , OPTIONAL, INTENT(in ) :: khls ! halo size, default = nn_hls 11 11 LOGICAL, DIMENSION(4),OPTIONAL, INTENT(in ) :: lsend, lrecv ! communication with other 4 proc 12 LOGICAL, OPTIONAL, INTENT(in ) :: ncsten ! 5-point or 9-point stencil12 LOGICAL, OPTIONAL, INTENT(in ) :: ld4only ! if .T., do only 4-neighbour comm (ignore corners) 13 13 ! 14 14 INTEGER :: ji, jj, jk , jl, jf, jn ! dummy loop indices … … 31 31 REAL(PRECISION) :: zland 32 32 REAL(PRECISION), DIMENSION(:), ALLOCATABLE :: zsnd, zrcv ! halos arrays 33 LOGICAL :: ll ncall ! default: 9-point stencil33 LOGICAL :: ll4only ! default: 8 neighbourgs 34 34 LOGICAL :: ll_IdoNFold 35 35 !!---------------------------------------------------------------------- … … 64 64 ENDIF 65 65 ! 66 ll ncall = .TRUE. ! default definition67 IF( PRESENT( ncsten) ) llncall = ncsten68 ! 69 impi_nc = mpi_nc_com 4(ihls)70 IF( llncall) impi_nc = mpi_nc_com8(ihls)66 ll4only = .FALSE. ! default definition 67 IF( PRESENT(ld4only) ) ll4only = ld4only 68 ! 69 impi_nc = mpi_nc_com8(ihls) ! default 70 IF( ll4only ) impi_nc = mpi_nc_com4(ihls) 71 71 ! 72 72 zland = 0._wp ! land filling value: zero by default … … 80 80 WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk with only one of the two arguments lsend or lrecv' 81 81 CALL ctl_stop( 'STOP', ctmp1 ) 82 ELSE 82 ELSE ! default neighbours 83 83 llsend(:) = mpiSnei(ihls,:) >= 0 84 IF( .NOT. llncall ) llsend(5:8) = .FALSE.! exclude corners84 IF( ll4only ) llsend(5:8) = .FALSE. ! exclude corners 85 85 llrecv(:) = mpiRnei(ihls,:) >= 0 86 IF( .NOT. llncall ) llrecv(5:8) = .FALSE.! exclude corners87 END 86 IF( ll4only ) llrecv(5:8) = .FALSE. ! exclude corners 87 ENDIF 88 88 ! 89 89 ! define ifill: which method should be used to fill each parts (sides+corners) of the halos … … 94 94 ELSEIF( PRESENT(kfillmode) ) THEN ; ifill(jn) = kfillmode ! localy defined 95 95 ELSE ; ifill(jn) = jpfillcst ! constant value (zland) 96 END 96 ENDIF 97 97 END DO 98 98 ! take care of "indirect self-periodicity" for the corners … … 167 167 idx = idx + 1 168 168 END DO ; END DO ; END DO ; END DO ; END DO 169 END 169 ENDIF 170 170 END DO 171 171 ! -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC/lbc_lnk_pt2pt_generic.h90
r14363 r14366 1 1 2 SUBROUTINE lbc_lnk_pt2pt_/**/PRECISION( cdname, ptab, cd_nat, psgn, kfld, kfillmode, pfillval, khls, lsend, lrecv )2 SUBROUTINE lbc_lnk_pt2pt_/**/PRECISION( cdname, ptab, cd_nat, psgn, kfld, kfillmode, pfillval, khls, lsend, lrecv, ld4only ) 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. … … 10 10 INTEGER , OPTIONAL, INTENT(in ) :: khls ! halo size, default = nn_hls 11 11 LOGICAL, DIMENSION(4),OPTIONAL, INTENT(in ) :: lsend, lrecv ! communication with other 4 proc 12 LOGICAL, OPTIONAL, INTENT(in ) :: ld4only ! if .T., do only 4-neighbour comm (ignore corners) 12 13 ! 13 14 INTEGER :: ji, jj, jk, jl, jf, jn ! dummy loop indices … … 18 19 INTEGER :: ifill_nfd, icomm, ierr 19 20 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 23 INTEGER, DIMENSION(4) :: ireq ! mpi_request id 21 INTEGER, DIMENSION(4) :: iwewe, issnn 22 INTEGER, DIMENSION(8) :: isizei, ishtSi, ishtRi, ishtPi 23 INTEGER, DIMENSION(8) :: isizej, ishtSj, ishtRj, ishtPj 24 INTEGER, DIMENSION(8) :: ifill, iszall, ishtS, ishtR 25 INTEGER, DIMENSION(8) :: ireq ! mpi_request id 26 INTEGER, DIMENSION(8) :: iStag, iRtag ! Send and Recv mpi_tag id 24 27 REAL(PRECISION) :: zland 25 28 REAL(PRECISION), DIMENSION(:), ALLOCATABLE :: zsnd, zrcv ! halos arrays 26 LOGICAL, DIMENSION(4) :: llsend, llrecv 29 LOGICAL, DIMENSION(8) :: llsend, llrecv 30 LOGICAL :: ll4only ! default: 8 neighbourgs 27 31 LOGICAL :: ll_IdoNFold 28 32 !!---------------------------------------------------------------------- … … 40 44 IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ipk, ipl, ipf, ld_lbc = .TRUE. ) 41 45 ! 46 idxs = 1 ! initalize index for send buffer 47 idxr = 1 ! initalize index for recv buffer 48 icomm = mpi_comm_oce ! shorter name 49 ! 42 50 ! take care of optional parameters 43 51 ! … … 56 64 CALL ctl_stop( 'STOP', ctmp1 ) 57 65 ENDIF 66 ! 67 ll4only = .FALSE. ! default definition 68 IF( PRESENT(ld4only) ) ll4only = ld4only 58 69 ! 59 70 zland = 0._wp ! land filling value: zero by default … … 66 77 WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk with only one of the two arguments lsend or lrecv' 67 78 CALL ctl_stop( 'STOP', ctmp1 ) 68 ELSE ! default neighbours 69 llsend(:) = mpiSnei(ihls,1:4) >= 0 70 llrecv(:) = mpiRnei(ihls,1:4) >= 0 71 END IF 79 ELSE ! default neighbours 80 llsend(:) = mpiSnei(ihls,:) >= 0 81 IF( ll4only ) llsend(5:8) = .FALSE. ! exclude corners 82 llrecv(:) = mpiRnei(ihls,:) >= 0 83 IF( ll4only ) llrecv(5:8) = .FALSE. ! exclude corners 84 ENDIF 72 85 ! 73 86 ! define ifill: which method should be used to fill each parts (sides+corners) of the halos … … 78 91 ELSEIF( PRESENT(kfillmode) ) THEN ; ifill(jn) = kfillmode ! localy defined 79 92 ELSE ; ifill(jn) = jpfillcst ! constant value (zland) 80 END IF 81 END DO 93 ENDIF 94 END DO 95 DO jn = 5, 8 96 IF( llrecv(jn) ) THEN ; ifill(jn) = jpfillmpi ! with an mpi communication 97 ELSE ; ifill(jn) = jpfillnothing! do nothing 98 ENDIF 99 END DO 100 ! 82 101 ! north fold treatment 83 102 ll_IdoNFold = l_IdoNFold .AND. ifill(jpno) /= jpfillnothing … … 103 122 ! ! ip0i ip1i im1i im0i 104 123 ! 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 124 iwewe(:) = (/ jpwe,jpea,jpwe,jpea /) ; issnn(:) = (/ jpso,jpso,jpno,jpno /) 125 !cd sides: west east south north ; corners: so-we, so-ea, no-we, no-ea 126 isizei(1:4) = (/ ihls, ihls, ipi, ipi /) ; isizei(5:8) = ihls ! i- count 127 isizej(1:4) = (/ ipj, ipj, ihls, ihls /) ; isizej(5:8) = ihls ! j- count 128 ishtSi(1:4) = (/ ip1i, im1i, ip0i, ip0i /) ; ishtSi(5:8) = ishtSi( iwewe ) ! i- shift send data 129 ishtSj(1:4) = (/ ip0j, ip0j, ip1j, im1j /) ; ishtSj(5:8) = ishtSj( issnn ) ! j- shift send data 130 ishtRi(1:4) = (/ ip0i, im0i, ip0i, ip0i /) ; ishtRi(5:8) = ishtRi( iwewe ) ! i- shift received data location 131 ishtRj(1:4) = (/ ip0j, ip0j, ip0j, im0j /) ; ishtRj(5:8) = ishtRj( issnn ) ! j- shift received data location 132 ishtPi(1:4) = (/ im1i, ip1i, ip0i, ip0i /) ; ishtPi(5:8) = ishtPi( iwewe ) ! i- shift data used for periodicity 133 ishtPj(1:4) = (/ ip0j, ip0j, im1j, ip1j /) ; ishtPj(5:8) = ishtPj( issnn ) ! j- shift data used for periodicity 114 134 ! 115 135 ! -------------------------------- ! … … 117 137 ! -------------------------------- ! 118 138 ! 119 ireq(:) = MPI_REQUEST_NULL 139 ireq(:) = MPI_REQUEST_NULL ! default definition when no communication is done. understood by mpi_waitall 140 iStag = (/ 1, 2, 3, 4, 5, 6, 7, 8 /) ! any value but each one must be different 141 ! define iRtag with the corresponding iStag, e.g. data received at west where sent at east. 142 iRtag(jpwe) = iStag(jpea) ; iRtag(jpea) = iStag(jpwe) ; iRtag(jpso) = iStag(jpno) ; iRtag(jpno) = iStag(jpso) 143 iRtag(jpsw) = iStag(jpne) ; iRtag(jpse) = iStag(jpnw) ; iRtag(jpnw) = iStag(jpse) ; iRtag(jpne) = iStag(jpsw) 144 ! 120 145 iszall(:) = isizei(:) * isizej(:) * ipk * ipl * ipf 121 146 ishtS(1) = 0 122 DO jn = 2, 4123 ishtS(jn) = ishtS(jn-1) + iszall(jn-1) * COUNT( (/llsend(jn-1)/) ) ! with _alltoallv: in units of sendtype147 DO jn = 2, 8 148 ishtS(jn) = ishtS(jn-1) + iszall(jn-1) * COUNT( (/llsend(jn-1)/) ) 124 149 END DO 125 150 ishtR(1) = 0 126 DO jn = 2, 4127 ishtR(jn) = ishtR(jn-1) + iszall(jn-1) * COUNT( (/llrecv(jn-1)/) ) ! with _alltoallv: in units of sendtype151 DO jn = 2, 8 152 ishtR(jn) = ishtR(jn-1) + iszall(jn-1) * COUNT( (/llrecv(jn-1)/) ) 128 153 END DO 129 154 … … 131 156 ALLOCATE( zsnd( SUM(iszall, mask = llsend) ), zrcv( SUM(iszall, mask = llrecv) ) ) 132 157 ! 133 ! -------------------------------------------------- ! 134 ! 3. Do east and west MPI exchange if needed ! 135 ! -------------------------------------------------- ! 136 ! 137 ! fill sending buffer with ARRAY_IN 138 idxs = 1 158 ! ----------------------------------------------- ! 159 ! 3. Do east and west MPI_Isend if needed ! 160 ! ----------------------------------------------- ! 161 ! 139 162 DO jn = 1, 2 140 163 IF( llsend(jn) ) THEN … … 145 168 idxs = idxs + 1 146 169 END DO ; END DO ; END DO ; END DO ; END DO 147 END IF 148 END DO 149 ! 150 #if ! defined key_mpi_off 151 IF( ln_timing ) CALL tic_tac(.TRUE.) 152 ! 153 icomm = mpi_comm_oce ! shorter name 154 ! non-blocking send of the western/eastern side using local temporary arrays 155 jn = jpwe 156 IF( llsend(jn) ) CALL MPI_ISEND( zsnd(ishtS(jn)+1), iszall(jn), MPI_TYPE, mpiSnei(ihls,jn), 1, icomm, ireq(jn), ierr ) 157 jn = jpea 158 IF( llsend(jn) ) CALL MPI_ISEND( zsnd(ishtS(jn)+1), iszall(jn), MPI_TYPE, mpiSnei(ihls,jn), 2, icomm, ireq(jn), ierr ) 159 ! blocking receive of the western/eastern halo in local temporary arrays 160 jn = jpwe 161 IF( llrecv(jn) ) CALL MPI_RECV( zrcv(ishtR(jn)+1), iszall(jn), MPI_TYPE, mpiRnei(ihls,jn), 2, icomm, MPI_STATUS_IGNORE, ierr ) 162 jn = jpea 163 IF( llrecv(jn) ) CALL MPI_RECV( zrcv(ishtR(jn)+1), iszall(jn), MPI_TYPE, mpiRnei(ihls,jn), 1, icomm, MPI_STATUS_IGNORE, ierr ) 164 ! 165 IF( ln_timing ) CALL tic_tac(.FALSE.) 166 #endif 170 #if ! defined key_mpi_off 171 IF( ln_timing ) CALL tic_tac(.TRUE.) 172 ! non-blocking send of the west/east side using local buffer 173 CALL MPI_ISEND( zsnd(ishtS(jn)+1), iszall(jn), MPI_TYPE, mpiSnei(ihls,jn), iStag(jn), icomm, ireq(jn), ierr ) 174 IF( ln_timing ) CALL tic_tac(.FALSE.) 175 #endif 176 ENDIF 177 END DO 167 178 ! 168 179 ! ----------------------------------- ! … … 170 181 ! ----------------------------------- ! 171 182 ! 172 idxr = 1173 183 DO jn = 1, 2 174 184 ishti = ishtRi(jn) … … 177 187 CASE ( jpfillnothing ) ! no filling 178 188 CASE ( jpfillmpi ) ! fill with data received by MPI 189 #if ! defined key_mpi_off 190 IF( ln_timing ) CALL tic_tac(.TRUE.) 191 ! ! blocking receive of the west/east halo in local temporary arrays 192 CALL MPI_RECV( zrcv(ishtR(jn)+1), iszall(jn), MPI_TYPE, mpiRnei(ihls,jn), iRtag(jn), icomm, MPI_STATUS_IGNORE, ierr ) 193 IF( ln_timing ) CALL tic_tac(.FALSE.) 194 #endif 179 195 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1,isizej(jn) ; DO ji = 1,isizei(jn) 180 196 ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = zrcv(idxr) … … 212 228 ENDIF 213 229 ! 214 ! ------------------------------------------------- ---!215 ! 6. Do north and south MPI exchangeif needed !216 ! ------------------------------------------------- ---!230 ! ------------------------------------------------- ! 231 ! 6. Do north and south MPI_Isend if needed ! 232 ! ------------------------------------------------- ! 217 233 ! 218 234 DO jn = 3, 4 … … 224 240 idxs = idxs + 1 225 241 END DO ; END DO ; END DO ; END DO ; END DO 226 END IF 227 END DO 228 ! 229 #if ! defined key_mpi_off 230 IF( ln_timing ) CALL tic_tac(.TRUE.) 231 ! 232 ! non-blocking send of the western/eastern side using local temporary arrays 233 jn = jpso 234 IF( llsend(jn) ) CALL MPI_ISEND( zsnd(ishtS(jn)+1), iszall(jn), MPI_TYPE, mpiSnei(ihls,jn), 3, icomm, ireq(jn), ierr ) 235 jn = jpno 236 IF( llsend(jn) ) CALL MPI_ISEND( zsnd(ishtS(jn)+1), iszall(jn), MPI_TYPE, mpiSnei(ihls,jn), 4, icomm, ireq(jn), ierr ) 237 ! blocking receive of the western/eastern halo in local temporary arrays 238 jn = jpso 239 IF( llrecv(jn) ) CALL MPI_RECV( zrcv(ishtR(jn)+1), iszall(jn), MPI_TYPE, mpiRnei(ihls,jn), 4, icomm, MPI_STATUS_IGNORE, ierr ) 240 jn = jpno 241 IF( llrecv(jn) ) CALL MPI_RECV( zrcv(ishtR(jn)+1), iszall(jn), MPI_TYPE, mpiRnei(ihls,jn), 3, icomm, MPI_STATUS_IGNORE, ierr ) 242 ! 243 IF( ln_timing ) CALL tic_tac(.FALSE.) 244 #endif 242 #if ! defined key_mpi_off 243 IF( ln_timing ) CALL tic_tac(.TRUE.) 244 ! non-blocking send of the south/north side using local buffer 245 CALL MPI_ISEND( zsnd(ishtS(jn)+1), iszall(jn), MPI_TYPE, mpiSnei(ihls,jn), iStag(jn), icomm, ireq(jn), ierr ) 246 IF( ln_timing ) CALL tic_tac(.FALSE.) 247 #endif 248 ENDIF 249 END DO 245 250 ! 246 251 ! ------------------------------------- ! … … 254 259 CASE ( jpfillnothing ) ! no filling 255 260 CASE ( jpfillmpi ) ! fill with data received by MPI 261 #if ! defined key_mpi_off 262 IF( ln_timing ) CALL tic_tac(.TRUE.) 263 ! ! blocking receive of the south/north halo in local temporary arrays 264 CALL MPI_RECV( zrcv(ishtR(jn)+1), iszall(jn), MPI_TYPE, mpiRnei(ihls,jn), iRtag(jn), icomm, MPI_STATUS_IGNORE, ierr ) 265 IF( ln_timing ) CALL tic_tac(.FALSE.) 266 #endif 256 267 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1,isizej(jn) ; DO ji = 1,isizei(jn) 257 268 ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = zrcv(idxr) … … 277 288 END DO 278 289 ! 290 ! ----------------------------------------------- ! 291 ! 8. Specific problem in corner treatment ! 292 ! ( very rate case... ) ! 293 ! ----------------------------------------------- ! 294 ! 295 DO jn = 5, 8 296 IF( llsend(jn) ) THEN 297 ishti = ishtSi(jn) 298 ishtj = ishtSj(jn) 299 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1,isizej(jn) ; DO ji = 1,isizei(jn) 300 zsnd(idxs) = ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) 301 idxs = idxs + 1 302 END DO ; END DO ; END DO ; END DO ; END DO 303 #if ! defined key_mpi_off 304 IF( ln_timing ) CALL tic_tac(.TRUE.) 305 ! non-blocking send of the corners using local buffer 306 CALL MPI_ISEND( zsnd(ishtS(jn)+1), iszall(jn), MPI_TYPE, mpiSnei(ihls,jn), iStag(jn), icomm, ireq(jn), ierr ) 307 IF( ln_timing ) CALL tic_tac(.FALSE.) 308 #endif 309 ENDIF 310 END DO 311 DO jn = 5, 8 312 IF( llrecv(jn) ) THEN 313 #if ! defined key_mpi_off 314 IF( ln_timing ) CALL tic_tac(.TRUE.) 315 ! blocking receive of the corner halo in local temporary arrays 316 CALL MPI_RECV( zrcv(ishtR(jn)+1), iszall(jn), MPI_TYPE, mpiRnei(ihls,jn), iRtag(jn), icomm, MPI_STATUS_IGNORE, ierr ) 317 IF( ln_timing ) CALL tic_tac(.FALSE.) 318 #endif 319 ishti = ishtRi(jn) 320 ishtj = ishtRj(jn) 321 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1,isizej(jn) ; DO ji = 1,isizei(jn) 322 ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = zrcv(idxr) 323 idxr = idxr + 1 324 END DO ; END DO ; END DO ; END DO ; END DO 325 ENDIF 326 END DO 327 ! 279 328 ! -------------------------------------------- ! 280 ! 8. deallocate local temporary arrays !329 ! 9. deallocate local temporary arrays ! 281 330 ! -------------------------------------------- ! 282 331 ! 283 CALL mpi_waitall( 4, ireq, MPI_STATUSES_IGNORE, ierr)332 CALL mpi_waitall(8, ireq, MPI_STATUSES_IGNORE, ierr) 284 333 DEALLOCATE( zsnd, zrcv ) 285 334 ! -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC/lbclnk.F90
r14349 r14366 51 51 52 52 !! * Substitutions 53 # include "do_loop_substitute.h90"53 !!# include "do_loop_substitute.h90" 54 54 !!---------------------------------------------------------------------- 55 55 !! NEMO/OCE 4.0 , NEMO Consortium (2018) -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC/mppini.F90
r14363 r14366 453 453 WRITE(inum,'(15i6)') jp-1, ii, ij, ijpi(ii,ij), ijpj(ii,ij), iimppt(ii,ij), ijmppt(ii,ij), inei(:,ii,ij) 454 454 END DO 455 END 455 ENDIF 456 456 457 457 ! … … 564 564 WRITE(inum,'(a,8i6)') ' Recv: ', ichanged(jh*16 -7:jh*16 ) 565 565 END DO 566 END 566 ENDIF 567 567 ! 568 568 CALL init_ioipsl ! Prepare NetCDF output file (if necessary) … … 781 781 iszi1(ii) = iszi0(ji) 782 782 iszj1(ii) = iszj0(jj) 783 END 783 ENDIF 784 784 END DO 785 785 END DO … … 837 837 WRITE(numout,*) ' -----------------------------------------------------' 838 838 WRITE(numout,*) 839 END 839 ENDIF 840 840 ji = isz0 ! initialization with the largest value 841 841 ALLOCATE( llisOce(inbi0(ji), inbj0(ji)) ) … … 854 854 & '%), largest oce domain: ', iszi0(ji)*iszj0(ji), ' ( ', iszi0(ji),' x ', iszj0(ji), ' )' 855 855 inbijold = inbij 856 END 856 ENDIF 857 857 END DO 858 858 DEALLOCATE( inbi0, inbj0, iszi0, iszj0 ) … … 1208 1208 ENDIF 1209 1209 ! 1210 ! Specific (and rare) problem in corner treatment because we do 1st West-East comm, next South-North comm 1211 IF( nn_comm == 1 ) THEN 1212 IF( mpiSnei(jh,jpwe) > -1 ) mpiSnei(jh, (/jpsw,jpnw/) ) = -1 ! SW and NW corners already sent through West nei 1213 IF( mpiSnei(jh,jpea) > -1 ) mpiSnei(jh, (/jpse,jpne/) ) = -1 ! SE and NE corners already sent through East nei 1214 IF( mpiRnei(jh,jpso) > -1 ) mpiRnei(jh, (/jpsw,jpse/) ) = -1 ! SW and SE corners will be received through South nei 1215 IF( mpiRnei(jh,jpno) > -1 ) mpiRnei(jh, (/jpnw,jpne/) ) = -1 ! NW and NE corners will be received through North nei 1216 ENDIF 1217 ! 1210 1218 DEALLOCATE( zmsk ) 1211 1219 ! -
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/module_example.F90
r14041 r14366 127 127 ! WARNING! the lbc_lnk call could not be compatible with the tiling approach 128 128 ! please refer to the manual for how to adapt your code 129 CALL lbc_lnk( 'module_example', avm, 'T', 1., ncsten=true ) ! Lateral boundary conditions (unchanged sign) 130 ! ! ncsten=false for 5-points stencil communication 131 ! ! ncsten=true (default) for 9-points stencil communication 129 CALL lbc_lnk( 'module_example', avm, 'T', 1. ) ! Lateral boundary conditions (unchanged sign) 132 130 ! 133 131 END SUBROUTINE exa_mpl
Note: See TracChangeset
for help on using the changeset viewer.
