OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_exch_a_ams_poff.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_ams_poff ../engine/source/mpi/forces/spmd_exch_a_ams_poff.F
25!||--- called by ------------------------------------------------------
26!|| resol ../engine/source/engine/resol.F
27!||--- calls -----------------------------------------------------
28!||--- uses -----------------------------------------------------
29!|| glob_therm_mod ../common_source/modules/mat_elem/glob_therm_mod.F90
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_ams_poff(
34 1 A ,AR ,STIFN,STIFR ,MS ,
35 2 IAD_ELEM ,FR_ELEM,MSNF ,IFSUBM,SIZE,
36 3 LENR ,FTHE ,MCP ,FR_LOC,NB_FR,
37 4 MS_2D , MCP_OFF,FORNEQS,NFACNIT ,
38 5 LENC ,FCONT ,H3D_DATA,FNCONT ,
39 6 FTCONT ,GLOB_THERM )
40C--------------------------------------
41 USE h3d_mod
42 USE glob_therm_mod
43C-----------------------------------------------
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46 USE spmd_comm_world_mod, ONLY : spmd_comm_world
47#include "implicit_f.inc"
48C-----------------------------------------------------------------
49C M e s s a g e P a s s i n g
50C-----------------------------------------------
51#include "spmd.inc"
52C-----------------------------------------------
53C C o m m o n B l o c k s
54C-----------------------------------------------
55#include "com01_c.inc"
56#include "com04_c.inc"
57#include "task_c.inc"
58#include "scr14_c.inc"
59#include "intstamp_c.inc"
60C-----------------------------------------------
61C D u m m y A r g u m e n t s
62C-----------------------------------------------
63 INTEGER IAD_ELEM(2,*),FR_ELEM(*), SIZE, LENR, IFSUBM,NB_FR,FR_LOC(*),
64 . NFACNIT,LENC
65 my_real
66 . A(3,*),AR(3,*),STIFN(*),STIFR(*),MS(*),MSNF(*),
67 . FTHE(*),MCP(*),MCP_OFF(*),MS_2D(*),FORNEQS(3,*)
68 my_real , INTENT(INOUT) :: FCONT(3,NUMNOD),FNCONT(3,NUMNOD),
69 . ftcont(3,numnod)
70 TYPE(h3d_database) :: H3D_DATA
71 TYPE(glob_therm_) ,INTENT(IN) :: GLOB_THERM
72C-----------------------------------------------
73C L o c a l V a r i a b l e s
74C-----------------------------------------------
75#ifdef MPI
76 INTEGER MSGTYP,I,NOD,LOC_PROC,IERROR,MSGOFF,
77 . siz,j,k,l,nb_nod,
78 . status(mpi_status_size),
79 . iad_send(nspmd+1),iad_recv(nspmd+1),
80 . req_r(nspmd),req_s(nspmd),
81 . shift
82 DATA msgoff/121/
83
84 my_real
85 . rbuf(size*lenr + nfacnit*lenr + lenc*lenr),
86 . sbuf(size*lenr + nfacnit*lenr + lenc*lenr)
87 my_real,
88 . DIMENSION (:,:),ALLOCATABLE :: sav_a
89C-----------------------------------------------
90C S o u r c e L i n e s
91C-----------------------------------------------
92 ALLOCATE(sav_a(size+nfacnit+lenc,nb_fr))
93 shift=0
94
95 loc_proc = ispmd + 1
96 l = 1
97 iad_recv(1) = 1
98 DO i=1,nspmd
99 siz = (SIZE + nfacnit + lenc)*(iad_elem(1,i+1)-iad_elem(1,i))
100 IF(siz/=0)THEN
101 msgtyp = msgoff
102 CALL mpi_irecv(
103 s rbuf(l),siz,real,it_spmd(i),msgtyp,
104 g spmd_comm_world,req_r(i),ierror)
105 l = l + siz
106 ENDIF
107 iad_recv(i+1) = l
108 END DO
109 l = 1
110 iad_send(1) = 1
111
112 DO i=1,nspmd
113
114 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
115 nod = fr_elem(j)
116 sbuf(l) = a(1,nod)
117 sbuf(l+1) = a(2,nod)
118 sbuf(l+2) = a(3,nod)
119 sbuf(l+3) = stifn(nod)
120
121 shift = l+3
122
123 IF(iroddl/=0) THEN
124 sbuf(shift+1) = ar(1,nod)
125 sbuf(shift+2) = ar(2,nod)
126 sbuf(shift+3) = ar(3,nod)
127
128 sbuf(shift+4) = stifr(nod)
129 shift = shift+4
130 ENDIF
131
132 IF(n2d /=0) THEN
133 sbuf(shift+1) = ms(nod)
134 shift = shift+1
135 ENDIF
136
137 IF(n2d /=0.AND.ifsubm ==1) THEN
138 sbuf(shift+1) = ms_2d(nod)
139 shift = shift+1
140 ENDIF
141
142 IF(ifsubm ==1)THEN
143 sbuf(shift+1) = msnf(nod)
144 shift = shift+1
145 ENDIF
146
147 IF(glob_therm%INTHEAT /=0 .OR. glob_therm%ITHERM_FE/=0)THEN
148 sbuf(shift+1) = fthe(nod)
149 shift = shift+1
150 IF(glob_therm%ITHERM_FE /= 0) THEN
151 sbuf(shift+1) = mcp(nod)
152 shift = shift+1
153 sbuf(shift+1) = mcp_off(nod)
154 shift = shift+1
155 ENDIF
156 ENDIF
157
158 IF(nitsche/=0) THEN
159 sbuf(shift+1) = forneqs(1,nod)
160 sbuf(shift+2) = forneqs(2,nod)
161 sbuf(shift+3) = forneqs(3,nod)
162 shift = shift+nfacnit
163 ENDIF
164
165C --- /CONT/MAX output
166 IF(anim_v(26)+h3d_data%N_VECT_CONT_MAX /=0.AND.nintstamp==0) THEN
167 sbuf(shift+1) = fcont(1,nod)
168 sbuf(shift+2) = fcont(2,nod)
169 sbuf(shift+3) = fcont(3,nod)
170 shift = shift+3
171 ENDIF
172
173C --- /PCONT/MAX output
174 IF(anim_v(26)+h3d_data%N_VECT_PCONT_MAX /=0.AND.nintstamp==0) THEN
175 sbuf(shift+1) = fncont(1,nod)
176 sbuf(shift+2) = fncont(2,nod)
177 sbuf(shift+3) = fncont(3,nod)
178 sbuf(shift+4) = ftcont(1,nod)
179 sbuf(shift+5) = ftcont(2,nod)
180 sbuf(shift+6) = ftcont(3,nod)
181 shift = shift+6
182 ENDIF
183
184 l = l + SIZE + nfacnit +lenc
185 ENDDO
186
187 iad_send(i+1) = l
188 ENDDO
189C
190C echange messages
191C
192 DO i=1,nspmd
193C--------------------------------------------------------------------
194C envoi a N+I mod P
195C test si msg necessaire a envoyer a completer par test interface
196 IF(iad_elem(1,i+1)-iad_elem(1,i)>0)THEN
197 msgtyp = msgoff
198 siz = iad_send(i+1)-iad_send(i)
199 l = iad_send(i)
200 CALL mpi_isend(
201 s sbuf(l),siz,real,it_spmd(i),msgtyp,
202 g spmd_comm_world,req_s(i),ierror)
203 ENDIF
204C--------------------------------------------------------------------
205 ENDDO
206
207C SAUVEGARGE VALEURS ACCEL
208 DO j=1,nb_fr
209 nod=fr_loc(j)
210
211 sav_a(1,j) = a(1,nod)
212 sav_a(2,j) = a(2,nod)
213 sav_a(3,j) = a(3,nod)
214 sav_a(4,j) = stifn(nod)
215
216 a(1,nod) = zero
217 a(2,nod) = zero
218 a(3,nod) = zero
219 stifn(nod) = zero
220
221 shift = 4
222
223 IF(iroddl/=0) THEN
224 sav_a(shift+1,j) = ar(1,nod)
225 sav_a(shift+2,j) = ar(2,nod)
226 sav_a(shift+3,j) = ar(3,nod)
227 sav_a(shift+4,j) = stifr(nod)
228
229 ar(1,nod) = zero
230 ar(2,nod) = zero
231 ar(3,nod) = zero
232 stifr(nod) = zero
233 shift = shift+4
234 ENDIF
235
236 IF(n2d /=0) THEN
237 sav_a(shift+1,j) = ms(nod)
238 ms(nod) = zero
239 shift = shift+1
240 ENDIF
241
242 IF(n2d /=0.AND.ifsubm ==1) THEN
243 sav_a(shift+1,j) = ms_2d(nod)
244 ms_2d(nod) = zero
245 shift = shift+1
246 ENDIF
247
248 IF(ifsubm ==1)THEN
249 sav_a(shift+1,j) = msnf(nod)
250 msnf(nod) = zero
251 shift = shift+1
252 ENDIF
253
254 IF(glob_therm%INTHEAT /=0 .OR. glob_therm%ITHERM_FE/=0)THEN
255 sav_a(shift+1,j) = fthe(nod)
256 fthe(nod) = zero
257 shift = shift+1
258 IF(glob_therm%ITHERM_FE /= 0 ) THEN
259 sav_a(shift+1,j) = mcp(nod)
260 mcp(nod) = zero
261 shift = shift+1
262 sav_a(shift+1,j) = mcp_off(nod)
263 mcp_off(nod) = zero
264 shift = shift+1
265 ENDIF
266 ENDIF
267
268 IF(nitsche/=0) THEN
269 sav_a(shift+1,j) = forneqs(1,nod)
270 sav_a(shift+2,j) = forneqs(2,nod)
271 sav_a(shift+3,j) = forneqs(3,nod)
272
273 forneqs(1,nod) = zero
274 forneqs(2,nod) = zero
275 forneqs(3,nod) = zero
276
277 shift = shift+nfacnit
278 ENDIF
279
280 IF(anim_v(26)+h3d_data%N_VECT_CONT_MAX /=0.AND.nintstamp==0) THEN
281 sav_a(shift+1,j) = fcont(1,nod)
282 sav_a(shift+2,j) = fcont(2,nod)
283 sav_a(shift+3,j) = fcont(3,nod)
284
285 fcont(1,nod) = zero
286 fcont(2,nod) = zero
287 fcont(3,nod) = zero
288
289 shift = shift+3
290 ENDIF
291
292 IF(h3d_data%N_VECT_PCONT_MAX /=0.AND.nintstamp==0) THEN
293 sav_a(shift+1,j) = fncont(1,nod)
294 sav_a(shift+2,j) = fncont(2,nod)
295 sav_a(shift+3,j) = fncont(3,nod)
296 sav_a(shift+4,j) = ftcont(1,nod)
297 sav_a(shift+5,j) = ftcont(2,nod)
298 sav_a(shift+6,j) = ftcont(3,nod)
299
300 fncont(1,nod) = zero
301 fncont(2,nod) = zero
302 fncont(3,nod) = zero
303
304 shift = shift+6
305 ENDIF
306
307 ENDDO
308
309
310
311C
312C decompactage
313C
314 DO i = 1, nspmd
315 IF(i/=loc_proc)THEN
316C test si msg necessaire a envoyer a completer par test interface
317 nb_nod = iad_elem(1,i+1)-iad_elem(1,i)
318 IF(nb_nod>0)THEN
319 CALL mpi_wait(req_r(i),status,ierror)
320
321 l = iad_recv(i)
322 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
323 nod = fr_elem(j)
324 a(1,nod) = a(1,nod) + rbuf(l)
325 a(2,nod) = a(2,nod) + rbuf(l+1)
326 a(3,nod) = a(3,nod) + rbuf(l+2)
327 stifn(nod)= stifn(nod)+ rbuf(l+3)
328
329 shift = l+3
330
331 IF(iroddl/=0) THEN
332 ar(1,nod)= ar(1,nod)+ rbuf(shift+1)
333 ar(2,nod)= ar(2,nod)+ rbuf(shift+2)
334 ar(3,nod)= ar(3,nod)+ rbuf(shift+3)
335 stifr(nod)= stifr(nod)+ rbuf(shift+4)
336 shift = shift+4
337 ENDIF
338
339 IF(n2d /=0) THEN
340 ms(nod) = ms(nod)+ rbuf(shift+1)
341 shift = shift+1
342 ENDIF
343
344 IF(n2d /=0.AND.ifsubm ==1) THEN
345 ms_2d(nod) = ms_2d(nod)+ rbuf(shift+1)
346 shift = shift+1
347 ENDIF
348
349 IF(ifsubm ==1)THEN
350 msnf(nod) = msnf(nod) + rbuf(shift+1)
351 shift = shift+1
352 ENDIF
353
354 IF(glob_therm%INTHEAT /=0 .OR. glob_therm%ITHERM_FE/=0)THEN
355 fthe(nod) = fthe(nod) + rbuf(shift+1)
356 shift = shift+1
357 IF(glob_therm%ITHERM_FE /= 0) THEN
358 mcp(nod) = mcp(nod) + rbuf(shift+1)
359 shift = shift+1
360 mcp_off(nod) =max(mcp_off(nod),rbuf(shift+1))
361 shift = shift+1
362 ENDIF
363 ENDIF
364
365 IF(nitsche/=0) THEN
366 forneqs(1,nod)= forneqs(1,nod)+ rbuf(shift+1)
367 forneqs(2,nod)= forneqs(2,nod)+ rbuf(shift+2)
368 forneqs(3,nod)= forneqs(3,nod)+ rbuf(shift+3)
369 shift = shift+nfacnit
370 ENDIF
371
372 IF(anim_v(26)+h3d_data%N_VECT_CONT_MAX /=0.AND.nintstamp==0) THEN
373 fcont(1,nod)= fcont(1,nod)+ rbuf(shift+1)
374 fcont(2,nod)= fcont(2,nod)+ rbuf(shift+2)
375 fcont(3,nod)= fcont(3,nod)+ rbuf(shift+3)
376 shift = shift+3
377 ENDIF
378
379 IF(h3d_data%N_VECT_PCONT_MAX /=0.AND.nintstamp==0) THEN
380 fncont(1,nod)= fncont(1,nod)+ rbuf(shift+1)
381 fncont(2,nod)= fncont(2,nod)+ rbuf(shift+2)
382 fncont(3,nod)= fncont(3,nod)+ rbuf(shift+3)
383 ftcont(1,nod)= ftcont(1,nod)+ rbuf(shift+4)
384 ftcont(2,nod)= ftcont(2,nod)+ rbuf(shift+5)
385 ftcont(3,nod)= ftcont(3,nod)+ rbuf(shift+6)
386 shift = shift+6
387 ENDIF
388
389 l = l + SIZE +nfacnit +lenc
390 END DO
391 ENDIF
392 ELSE
393
394 DO j=1,nb_fr
395 nod=fr_loc(j)
396 a(1,nod) = a(1,nod) + sav_a(1,j)
397 a(2,nod) = a(2,nod) + sav_a(2,j)
398 a(3,nod) = a(3,nod) + sav_a(3,j)
399 stifn(nod)= stifn(nod)+ sav_a(4,j)
400 shift = 4
401
402 IF(iroddl/=0) THEN
403 ar(1,nod) = ar(1,nod) + sav_a(shift+1,j)
404 ar(2,nod) = ar(2,nod) + sav_a(shift+2,j)
405 ar(3,nod) = ar(3,nod) + sav_a(shift+3,j)
406 stifr(nod)= stifr(nod)+ sav_a(shift+4,j)
407 shift = shift+4
408 ENDIF
409
410 IF(n2d /=0) THEN
411 ms(nod) = ms(nod) + sav_a(shift+1,j)
412 shift = shift+1
413 ENDIF
414
415 IF(n2d /=0.AND.ifsubm ==1) THEN
416 ms_2d(nod) = ms_2d(nod) + sav_a(shift+1,j)
417 shift = shift+1
418 ENDIF
419
420 IF(ifsubm ==1)THEN
421 msnf(nod) = msnf(nod) + sav_a(shift+1,j)
422 shift = shift+1
423 ENDIF
424
425 IF(glob_therm%INTHEAT /=0 .OR. glob_therm%ITHERM_FE/=0)THEN
426 fthe(nod) = fthe(nod) + sav_a(shift+1,j)
427 shift = shift+1
428 IF(glob_therm%ITHERM_FE /= 0) THEN
429 mcp(nod) = mcp(nod) + sav_a(shift+1,j)
430 shift = shift+1
431 mcp_off(nod) = max(mcp_off(nod),sav_a(shift+1,j))
432 shift = shift+1
433 ENDIF
434 ENDIF
435
436 IF(nitsche/=0) THEN
437 forneqs(1,nod) = forneqs(1,nod) + sav_a(shift+1,j)
438 forneqs(2,nod) = forneqs(2,nod) + sav_a(shift+2,j)
439 forneqs(3,nod) = forneqs(3,nod) + sav_a(shift+3,j)
440 shift = shift+nfacnit
441 ENDIF
442
443C --- /CONT/MAX output
444 IF(anim_v(26)+h3d_data%N_VECT_CONT_MAX /=0.AND.nintstamp==0) THEN
445 fcont(1,nod) = fcont(1,nod) + sav_a(shift+1,j)
446 fcont(2,nod) = fcont(2,nod) + sav_a(shift+2,j)
447 fcont(3,nod) = fcont(3,nod) + sav_a(shift+3,j)
448 shift = shift+3
449 ENDIF
450
451 IF(h3d_data%N_VECT_PCONT_MAX /=0.AND.nintstamp==0) THEN
452 fncont(1,nod)= fncont(1,nod)+ sav_a(shift+1,j)
453 fncont(2,nod)= fncont(2,nod)+ sav_a(shift+2,j)
454 fncont(3,nod)= fncont(3,nod)+ sav_a(shift+3,j)
455 ftcont(1,nod)= ftcont(1,nod)+ sav_a(shift+4,j)
456 ftcont(2,nod)= ftcont(2,nod)+ sav_a(shift+5,j)
457 ftcont(3,nod)= ftcont(3,nod)+ sav_a(shift+6,j)
458 shift = shift+6
459 ENDIF
460
461 END DO
462 ENDIF
463 END DO
464C
465C wait terminaison isend
466C
467 DO i = 1, nspmd
468 IF(iad_elem(1,i+1)-iad_elem(1,i)>0)THEN
469 CALL mpi_wait(req_s(i),status,ierror)
470 ENDIF
471 ENDDO
472 DEALLOCATE(sav_a)
473C
474#endif
475 RETURN
476 END
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
h3d_mod
Definition h3d_mod.F:308
spmd_exch_a_ams_poff
subroutine spmd_exch_a_ams_poff(a, ar, stifn, stifr, ms, iad_elem, fr_elem, msnf, ifsubm, size, lenr, fthe, mcp, fr_loc, nb_fr, ms_2d, mcp_off, forneqs, nfacnit, lenc, fcont, h3d_data, fncont, ftcont, glob_therm)
Definition spmd_exch_a_ams_poff.F:40
h3d_mod::h3d_database
Definition h3d_mod.F:435