OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_exch_inter_18.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| spmd_exch_inter_18 ../engine/source/mpi/interfaces/spmd_exch_inter_18.F
25!||--- called by ------------------------------------------------------
26!|| resol ../engine/source/engine/resol.F
27!||--- calls -----------------------------------------------------
28!|| alloc_my_real_1d_array ../common_source/modules/array_mod.F
29!|| dealloc_my_real_1d_array ../common_source/modules/array_mod.F
30!||--- uses -----------------------------------------------------
31!|| ale_connectivity_mod ../common_source/modules/ale/ale_connectivity_mod.F
32!|| array_mod ../common_source/modules/array_mod.F
33!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
34!|| multi_fvm_mod ../common_source/modules/ale/multi_fvm_mod.F90
35!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
36!|| tri7box ../engine/share/modules/tri7box.F
37!||====================================================================
38 SUBROUTINE spmd_exch_inter_18(NINTER,NSPMD,NUMBER_INTER18,SXCELL,INTER18_LIST,
39 . XCELL,MULTI_FVM,XCELL_REMOTE,INTBUF_TAB,ALE_CONNECTIVITY)
40!$COMMENT
41! SPMD_EXCH_INTER_18 description : exchange of remote data (XCELL) between processor
42!
43! SPMD_EXCH_INTER_18 organization :
44! * allocation of buffer + remote xcell array
45! * compute the size & adress for mpi comm
46! * post the rcv comm
47! * send the data
48! * wait the rcv comm + save the remote data
49! * wait the send comm
50!$ENDCOMMENT
51C-----------------------------------------------
52C M o d u l e s
53C-----------------------------------------------
54 USE intbufdef_mod
55 USE array_mod
56 USE tri7box
57 USE multi_fvm_mod
58 USE ale_connectivity_mod
59C-----------------------------------------------
60C I m p l i c i t T y p e s
61C-----------------------------------------------
62 USE spmd_comm_world_mod, ONLY : spmd_comm_world
63#include "implicit_f.inc"
64C-----------------------------------------------
65C M e s s a g e P a s s i n g
66C-----------------------------------------------
67#include "spmd.inc"
68C-----------------------------------------------
69C C o m m o n B l o c k s
70C-----------------------------------------------
71#include "task_c.inc"
72C-----------------------------------------------
73C D u m m y A r g u m e n t s
74C-----------------------------------------------
75 INTEGER, INTENT(in) :: NINTER !< number of interface
76 INTEGER, INTENT(in) :: NSPMD !< number of mpi tasks
77 INTEGER, INTENT(inout) :: NUMBER_INTER18 !< number of interface 18
78 INTEGER, INTENT(in) :: SXCELL !< size of characteristic length array
79 INTEGER, DIMENSION(NUMBER_INTER18), INTENT(inout) :: INTER18_LIST !< list of interface 18
80 my_real, DIMENSION(3,SXCELL), INTENT(in) :: xcell !< characteristic length
81 TYPE(multi_fvm_struct), INTENT(inout) :: MULTI_FVM
82 TYPE(array_type), DIMENSION(NINTER), INTENT(inout) :: XCELL_REMOTE !< remote data structure for interface 18
83 TYPE(intbuf_struct_), DIMENSION(NINTER), INTENT(inout) :: INTBUF_TAB !< interface data
84 TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECTIVITY !< ale connectivity structure
85C-----------------------------------------------
86C L o c a l V a r i a b l e s
87C-----------------------------------------------
88#ifdef MPI
89 INTEGER :: I,J,K,IJK,P,N
90 INTEGER :: MY_SIZE
91 INTEGER :: LOC_PROC
92 INTEGER :: NIN,NODE_ID,ELEM_ID,NUMBER_REMOTE_NODE
93 INTEGER :: BUFFER_SEND_SIZE,BUFFER_RCV_SIZE
94 INTEGER :: SEND_SIZE,RCV_SIZE
95 INTEGER :: LOCAL_ADRESS
96 INTEGER, DIMENSION(NINTER) :: ADRESS_INTER
97 INTEGER, DIMENSION(NSPMD+1) :: ADRESS_SEND,ADRESS_RCV
98
99 INTEGER :: IAD1,IAD2
100 my_real :: dl
101 my_real, DIMENSION(:), ALLOCATABLE :: buffer_send,buffer_rcv
102
103 INTEGER :: MSGTYP
104 INTEGER :: ERROR_MPI
105 INTEGER, DIMENSION(NSPMD) :: REQUEST_SEND,REQUEST_RCV
106 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: STATUS_MPI
107 INTEGER :: MSGOFF
108 DATA msgoff/13016/
109! --------------------------------------------------------------------
110 loc_proc = ispmd + 1
111
112 ! ---------------------------
113 ! allocation of remote array
114 DO i=1,number_inter18
115 nin = inter18_list(i)
116 my_size = 0
117 DO p=1,nspmd
118 my_size = my_size + nsnfi(nin)%P(p)
119 ENDDO
120 IF(xcell_remote(nin)%SIZE_MY_REAL_ARRAY_1D < my_size) THEN
121 IF( ALLOCATED(xcell_remote(nin)%MY_REAL_ARRAY_1D) ) CALL dealloc_my_real_1d_array(xcell_remote(nin))
122 xcell_remote(nin)%SIZE_MY_REAL_ARRAY_1D = my_size
123 CALL alloc_my_real_1d_array(xcell_remote(nin))
124 ENDIF
125 ENDDO
126 ! ---------------------------
127
128 ! ---------------------------
129 ! compute the size (send & rcv) and the adress in the buffer (send & rcv)
130 buffer_send_size = 0
131 buffer_rcv_size = 0
132
133 adress_send(1:nspmd+1) = 0
134 adress_rcv(1:nspmd+1) = 0
135
136 DO p=1,nspmd
137 adress_send(p) = buffer_send_size + 1
138 adress_rcv(p) = buffer_rcv_size + 1
139 DO i=1,number_inter18
140 nin = inter18_list(i)
141 buffer_send_size = buffer_send_size + nsnsi(nin)%P(p)
142 buffer_rcv_size = buffer_rcv_size + nsnfi(nin)%P(p)
143 ENDDO
144 ENDDO
145
146 adress_send(nspmd+1) = buffer_send_size + 1
147 adress_rcv(nspmd+1) = buffer_rcv_size + 1
148 ALLOCATE( buffer_send(buffer_send_size) )
149 ALLOCATE( buffer_rcv(buffer_rcv_size) )
150 ! ---------------------------
151
152 ! ---------------------------
153 ! rcv of buffer
154 DO p=1,nspmd
155 rcv_size = adress_rcv(p+1)-adress_rcv(p)
156 IF(p/=loc_proc.AND.rcv_size>0) THEN
157 msgtyp = msgoff
158 CALL mpi_irecv( buffer_rcv(adress_rcv(p)),rcv_size,real,
159 . it_spmd(p),msgtyp,spmd_comm_world,request_rcv(p),error_mpi )
160 ENDIF
161 ENDDO
162 ! ---------------------------
163
164 ! ---------------------------
165 ! initialize the buffer (send)
166 ijk = 0
167 adress_inter(1:ninter) = 0
168 DO p=1,nspmd
169 IF(p/=loc_proc) THEN
170 DO i=1,number_inter18
171 nin = inter18_list(i)
172 DO j =1,nsnsi(nin)%P(p)
173 n = nsvsi(nin)%P(adress_inter(nin)+j)
174 node_id = intbuf_tab(nin)%NSV(n)
175 dl = zero
176 IF(.NOT.multi_fvm%IS_USED) THEN
177 iad1 = ale_connectivity%NE_CONNECT%IAD_CONNECT(node_id)
178 iad2 = ale_connectivity%NE_CONNECT%IAD_CONNECT(node_id + 1) - 1
179 DO k=iad1,iad2
180 elem_id = ale_connectivity%NE_CONNECT%CONNECTED(k)
181 dl=max(dl, xcell(1,elem_id))
182 ENDDO
183 ELSE
184 dl=xcell(1,node_id)
185 ENDIF
186 ijk = ijk + 1
187 buffer_send(ijk) = dl
188 ENDDO
189 adress_inter(nin) = adress_inter(nin) + nsnsi(nin)%P(p)
190 ENDDO
191 ENDIF
192 ENDDO
193 ! ---------------------------
194
195 ! ---------------------------
196 ! send the buffer
197 DO p=1,nspmd
198 send_size = adress_send(p+1)-adress_send(p)
199 IF(p/=loc_proc.AND.send_size>0) THEN
200 msgtyp = msgoff
201 CALL mpi_isend( buffer_send(adress_send(p)),send_size,real,
202 . it_spmd(p),msgtyp,spmd_comm_world,request_send(p),error_mpi )
203 ENDIF
204 ENDDO
205 ! ---------------------------
206
207 ! ---------------------------
208 ! wait the rcv comm
209 ! and save the remote data in the remote XCELL array
210 adress_inter(1:ninter) = 0
211 DO p=1,nspmd
212 rcv_size = adress_rcv(p+1)-adress_rcv(p)
213 IF(p/=loc_proc.AND.rcv_size>0) THEN
214 local_adress = 0
215 msgtyp = msgoff
216 CALL mpi_wait(request_rcv(p),status_mpi,error_mpi)
217 DO i=1,number_inter18
218 nin = inter18_list(i)
219 number_remote_node = nsnfi(nin)%P(p)
220 IF(number_remote_node>0) THEN
221 DO j =1,number_remote_node
222 xcell_remote(nin)%MY_REAL_ARRAY_1D(adress_inter(nin)+j) = buffer_rcv(local_adress+adress_rcv(p)-1+j)
223 ENDDO
224 adress_inter(nin) = adress_inter(nin) + number_remote_node
225 local_adress = local_adress + number_remote_node
226 ENDIF
227 ENDDO
228 ENDIF
229 ENDDO
230 ! ---------------------------
231
232 ! ---------------------------
233 ! wait the send comm
234 DO p=1,nspmd
235 send_size = adress_send(p+1)-adress_send(p)
236 IF(p/=loc_proc.AND.send_size>0) THEN
237 CALL mpi_wait(request_send(p),status_mpi,error_mpi)
238 ENDIF
239 ENDDO
240 ! ---------------------------
241
242 DEALLOCATE( buffer_send )
243 DEALLOCATE( buffer_rcv )
244
245! --------------------------------------------------------------------
246#endif
247 RETURN
248 END SUBROUTINE spmd_exch_inter_18
my_real
#define my_real
Definition cppsort.cpp:32
the
end diagonal values have been computed in the(sparse) matrix id.SOL
max
#define max(a, b)
Definition macros.h:21
mpi_isend
subroutine mpi_isend(buf, cnt, datatype, dest, tag, comm, ireq, ierr)
Definition mpi.f:382
mpi_wait
subroutine mpi_wait(ireq, status, ierr)
Definition mpi.f:525
mpi_irecv
subroutine mpi_irecv(buf, cnt, datatype, source, tag, comm, ireq, ierr)
Definition mpi.f:372
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
ale_connectivity_mod
Definition ale_connectivity_mod.F:223
array_mod
Definition array_mod.F:51
array_mod::alloc_my_real_1d_array
subroutine alloc_my_real_1d_array(this)
Definition array_mod.F:233
array_mod::dealloc_my_real_1d_array
subroutine dealloc_my_real_1d_array(this)
Definition array_mod.F:251
tri7box::nsvsi
type(int_pointer), dimension(:), allocatable nsvsi
Definition tri7box.F:485
tri7box::nsnsi
type(int_pointer), dimension(:), allocatable nsnsi
Definition tri7box.F:491
tri7box::nsnfi
type(int_pointer), dimension(:), allocatable nsnfi
Definition tri7box.F:440
spmd_exch_inter_18
subroutine spmd_exch_inter_18(ninter, nspmd, number_inter18, sxcell, inter18_list, xcell, multi_fvm, xcell_remote, intbuf_tab, ale_connectivity)
Definition spmd_exch_inter_18.F:40
ale_connectivity_mod::t_ale_connectivity
Definition ale_connectivity_mod.F:254
array_mod::array_type
Definition array_mod.F:61