FrontISTR  5.7.0
Large-scale structural analysis program with finit element method
hecmw_solver_SR_i.F90
Go to the documentation of this file.
1 !-------------------------------------------------------------------------------
2 ! Copyright (c) 2019 FrontISTR Commons
3 ! This software is released under the MIT License, see LICENSE.txt
4 !-------------------------------------------------------------------------------
5 
6 !C
7 !C***
8 !C*** module hecmw_solver_SR_i
9 !C***
10 !C
11 module hecmw_solver_sr_i
12 contains
13  !C
14  !C*** SOLVER_SEND_RECV
15  !C
16  subroutine hecmw_solve_send_recv_i &
17  & ( n, m, neibpetot, neibpe, &
18  & stack_import, nod_import, &
19  & stack_export, nod_export, ws, wr, x, &
20  & solver_comm,my_rank)
21 
22  use hecmw_util
23  implicit none
24  ! include 'mpif.h'
25  ! include 'hecmw_config_f.h'
26 
27  integer(kind=kint ) , intent(in) :: N, m
28  integer(kind=kint ) , intent(in) :: NEIBPETOT
29  integer(kind=kint ), pointer :: NEIBPE (:)
30  integer(kind=kint ), pointer :: STACK_IMPORT(:)
31  integer(kind=kint ), pointer :: NOD_IMPORT (:)
32  integer(kind=kint ), pointer :: STACK_EXPORT(:)
33  integer(kind=kint ), pointer :: NOD_EXPORT (:)
34  integer(kind=kint ), dimension(: ), intent(inout):: WS
35  integer(kind=kint ), dimension(: ), intent(inout):: WR
36  integer(kind=kint ), dimension(: ), intent(inout):: X
37  integer(kind=kint ) , intent(in) ::SOLVER_COMM
38  integer(kind=kint ) , intent(in) :: my_rank
39 
40 #ifndef HECMW_SERIAL
41  integer(kind=kint ), dimension(:,:), allocatable :: sta1
42  integer(kind=kint ), dimension(:,:), allocatable :: sta2
43  integer(kind=kint ), dimension(: ), allocatable :: req1
44  integer(kind=kint ), dimension(: ), allocatable :: req2
45 
46  integer(kind=kint ), save :: NFLAG
47  data nflag/0/
48  ! local valiables
49  integer(kind=kint ) :: neib,istart,inum,k,ii,kk,ierr,nreq1,nreq2
50  !C
51  !C-- INIT.
52  allocate (sta1(mpi_status_size,neibpetot))
53  allocate (sta2(mpi_status_size,neibpetot))
54  allocate (req1(neibpetot))
55  allocate (req2(neibpetot))
56 
57  !C
58  !C-- SEND
59  nreq1=0
60  do neib= 1, neibpetot
61  istart= stack_export(neib-1)
62  inum = stack_export(neib ) - istart
63  if (inum==0) cycle
64  nreq1=nreq1+1
65  do k= istart+1, istart+inum
66  ii = m*nod_export(k)
67  do kk= 1, m
68  ws(m*k-kk+1)= x(ii-kk+1)
69  enddo
70  enddo
71 
72  call mpi_isend (ws(m*istart+1), m*inum, mpi_integer, &
73  & neibpe(neib), 0, solver_comm, req1(nreq1), ierr)
74  enddo
75 
76  !C
77  !C-- RECEIVE
78  nreq2=0
79  do neib= 1, neibpetot
80  istart= stack_import(neib-1)
81  inum = stack_import(neib ) - istart
82  if (inum==0) cycle
83  nreq2=nreq2+1
84  call mpi_irecv (wr(m*istart+1), m*inum, mpi_integer, &
85  & neibpe(neib), 0, solver_comm, req2(nreq2), ierr)
86  enddo
87 
88  call mpi_waitall (nreq2, req2, sta2, ierr)
89 
90  do neib= 1, neibpetot
91  istart= stack_import(neib-1)
92  inum = stack_import(neib ) - istart
93  do k= istart+1, istart+inum
94  ii = m*nod_import(k)
95  do kk= 1, m
96  x(ii-kk+1)= wr(m*k-kk+1)
97  enddo
98  enddo
99  enddo
100 
101  call mpi_waitall (nreq1, req1, sta1, ierr)
102 
103  deallocate (sta1, sta2, req1, req2)
104 #endif
105  end subroutine hecmw_solve_send_recv_i
106 
107  !C
108  !C*** SOLVER_REVERSE_SEND_RECV_i
109  !C
110  subroutine hecmw_solve_rev_send_recv_i &
111  & ( n, m, neibpetot, neibpe, stack_import, nod_import, &
112  & stack_export, nod_export, &
113  & ws, wr, x, solver_comm,my_rank)
114 
115  use hecmw_util
116  implicit none
117 
118  integer(kind=kint ) , intent(in) :: N, M
119  integer(kind=kint ) , intent(in) :: NEIBPETOT
120  integer(kind=kint ), pointer :: NEIBPE (:)
121  integer(kind=kint ), pointer :: STACK_IMPORT(:)
122  integer(kind=kint ), pointer :: NOD_IMPORT (:)
123  integer(kind=kint ), pointer :: STACK_EXPORT(:)
124  integer(kind=kint ), pointer :: NOD_EXPORT (:)
125  integer(kind=kint ), dimension(: ), intent(inout):: WS
126  integer(kind=kint ), dimension(: ), intent(inout):: WR
127  integer(kind=kint ), dimension(: ), intent(inout):: X
128  integer(kind=kint ) , intent(in) ::SOLVER_COMM
129  integer(kind=kint ) , intent(in) :: my_rank
130 
131 #ifndef HECMW_SERIAL
132  integer(kind=kint ), dimension(:,:), allocatable :: sta1
133  integer(kind=kint ), dimension(:,:), allocatable :: sta2
134  integer(kind=kint ), dimension(: ), allocatable :: req1
135  integer(kind=kint ), dimension(: ), allocatable :: req2
136 
137  ! local valiables
138  integer(kind=kint ) :: neib,istart,inum,k,kk,ii,ierr,nreq1,nreq2
139  !C
140  !C-- INIT.
141  allocate (sta1(mpi_status_size,neibpetot))
142  allocate (sta2(mpi_status_size,neibpetot))
143  allocate (req1(neibpetot))
144  allocate (req2(neibpetot))
145 
146  !C
147  !C-- SEND
148  nreq1=0
149  do neib= 1, neibpetot
150  istart= stack_import(neib-1)
151  inum = stack_import(neib ) - istart
152  if (inum==0) cycle
153  nreq1=nreq1+1
154  do k= istart+1, istart+inum
155  ii = nod_import(k)
156  do kk = 1, m
157  ws(m*(k-1)+kk)= x(m*(ii-1)+kk)
158  enddo
159  enddo
160 
161  call mpi_isend (ws(m*istart+1), m*inum,mpi_integer, &
162  & neibpe(neib), 0, solver_comm, req1(nreq1), ierr)
163  enddo
164 
165  !C
166  !C-- RECEIVE
167  nreq2=0
168  do neib= 1, neibpetot
169  istart= stack_export(neib-1)
170  inum = stack_export(neib ) - istart
171  if (inum==0) cycle
172  nreq2=nreq2+1
173  call mpi_irecv (wr(m*istart+1), m*inum, mpi_integer, &
174  & neibpe(neib), 0, solver_comm, req2(nreq2), ierr)
175  enddo
176 
177  call mpi_waitall (nreq2, req2, sta2, ierr)
178 
179  do neib= 1, neibpetot
180  istart= stack_export(neib-1)
181  inum = stack_export(neib ) - istart
182  do k= istart+1, istart+inum
183  ii = nod_export(k)
184  do kk = 1, m
185  x(m*(ii-1)+kk)= x(m*(ii-1)+kk)+wr(m*(k-1)+kk)
186  enddo
187  enddo
188  enddo
189 
190  call mpi_waitall (nreq1, req1, sta1, ierr)
191  deallocate (sta1, sta2, req1, req2)
192 #endif
193  end subroutine hecmw_solve_rev_send_recv_i
194 
195 end module hecmw_solver_sr_i
hecmw_solver_sr_i::hecmw_solve_send_recv_i
subroutine hecmw_solve_send_recv_i(N, m, NEIBPETOT, NEIBPE, STACK_IMPORT, NOD_IMPORT, STACK_EXPORT, NOD_EXPORT, WS, WR, X, SOLVER_COMM, my_rank)
Definition: hecmw_solver_SR_i.F90:21
hecmw_util
I/O and Utility.
Definition: hecmw_util_f.F90:7
hecmw_solver_sr_i::hecmw_solve_rev_send_recv_i
subroutine hecmw_solve_rev_send_recv_i(N, M, NEIBPETOT, NEIBPE, STACK_IMPORT, NOD_IMPORT, STACK_EXPORT, NOD_EXPORT, WS, WR, X, SOLVER_COMM, my_rank)
Definition: hecmw_solver_SR_i.F90:114
hecmw_solver_sr_i
Definition: hecmw_solver_SR_i.F90:11