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