22 integer(kind=kint ) :: NEIBPETOT = 0
23 integer(kind=kint ),
pointer :: STACK_IMPORT(:)
24 integer(kind=kint ),
pointer :: NOD_IMPORT (:)
25 real (kind=
kreal),
pointer :: ws(:)
26 real (kind=
kreal),
pointer :: wr(:)
27 real (kind=
kreal),
pointer :: x(:)
28 integer(kind=kint ),
pointer :: req1(:)
29 integer(kind=kint ),
pointer :: req2(:)
30 integer(kind=kint ) :: nreq1
31 integer(kind=kint ) :: nreq2
35 type(async_buf),
save :: abuf(
max_nreq)
43 & ( n, neibpetot, neibpe, stack_import, nod_import, &
44 & stack_export, nod_export, &
45 & ws, wr, x, solver_comm,my_rank)
49 integer(kind=kint ) ,
intent(in) :: n
50 integer(kind=kint ) ,
intent(in) :: neibpetot
51 integer(kind=kint ),
pointer :: neibpe (:)
52 integer(kind=kint ),
pointer :: stack_import(:)
53 integer(kind=kint ),
pointer :: nod_import (:)
54 integer(kind=kint ),
pointer :: stack_export(:)
55 integer(kind=kint ),
pointer :: nod_export (:)
56 real (kind=
kreal),
dimension(: ),
intent(inout):: ws
57 real (kind=
kreal),
dimension(: ),
intent(inout):: wr
58 real (kind=
kreal),
dimension(: ),
intent(inout):: x
59 integer(kind=kint ) ,
intent(in) ::solver_comm
60 integer(kind=kint ) ,
intent(in) :: my_rank
63 integer(kind=kint ),
dimension(:,:),
allocatable :: sta1
64 integer(kind=kint ),
dimension(:,:),
allocatable :: sta2
65 integer(kind=kint ),
dimension(: ),
allocatable :: req1
66 integer(kind=kint ),
dimension(: ),
allocatable :: req2
69 integer(kind=kint ) :: neib,istart,inum,k,ii,ierr,nreq1,nreq2
72 allocate (sta1(mpi_status_size,neibpetot))
73 allocate (sta2(mpi_status_size,neibpetot))
74 allocate (req1(neibpetot))
75 allocate (req2(neibpetot))
81 istart= stack_export(neib-1)
82 inum = stack_export(neib ) - istart
85 do k= istart+1, istart+inum
92 call mpi_isend (ws(3*istart+1), 3*inum,mpi_double_precision, &
93 & neibpe(neib), 0, solver_comm, req1(nreq1), ierr)
100 istart= stack_import(neib-1)
101 inum = stack_import(neib ) - istart
104 call mpi_irecv (wr(3*istart+1), 3*inum, mpi_double_precision, &
105 & neibpe(neib), 0, solver_comm, req2(nreq2), ierr)
108 call mpi_waitall (nreq2, req2, sta2, ierr)
110 do neib= 1, neibpetot
111 istart= stack_import(neib-1)
112 inum = stack_import(neib ) - istart
113 do k= istart+1, istart+inum
121 call mpi_waitall (nreq1, req1, sta1, ierr)
122 deallocate (sta1, sta2, req1, req2)
130 & ( n, neibpetot, neibpe, stack_import, nod_import, &
131 & stack_export, nod_export, &
132 & x, solver_comm,my_rank,ireq)
134 integer(kind=kint ) ,
intent(in) :: n
135 integer(kind=kint ) ,
intent(in) :: neibpetot
136 integer(kind=kint ),
pointer :: neibpe (:)
137 integer(kind=kint ),
pointer :: stack_import(:)
138 integer(kind=kint ),
pointer :: nod_import (:)
139 integer(kind=kint ),
pointer :: stack_export(:)
140 integer(kind=kint ),
pointer :: nod_export (:)
141 real (kind=
kreal),
target,
intent(inout):: x(:)
142 integer(kind=kint ) ,
intent(in) ::solver_comm
143 integer(kind=kint ) ,
intent(in) :: my_rank
144 integer(kind=kint ) ,
intent(out) :: ireq
148 real (kind=
kreal),
pointer :: ws(:)
149 real (kind=
kreal),
pointer :: wr(:)
150 integer(kind=kint ),
pointer :: req1(:)
151 integer(kind=kint ),
pointer :: req2(:)
152 integer(kind=kint ) :: neib,istart,inum,k,ii,ierr,i,nreq1,nreq2
155 allocate (ws(3*stack_export(neibpetot)))
156 allocate (wr(3*stack_import(neibpetot)))
157 allocate (req1(neibpetot))
158 allocate (req2(neibpetot))
162 do neib= 1, neibpetot
163 istart= stack_export(neib-1)
164 inum = stack_export(neib ) - istart
167 do k= istart+1, istart+inum
173 call mpi_isend (ws(3*istart+1), 3*inum,mpi_double_precision, &
174 & neibpe(neib), 0, solver_comm, req1(nreq1), ierr)
179 do neib= 1, neibpetot
180 istart= stack_import(neib-1)
181 inum = stack_import(neib ) - istart
184 call mpi_irecv (wr(3*istart+1), 3*inum, mpi_double_precision, &
185 & neibpe(neib), 0, solver_comm, req2(nreq2), ierr)
191 if (abuf(i)%NEIBPETOT == 0)
then
197 stop
'Error: hecmw_solve_isend_irecv_33: exceeded maximum num of requests'
201 abuf(ireq)%NEIBPETOT = neibpetot
202 abuf(ireq)%STACK_IMPORT=> stack_import
203 abuf(ireq)%NOD_IMPORT => nod_import
207 abuf(ireq)%req1 => req1
208 abuf(ireq)%req2 => req2
209 abuf(ireq)%nreq1 = nreq1
210 abuf(ireq)%nreq2 = nreq2
219 integer(kind=kint ),
intent(in) :: ireq
223 integer(kind=kint ) :: neibpetot
224 integer(kind=kint ),
pointer :: stack_import(:)
225 integer(kind=kint ),
pointer :: nod_import (:)
226 real (kind=
kreal),
pointer :: ws(:)
227 real (kind=
kreal),
pointer :: wr(:)
228 real (kind=
kreal),
pointer :: x(:)
229 integer(kind=kint ),
pointer :: req1(:)
230 integer(kind=kint ),
pointer :: req2(:)
231 integer(kind=kint ),
dimension(:,:),
allocatable :: sta1
232 integer(kind=kint ),
dimension(:,:),
allocatable :: sta2
233 integer(kind=kint ) :: neib,istart,inum,k,ii,ierr,nreq1,nreq2
235 if (ireq < 0 .or. ireq >
max_nreq)
then
236 stop
'ERROR: hecmw_solve_isend_irecv_33_wait: invalid ireq'
239 neibpetot = abuf(ireq)%NEIBPETOT
240 stack_import=> abuf(ireq)%STACK_IMPORT
241 nod_import => abuf(ireq)%NOD_IMPORT
245 req1 => abuf(ireq)%req1
246 req2 => abuf(ireq)%req2
247 nreq1 = abuf(ireq)%nreq1
248 nreq2 = abuf(ireq)%nreq2
250 abuf(ireq)%NEIBPETOT = 0
252 allocate (sta1(mpi_status_size,neibpetot))
253 allocate (sta2(mpi_status_size,neibpetot))
255 call mpi_waitall (nreq2, req2, sta2, ierr)
256 do neib= 1, neibpetot
257 istart= stack_import(neib-1)
258 inum = stack_import(neib ) - istart
259 do k= istart+1, istart+inum
267 call mpi_waitall (nreq1, req1, sta1, ierr)
269 deallocate (sta1, sta2)
270 deallocate (req1, req2)
subroutine, public hecmw_solve_isend_irecv_33_wait(ireq)
integer(kind=kint), parameter max_nreq
subroutine, public hecmw_solve_isend_irecv_33(n, neibpetot, neibpe, stack_import, nod_import, stack_export, nod_export, x, solver_comm, my_rank, ireq)
subroutine, public hecmw_solve_send_recv_33(n, neibpetot, neibpe, stack_import, nod_import, stack_export, nod_export, ws, wr, x, solver_comm, my_rank)
integer(kind=4), parameter kreal