OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_exch_a_int2.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!||====================================================================
25!|| spmd_exch_a_int2 ../engine/source/mpi/forces/spmd_exch_a_int2.f
26!||--- called by ------------------------------------------------------
27!|| intti1 ../engine/source/interfaces/interf/intti1.F
28!||--- calls -----------------------------------------------------
29!||--- uses -----------------------------------------------------
30!|| h3d_mod ../engine/share/modules/h3d_mod.F
31!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
32!||====================================================================
33 SUBROUTINE spmd_exch_a_int2(
34 1 A ,AR ,MS ,IN ,STIFN,
35 2 STIFR,FR_I2M,IAD_I2M,LCOMI2M,ISIZE,
36 3 INTTH2,FTHE ,CONDN ,FNCONT ,FNCONTP,
37 4 FTCONTP,H3D_DATA ,IDT_THERM)
38C-----------------------------------------------
39 USE h3d_mod
40C----------------------------------------------
41C realise le cumul des acc et masses aux noeuds main d'int2
42C-----------------------------------------------
43C I m p l i c i t T y p e s
44C-----------------------------------------------
45 USE spmd_comm_world_mod, ONLY : spmd_comm_world
46#include "implicit_f.inc"
47C-----------------------------------------------
48C M e s s a g e P a s s i n g
49C-----------------------------------------------
50#include "spmd.inc"
51C-----------------------------------------------
52C C o m m o n B l o c k s
53C-----------------------------------------------
54#include "com01_c.inc"
55#include "com04_c.inc"
56#include "task_c.inc"
57#include "scr18_c.inc"
58C-----------------------------------------------
59C D u m m y A r g u m e n t s
60C-----------------------------------------------
61 INTEGER LCOMI2M, ISIZE, INTTH2,
62 . FR_I2M(*), IAD_I2M(*)
63 INTEGER ,INTENT(IN) :: IDT_THERM
64 my_real
65 . a(3,*), ar(3,*), ms(*), in(*),
66 . stifn(*), stifr(*),fthe(*),condn(*)
67 my_real , INTENT(INOUT) :: fncont(3,numnod),
68 . fncontp(3,numnod),ftcontp(3,numnod)
69 TYPE(h3d_database) :: H3D_DATA
70C-----------------------------------------------
71C L o c a l V a r i a b l e s
72C-----------------------------------------------
73#ifdef MPI
74 INTEGER MSGTYP,LOC_PROC,NOD,I,J,L,IDEB,IAD,LEN,
75 . NBINDEX,INDEX,MSGOFF,SIZ,IERROR,ISIZE2,
76 . STATUS(MPI_STATUS_SIZE),
77 . REQ_S(NSPMD),REQ_R(NSPMD),INDEXI(NSPMD)
78 DATA msgoff/117/
79
80 my_real,
81 . DIMENSION (:),ALLOCATABLE :: sbuf,rbuf
82C-----------------------------------------------
83C S o u r c e L i n e s
84C-----------------------------------------------
85 loc_proc = ispmd + 1
86C
87 isize2=isize
88 IF (h3d_data%N_VECT_CONT2_MAX > 0.OR.h3d_data%N_VECT_CONT2_MIN > 0) THEN
89 isize2 = isize2 + 3
90 ENDIF
91 IF (h3d_data%N_VECT_PCONT2_MAX > 0.OR.h3d_data%N_VECT_PCONT2_MIN > 0) THEN
92 isize2 = isize2 + 6
93 ENDIF
94 ALLOCATE(sbuf(lcomi2m*isize2))
95 ALLOCATE(rbuf(lcomi2m*isize2))
96C
97! PRINT*,'SPMD_EXCH_A_INT2 : LOCPROC = ', LOC_PROC
98 ideb = 1
99 l = 0
100 DO i = 1, nspmd
101 len = iad_i2m(i+1)-iad_i2m(i)
102 IF(len>0) THEN
103 siz = len*(isize2)
104 l=l+1
105 indexi(l)=i
106 msgtyp = msgoff
107 CALL mpi_irecv(
108 s rbuf(ideb),siz,real,it_spmd(i),msgtyp,
109 g spmd_comm_world,req_r(l),ierror)
110 ideb = ideb + siz
111 ENDIF
112 ENDDO
113 nbindex = l
114C
115 ideb = 1
116 DO l = 1, nbindex
117 i = indexi(l)
118 len = iad_i2m(i+1) - iad_i2m(i)
119 iad = iad_i2m(i)-1
120 IF (intth2 == 1) THEN
121 IF(idt_therm == 1) THEN
122 IF (iroddl==0) THEN
123#include "vectorize.inc"
124 DO j = 1, len
125 nod = fr_i2m(iad+j)
126 sbuf(ideb) = a(1,nod)
127 sbuf(ideb+1) = a(2,nod)
128 sbuf(ideb+2) = a(3,nod)
129 sbuf(ideb+3) = ms(nod)
130 sbuf(ideb+4) = stifn(nod)
131 sbuf(ideb+5) = fthe(nod)
132 sbuf(ideb+6) = condn(nod)
133 ideb = ideb + isize
134 ENDDO
135 ELSE
136#include "vectorize.inc"
137 DO j = 1, len
138 nod = fr_i2m(iad+j)
139 sbuf(ideb) = a(1,nod)
140 sbuf(ideb+1) = a(2,nod)
141 sbuf(ideb+2) = a(3,nod)
142 sbuf(ideb+3) = ar(1,nod)
143 sbuf(ideb+4) = ar(2,nod)
144 sbuf(ideb+5) = ar(3,nod)
145 sbuf(ideb+6) = ms(nod)
146 sbuf(ideb+7) = in(nod)
147 sbuf(ideb+8) = stifn(nod)
148 sbuf(ideb+9) = stifr(nod)
149 sbuf(ideb+10) = fthe(nod)
150 sbuf(ideb+11) = condn(nod)
151 ideb = ideb + isize
152 ENDDO
153 ENDIF
154 ELSE
155 IF (iroddl==0) THEN
156#include "vectorize.inc"
157 DO j = 1, len
158 nod = fr_i2m(iad+j)
159 sbuf(ideb) = a(1,nod)
160 sbuf(ideb+1) = a(2,nod)
161 sbuf(ideb+2) = a(3,nod)
162 sbuf(ideb+3) = ms(nod)
163 sbuf(ideb+4) = stifn(nod)
164 sbuf(ideb+5) = fthe(nod)
165 ideb = ideb + isize
166 ENDDO
167 ELSE
168#include "vectorize.inc"
169 DO j = 1, len
170 nod = fr_i2m(iad+j)
171 sbuf(ideb) = a(1,nod)
172 sbuf(ideb+1) = a(2,nod)
173 sbuf(ideb+2) = a(3,nod)
174 sbuf(ideb+3) = ar(1,nod)
175 sbuf(ideb+4) = ar(2,nod)
176 sbuf(ideb+5) = ar(3,nod)
177 sbuf(ideb+6) = ms(nod)
178 sbuf(ideb+7) = in(nod)
179 sbuf(ideb+8) = stifn(nod)
180 sbuf(ideb+9) = stifr(nod)
181 sbuf(ideb+10) = fthe(nod)
182 ideb = ideb + isize
183 ENDDO
184 ENDIF
185 ENDIF
186 ELSE
187 IF (iroddl==0) THEN
188#include "vectorize.inc"
189 DO j = 1, len
190 nod = fr_i2m(iad+j)
191 sbuf(ideb) = a(1,nod)
192 sbuf(ideb+1) = a(2,nod)
193 sbuf(ideb+2) = a(3,nod)
194 sbuf(ideb+3) = ms(nod)
195 sbuf(ideb+4) = stifn(nod)
196 ideb = ideb + isize
197 ENDDO
198 ELSE
199#include "vectorize.inc"
200 DO j = 1, len
201 nod = fr_i2m(iad+j)
202 sbuf(ideb) = a(1,nod)
203 sbuf(ideb+1) = a(2,nod)
204 sbuf(ideb+2) = a(3,nod)
205 sbuf(ideb+3) = ar(1,nod)
206 sbuf(ideb+4) = ar(2,nod)
207 sbuf(ideb+5) = ar(3,nod)
208 sbuf(ideb+6) = ms(nod)
209 sbuf(ideb+7) = in(nod)
210 sbuf(ideb+8) = stifn(nod)
211 sbuf(ideb+9) = stifr(nod)
212 ideb = ideb + isize
213 ENDDO
214 ENDIF
215 ENDIF
216C
217 IF (h3d_data%N_VECT_CONT2_MAX > 0.OR.h3d_data%N_VECT_CONT2_MIN > 0) THEN
218#include "vectorize.inc"
219 DO j = 1, len
220 nod = fr_i2m(iad+j)
221 sbuf(ideb) = fncont(1,nod)
222 sbuf(ideb+1) = fncont(2,nod)
223 sbuf(ideb+2) = fncont(3,nod)
224 ideb = ideb + 3
225 ENDDO
226 ENDIF
227 IF (h3d_data%N_VECT_PCONT2_MAX > 0.OR.h3d_data%N_VECT_PCONT2_MIN > 0) THEN
228#include "vectorize.inc"
229 DO j = 1, len
230 nod = fr_i2m(iad+j)
231 sbuf(ideb) = fncontp(1,nod)
232 sbuf(ideb+1) = fncontp(2,nod)
233 sbuf(ideb+2) = fncontp(3,nod)
234 sbuf(ideb+3) = ftcontp(1,nod)
235 sbuf(ideb+4) = ftcontp(2,nod)
236 sbuf(ideb+5) = ftcontp(3,nod)
237 ideb = ideb + 6
238 ENDDO
239 ENDIF
240C
241 ENDDO
242C
243 ideb = 1
244 DO l=1,nbindex
245 i = indexi(l)
246 len = iad_i2m(i+1)-iad_i2m(i)
247 siz = len*(isize2)
248 msgtyp = msgoff
249 CALL mpi_isend(
250 s sbuf(ideb),siz,real,it_spmd(i),msgtyp,
251 g spmd_comm_world,req_s(l),ierror)
252 ideb = ideb + siz
253 ENDDO
254C
255 DO l=1,nbindex
256 CALL mpi_waitany(nbindex,req_r,index,status,ierror)
257 i = indexi(index)
258 ideb = 1+(iad_i2m(i)-1)*(isize2)
259 len = iad_i2m(i+1)-iad_i2m(i)
260 iad = iad_i2m(i)-1
261 IF (intth2 == 1) THEN
262 IF(idt_therm == 1) THEN
263 IF (iroddl==0) THEN
264#include "vectorize.inc"
265 DO j = 1, len
266 nod = fr_i2m(iad+j)
267 a(1,nod) = a(1,nod) + rbuf(ideb)
268 a(2,nod) = a(2,nod) + rbuf(ideb+1)
269 a(3,nod) = a(3,nod) + rbuf(ideb+2)
270 ms(nod) = ms(nod) + rbuf(ideb+3)
271 stifn(nod) = stifn(nod)+rbuf(ideb+4)
272 fthe(nod) = fthe(nod) +rbuf(ideb+5)
273 condn(nod) = condn(nod)+rbuf(ideb+6)
274 ideb = ideb + isize
275 ENDDO
276 ELSE
277#include "vectorize.inc"
278 DO j = 1, len
279 nod = fr_i2m(iad+j)
280 a(1,nod) = a(1,nod) + rbuf(ideb)
281 a(2,nod) = a(2,nod) + rbuf(ideb+1)
282 a(3,nod) = a(3,nod) + rbuf(ideb+2)
283 ar(1,nod) = ar(1,nod)+ rbuf(ideb+3)
284 ar(2,nod) = ar(2,nod)+ rbuf(ideb+4)
285 ar(3,nod) = ar(3,nod)+ rbuf(ideb+5)
286 ms(nod) = ms(nod) + rbuf(ideb+6)
287 in(nod) = in(nod) + rbuf(ideb+7)
288 stifn(nod) = stifn(nod)+rbuf(ideb+8)
289 stifr(nod) = stifr(nod)+rbuf(ideb+9)
290 fthe(nod) = fthe(nod) +rbuf(ideb+10)
291 condn(nod) = condn(nod)+rbuf(ideb+11)
292 ideb = ideb + isize
293 END DO
294 END IF
295 ELSE
296 IF (iroddl==0) THEN
297#include "vectorize.inc"
298 DO j = 1, len
299 nod = fr_i2m(iad+j)
300 a(1,nod) = a(1,nod) + rbuf(ideb)
301 a(2,nod) = a(2,nod) + rbuf(ideb+1)
302 a(3,nod) = a(3,nod) + rbuf(ideb+2)
303 ms(nod) = ms(nod) + rbuf(ideb+3)
304 stifn(nod) = stifn(nod)+rbuf(ideb+4)
305 fthe(nod) = fthe(nod) +rbuf(ideb+5)
306 ideb = ideb + isize
307 ENDDO
308 ELSE
309#include "vectorize.inc"
310 DO j = 1, len
311 nod = fr_i2m(iad+j)
312 a(1,nod) = a(1,nod) + rbuf(ideb)
313 a(2,nod) = a(2,nod) + rbuf(ideb+1)
314 a(3,nod) = a(3,nod) + rbuf(ideb+2)
315 ar(1,nod) = ar(1,nod)+ rbuf(ideb+3)
316 ar(2,nod) = ar(2,nod)+ rbuf(ideb+4)
317 ar(3,nod) = ar(3,nod)+ rbuf(ideb+5)
318 ms(nod) = ms(nod) + rbuf(ideb+6)
319 in(nod) = in(nod) + rbuf(ideb+7)
320 stifn(nod) = stifn(nod)+rbuf(ideb+8)
321 stifr(nod) = stifr(nod)+rbuf(ideb+9)
322 fthe(nod) = fthe(nod) +rbuf(ideb+10)
323 ideb = ideb + isize
324 END DO
325 END IF
326 ENDIF
327 ELSE
328 IF (iroddl==0) THEN
329#include "vectorize.inc"
330 DO j = 1, len
331 nod = fr_i2m(iad+j)
332 a(1,nod) = a(1,nod) + rbuf(ideb)
333 a(2,nod) = a(2,nod) + rbuf(ideb+1)
334 a(3,nod) = a(3,nod) + rbuf(ideb+2)
335 ms(nod) = ms(nod) + rbuf(ideb+3)
336 stifn(nod) = stifn(nod)+rbuf(ideb+4)
337 ideb = ideb + isize
338 ENDDO
339 ELSE
340#include "vectorize.inc"
341 DO j = 1, len
342 nod = fr_i2m(iad+j)
343 a(1,nod) = a(1,nod) + rbuf(ideb)
344 a(2,nod) = a(2,nod) + rbuf(ideb+1)
345 a(3,nod) = a(3,nod) + rbuf(ideb+2)
346 ar(1,nod) = ar(1,nod)+ rbuf(ideb+3)
347 ar(2,nod) = ar(2,nod)+ rbuf(ideb+4)
348 ar(3,nod) = ar(3,nod)+ rbuf(ideb+5)
349 ms(nod) = ms(nod) + rbuf(ideb+6)
350 in(nod) = in(nod) + rbuf(ideb+7)
351 stifn(nod) = stifn(nod)+rbuf(ideb+8)
352 stifr(nod) = stifr(nod)+rbuf(ideb+9)
353 ideb = ideb + isize
354 END DO
355 END IF
356 ENDIF
357
358C
359 IF (h3d_data%N_VECT_CONT2_MAX > 0.OR.h3d_data%N_VECT_CONT2_MIN > 0) THEN
360#include "vectorize.inc"
361 DO j = 1, len
362 nod = fr_i2m(iad+j)
363 fncont(1,nod) = fncont(1,nod) + rbuf(ideb)
364 fncont(2,nod) = fncont(2,nod) + rbuf(ideb+1)
365 fncont(3,nod) = fncont(3,nod) + rbuf(ideb+2)
366 ideb = ideb + 3
367 ENDDO
368 ENDIF
369 IF (h3d_data%N_VECT_PCONT2_MAX > 0.OR.h3d_data%N_VECT_PCONT2_MIN > 0) THEN
370#include "vectorize.inc"
371 DO j = 1, len
372 nod = fr_i2m(iad+j)
373 fncontp(1,nod) = fncontp(1,nod) + rbuf(ideb)
374 fncontp(2,nod) = fncontp(2,nod) + rbuf(ideb+1)
375 fncontp(3,nod) = fncontp(3,nod) + rbuf(ideb+2)
376 ftcontp(1,nod) = ftcontp(1,nod) + rbuf(ideb+3)
377 ftcontp(2,nod) = ftcontp(2,nod) + rbuf(ideb+4)
378 ftcontp(3,nod) = ftcontp(3,nod) + rbuf(ideb+5)
379 ideb = ideb + 6
380 ENDDO
381 ENDIF
382C
383
384 ENDDO
385C
386 DO l=1,nbindex
387 CALL mpi_waitany(nbindex,req_s,index,status,ierror)
388 ENDDO
389C
390 DEALLOCATE(rbuf)
391 DEALLOCATE(sbuf)
392C
393#endif
394 RETURN
395 END
mpi_isend
subroutine mpi_isend(buf, cnt, datatype, dest, tag, comm, ireq, ierr)
Definition mpi.f:382
mpi_waitany
subroutine mpi_waitany(cnt, array_of_requests, index, status, ierr)
Definition mpi.f:549
mpi_irecv
subroutine mpi_irecv(buf, cnt, datatype, source, tag, comm, ireq, ierr)
Definition mpi.f:372
h3d_mod
Definition h3d_mod.F:308
spmd_exch_a_int2
subroutine spmd_exch_a_int2(a, ar, ms, in, stifn, stifr, fr_i2m, iad_i2m, lcomi2m, isize, intth2, fthe, condn, fncont, fncontp, ftcontp, h3d_data, idt_therm)
Definition spmd_exch_a_int2.F:38
h3d_mod::h3d_database
Definition h3d_mod.F:435