OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_stat.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_stat_pgather ../engine/source/mpi/output/spmd_stat.F
26!||--- called by ------------------------------------------------------
27!|| dynain_c_strag ../engine/source/output/dynain/dynain_c_strag.F
28!|| dynain_c_strsg ../engine/source/output/dynain/dynain_c_strsg.F
29!|| stat_c_auxf ../engine/source/output/sta/stat_c_auxf.F
30!|| stat_c_epspf ../engine/source/output/sta/stat_c_epspf.F
31!|| stat_c_fail ../engine/source/output/sta/stat_c_fail.F
32!|| stat_c_orth_loc ../engine/source/output/sta/stat_c_orth_loc.F
33!|| stat_c_straf ../engine/source/output/sta/stat_c_straf.F
34!|| stat_c_strafg ../engine/source/output/sta/stat_c_strafg.F
35!|| stat_c_strsf ../engine/source/output/sta/stat_c_strsf.F
36!|| stat_c_strsfg ../engine/source/output/sta/stat_c_strsfg.F
37!|| stat_p_aux ../engine/source/output/sta/stat_p_aux.F
38!|| stat_p_full ../engine/source/output/sta/stat_p_full.F
39!|| stat_r_full ../engine/source/output/sta/stat_r_full.F
40!|| stat_s_auxf ../engine/source/output/sta/stat_s_auxf.F
41!|| stat_s_eref ../engine/source/output/sta/stat_s_eref.F
42!|| stat_s_fail ../engine/source/output/sta/stat_s_fail.F
43!|| stat_s_ortho ../engine/source/output/sta/stat_s_ortho.F
44!|| stat_s_straf ../engine/source/output/sta/stat_s_straf.F
45!|| stat_s_strsf ../engine/source/output/sta/stat_s_strsf.F
46!|| stat_sphcel_full ../engine/source/output/sta/stat_sphcel_full.F90
47!|| stat_t_full ../engine/source/output/sta/stat_t_full.F
48!||--- calls -----------------------------------------------------
49!||--- uses -----------------------------------------------------
50!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
51!||====================================================================
52 SUBROUTINE spmd_stat_pgather(PTV,PTLEN,PTV_P0,PTLEN_P0)
53C-----------------------------------------------
54C I m p l i c i t T y p e s
55C-----------------------------------------------
56 USE spmd_comm_world_mod, ONLY : spmd_comm_world
57#include "implicit_f.inc"
58#include "spmd.inc"
59C-----------------------------------------------
60C C o m m o n B l o c k s
61C-----------------------------------------------
62#include "task_c.inc"
63#include "com01_c.inc"
64C-----------------------------------------------
65C D u m m y A r g u m e n t s
66C-----------------------------------------------
67 INTEGER PTLEN,PTLEN_P0,PTV(PTLEN),PTV_P0(0:MAX(1,PTLEN_P0))
68C-----------------------------------------------
69C L O C A L V A R I A B L E S
70C-----------------------------------------------
71#ifdef MPI
72 INTEGER STATUS(MPI_STATUS_SIZE),IERROR,
73 . MSGTYP,I,J,IAD,IDEB, POLD,
74 . LENP(NSPMD),DISP(NSPMD)
75
76
77
78
79 CALL mpi_gather(
80 s ptlen ,1 ,mpi_integer,
81 r lenp ,1 ,mpi_integer,it_spmd(1),
82 g spmd_comm_world,ierror)
83C
84 iad=0
85 IF(ispmd==0)THEN
86 DO i=1,nspmd
87 disp(i) = iad
88 iad = iad+lenp(i)
89 END DO
90 END IF
91C
92 CALL mpi_gatherv(
93 s ptv ,ptlen ,mpi_integer,
94 r ptv_p0(1) ,lenp ,disp,mpi_integer ,it_spmd(1),
95 g spmd_comm_world,ierror)
96C
97 IF(ispmd==0)THEN
98C construit les pointeurs globaux de fin de zone
99 ptv_p0(0)=0
100 DO i=2,nspmd
101 ideb = disp(i)
102 pold = ptv_p0(ideb)
103 DO j=1,lenp(i)
104 ptv_p0(ideb+j)=ptv_p0(ideb+j)+pold
105 END DO
106 END DO
107 END IF
108
109#endif
110 RETURN
111 END
112!||====================================================================
113!|| spmd_iget_partn_sta ../engine/source/mpi/output/spmd_stat.F
114!||--- called by ------------------------------------------------------
115!|| dynain_shel_spmd ../engine/source/output/dynain/dynain_shel_spmd.F
116!|| stat_beam_spmd ../engine/source/output/sta/stat_beam_spmd.F
117!|| stat_brick_spmd ../engine/source/output/sta/stat_brick_spmd.F
118!|| stat_shel_spmd ../engine/source/output/sta/stat_shel_spmd.F
119!|| stat_sphcel_spmd ../engine/source/output/sta/stat_sphcel_spmd.F90
120!|| stat_spring_spmd ../engine/source/output/sta/stat_spring_spmd.F
121!|| stat_truss_spmd ../engine/source/output/sta/stat_truss_spmd.F
122!||--- calls -----------------------------------------------------
123!||--- uses -----------------------------------------------------
124!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
125!||====================================================================
126 SUBROUTINE spmd_iget_partn_sta(
127 . SIZE,STAT_NUMEL,STAT_LENELG,LENG,NP,
128 . IADG,NPGLOB,STAT_INDX)
129C gather sur p0 du tableau wa en fonction des parts (IADG)
130C-----------------------------------------------
131C I m p l i c i t T y p e s
132C-----------------------------------------------
133 USE spmd_comm_world_mod, ONLY : spmd_comm_world
134#include "implicit_f.inc"
135C-----------------------------------------------
136C M e s s a g e P a s s i n g
137C-----------------------------------------------
138
139#include "spmd.inc"
140
141C-----------------------------------------------
142C C o m m o n B l o c k s
143C-----------------------------------------------
144#include "com01_c.inc"
145#include "task_c.inc"
146C-----------------------------------------------
147C D u m m y A r g u m e n t s
148C-----------------------------------------------
149 INTEGER SIZE, STAT_NUMEL, STAT_LENELG, LENG, NP(*),
150 . IADG(NSPMD,*),NPGLOB(*),STAT_INDX(*)
151C-----------------------------------------------
152C L o c a l V a r i a b l e s
153C-----------------------------------------------
154#ifdef MPI
155 INTEGER MSGOFF,MSGTYP,INFO,IDEB,K,N,NB_TMP,LEN,
156 . NBF_L,NPT(SIZE*STAT_NUMEL)
157 INTEGER STATUS(MPI_STATUS_SIZE),IERROR
158 DATA MSGOFF/10001/
159C-----------------------------------------------
160C S o u r c e L i n e s
161C-----------------------------------------------
162 nbf_l = size*stat_numel
163 IF (ispmd/=0) THEN
164 msgtyp=msgoff
165
166
167 CALL mpi_send(np,nbf_l,mpi_integer,it_spmd(1),msgtyp,
168 . spmd_comm_world,ierror)
169
170
171 stat_lenelg=0
172
173 ELSE
174 DO k=1,nbf_l
175 npglob(k) = np(k)
176 ENDDO
177 ideb = nbf_l + 1
178C
179 DO k=2,nspmd
180 msgtyp=msgoff
181
182 CALL mpi_probe(it_spmd(k),msgtyp,
183 . spmd_comm_world,status,ierror)
184 CALL mpi_get_count(status,mpi_integer,nb_tmp,ierror)
185C 12
186 CALL mpi_recv(npglob(ideb),nb_tmp,mpi_integer,it_spmd(k),
187 . msgtyp,spmd_comm_world,status,ierror)
188
189 ideb = ideb + nb_tmp
190 END DO
191
192 stat_lenelg=ideb/SIZE
193
194 END IF
195C
196#endif
197 RETURN
198 END
199
200!||====================================================================
201!|| spmd_dstat_vgath ../engine/source/mpi/output/spmd_stat.F
202!||--- called by ------------------------------------------------------
203!|| dynain_node ../engine/source/output/dynain/dynain_node.F
204!|| stat_n_vel ../engine/source/output/sta/state_n_vel.F
205!|| stat_node ../engine/source/output/sta/stat_node.F
206!||--- calls -----------------------------------------------------
207!||--- uses -----------------------------------------------------
208!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
209!||====================================================================
210 SUBROUTINE spmd_dstat_vgath(V,NODGLOB,WEIGHT,VGATH,NODTAG,
211 . NODTAGLOB)
212C-----------------------------------------------
213C I m p l i c i t T y p e s
214C-----------------------------------------------
215 USE spmd_comm_world_mod, ONLY : spmd_comm_world
216#include "implicit_f.inc"
217#include "spmd.inc"
218C-----------------------------------------------
219C C o m m o n B l o c k s
220C-----------------------------------------------
221#include "com01_c.inc"
222#include "com04_c.inc"
223#include "task_c.inc"
224#include "spmd_c.inc"
225C-----------------------------------------------
226C D u m m y A r g u m e n t s
227C-----------------------------------------------
228 my_real
229 . v(3,*),vgath(3,*)
230 INTEGER WEIGHT(*),NODGLOB(*),NUM,SRECBUF,NODTAG(*),
231 . nodtaglob(*)
232C-----------------------------------------------
233C L O C A L V A R I A B L E S
234C-----------------------------------------------
235#ifdef MPI
236 INTEGER STATUS(MPI_STATUS_SIZE),IERROR,MSGOFF
237 INTEGER SIZ,MSGTYP,I,K,NG,NREC,MSGOFF2
238
239 DATA msgoff/10002/
240 DATA msgoff2/10002/
241 my_real
242 . bufsr(3,numnodm)
243 INTEGER IBUF(NUMNODM)
244C Tableau utilise par proc 0
245
246 IF (ispmd/=0) THEN
247
248 siz = 0
249 DO i=1,numnod
250 IF (nodtag(i)/=0) THEN
251 siz = siz + 1
252 ibuf(siz) = nodglob(i)
253 bufsr(1,siz) = v(1,i)
254 bufsr(2,siz) = v(2,i)
255 bufsr(3,siz) = v(3,i)
256 END IF
257 END DO
258
259C a cause de la version simple precision, on ne peux pas metre l'entier
260C dans le buffer flottant car on n a que 2puiss 24 bits dispo ~ 16 Million
261C de noeuds au max
262
263 msgtyp = msgoff2
264 CALL mpi_send(ibuf,siz,mpi_integer,it_spmd(1),msgtyp,
265 . spmd_comm_world,ierror)
266
267 msgtyp = msgoff
268 CALL mpi_send(bufsr,3*siz,real,it_spmd(1),msgtyp,
269 . spmd_comm_world,ierror)
270
271
272 ELSE
273
274 nodtaglob(1:numnodg)=0
275 DO i=1,numnod
276 IF (nodtag(i)/=0) THEN
277 ng = nodglob(i)
278 nodtaglob(ng)=1
279 vgath(1,ng) = v(1,i)
280 vgath(2,ng) = v(2,i)
281 vgath(3,ng) = v(3,i)
282 ENDIF
283 ENDDO
284
285
286 DO i=2,nspmd
287
288C Reception du buffer entier des adresses NODGLOB
289 msgtyp = msgoff2
290
291 CALL mpi_probe(it_spmd(i),msgtyp,
292 . spmd_comm_world,status,ierror)
293 CALL mpi_get_count(status,mpi_integer,siz,ierror)
294
295 CALL mpi_recv(ibuf,siz,mpi_integer,it_spmd(i),msgtyp,
296 . spmd_comm_world,status,ierror)
297
298C Reception du buffer flottant double des adresses NODGLOB
299
300 msgtyp = msgoff
301 CALL mpi_recv(bufsr,3*siz,real,it_spmd(i),msgtyp,
302 . spmd_comm_world,status,ierror)
303
304 nrec = siz
305 DO k = 1, nrec
306 ng = ibuf(k)
307 nodtaglob(ng)=1
308 vgath(1,ng) = bufsr(1,k)
309 vgath(2,ng) = bufsr(2,k)
310 vgath(3,ng) = bufsr(3,k)
311 ENDDO
312 ENDDO
313
314
315 ENDIF
316
317#endif
318 RETURN
319 END
320!||====================================================================
321!|| spmd_dstat_gath ../engine/source/mpi/output/spmd_stat.F
322!||--- called by ------------------------------------------------------
323!|| stat_n_temp ../engine/source/output/sta/stat_n_temp.F
324!||--- calls -----------------------------------------------------
325!||--- uses -----------------------------------------------------
326!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
327!||====================================================================
328 SUBROUTINE spmd_dstat_gath(V,NODGLOB,WEIGHT,VGATH,NODTAG,
329 . NODTAGLOB)
330C-----------------------------------------------
331C I m p l i c i t T y p e s
332C-----------------------------------------------
333 USE spmd_comm_world_mod, ONLY : spmd_comm_world
334#include "implicit_f.inc"
335#include "spmd.inc"
336C-----------------------------------------------
337C C o m m o n B l o c k s
338C-----------------------------------------------
339#include "com01_c.inc"
340#include "com04_c.inc"
341#include "task_c.inc"
342#include "spmd_c.inc"
343C-----------------------------------------------
344C D u m m y A r g u m e n t s
345C-----------------------------------------------
346 my_real
347 . v(*),vgath(*)
348 INTEGER WEIGHT(*),NODGLOB(*),NUM,SRECBUF,NODTAG(*),
349 . NODTAGLOB(*)
350C-----------------------------------------------
351C L O C A L V A R I A B L E S
352C-----------------------------------------------
353#ifdef MPI
354 INTEGER STATUS(MPI_STATUS_SIZE),IERROR,MSGOFF
355 INTEGER SIZ,MSGTYP,I,K,NG,NREC,MSGOFF2
356
357 DATA MSGOFF/10003/
358 DATA msgoff2/10003/
359 my_real
360 . bufsr(numnodm)
361 INTEGER IBUF(NUMNODM)
362C Tableau utilise par proc 0
363
364 IF (ispmd/=0) THEN
365
366 siz = 0
367 DO i=1,numnod
368 IF (nodtag(i)/=0) THEN
369 siz = siz + 1
370 ibuf(siz) = nodglob(i)
371 bufsr(siz) = v(i)
372 END IF
373 END DO
374
375C a cause de la version simple precision, on ne peux pas metre l'entier
376C dans le buffer flottant car on n a que 2puiss 24 bits dispo ~ 16 Million
377C de noeuds au max
378
379 msgtyp = msgoff2
380 CALL mpi_send(ibuf,siz,mpi_integer,it_spmd(1),msgtyp,
381 . spmd_comm_world,ierror)
382
383 msgtyp = msgoff
384 CALL mpi_send(bufsr,siz,real,it_spmd(1),msgtyp,
385 . spmd_comm_world,ierror)
386
387
388 ELSE
389
390 nodtaglob(1:numnodg)=0
391 DO i=1,numnod
392 IF (nodtag(i)/=0) THEN
393 ng = nodglob(i)
394 nodtaglob(ng)=1
395 vgath(ng) = v(i)
396 ENDIF
397 ENDDO
398
399
400 DO i=2,nspmd
401
402C Reception du buffer entier des adresses NODGLOB
403 msgtyp = msgoff2
404
405 CALL mpi_probe(it_spmd(i),msgtyp,
406 . spmd_comm_world,status,ierror)
407 CALL mpi_get_count(status,mpi_integer,siz,ierror)
408
409 CALL mpi_recv(ibuf,siz,mpi_integer,it_spmd(i),msgtyp,
410 . spmd_comm_world,status,ierror)
411
412C Reception du buffer flottant double des adresses NODGLOB
413
414 msgtyp = msgoff
415 CALL mpi_recv(bufsr,siz,real,it_spmd(i),msgtyp,
416 . spmd_comm_world,status,ierror)
417
418 nrec = siz
419 DO k = 1, nrec
420 ng = ibuf(k)
421 nodtaglob(ng)=1
422 vgath(ng) = bufsr(k)
423 ENDDO
424 ENDDO
425
426
427 ENDIF
428
429#endif
430 RETURN
431 END
432
433
434!||====================================================================
435!|| spmd_istat_gath ../engine/source/mpi/output/spmd_stat.F
436!||--- called by ------------------------------------------------------
437!|| stat_n_bcs ../engine/source/output/sta/stat_n_bcs.F
438!||--- calls -----------------------------------------------------
439!||--- uses -----------------------------------------------------
440!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
441!||====================================================================
442 SUBROUTINE spmd_istat_gath(VI,NODGLOB,VIGATH)
443C-----------------------------------------------
444C I m p l i c i t T y p e s
445C-----------------------------------------------
446 USE spmd_comm_world_mod, ONLY : spmd_comm_world
447#include "implicit_f.inc"
448#include "spmd.inc"
449C-----------------------------------------------
450C C o m m o n B l o c k s
451C-----------------------------------------------
452#include "com01_c.inc"
453#include "com04_c.inc"
454#include "task_c.inc"
455#include "spmd_c.inc"
456C-----------------------------------------------
457C D u m m y A r g u m e n t s
458C-----------------------------------------------
459 INTEGER VI(*),VIGATH(*),NODGLOB(*)
460C-----------------------------------------------
461C L O C A L V A R I A B L E S
462C-----------------------------------------------
463#ifdef MPI
464 INTEGER STATUS(MPI_STATUS_SIZE),IERROR,MSGOFF,MSGOFF2
465 INTEGER SIZ,MSGTYP,I,K,NG,NREC
466
467 DATA MSGOFF/10003/
468 DATA msgoff2/10003/
469 INTEGER IBUFN(NUMNODM),IBUFM(NUMNODM)
470C Tableau utilise par proc 0
471
472 IF (ispmd/=0) THEN
473
474 siz = 0
475 DO i=1,numnod
476 siz = siz + 1
477 ibufn(siz) = nodglob(i)
478 ibufm(siz) = vi(i)
479 END DO
480
481C
482
483 msgtyp = msgoff
484 CALL mpi_send(ibufn,siz,mpi_integer,it_spmd(1),msgtyp,
485 . spmd_comm_world,ierror)
486
487 msgtyp = msgoff2
488 CALL mpi_send(ibufm,siz,mpi_integer,it_spmd(1),msgtyp,
489 . spmd_comm_world,ierror)
490
491
492 ELSE
493 DO i=1,numnod
494 ng = nodglob(i)
495 vigath(ng) = vi(i)
496 ENDDO
497
498
499 DO i=2,nspmd
500
501C Reception du buffer entier des adresses NODGLOB
502 msgtyp = msgoff
503
504 CALL mpi_probe(it_spmd(i),msgtyp,
505 . spmd_comm_world,status,ierror)
506 CALL mpi_get_count(status,mpi_integer,siz,ierror)
507
508 CALL mpi_recv(ibufn,siz,mpi_integer,it_spmd(i),msgtyp,
509 . spmd_comm_world,status,ierror)
510
511C Reception Integer Buffer of ICODE
512 msgtyp = msgoff2
513 CALL mpi_recv(ibufm,siz,mpi_integer,it_spmd(i),msgtyp,
514 . spmd_comm_world,status,ierror)
515
516 nrec = siz
517 DO k = 1, nrec
518 ng = ibufn(k)
519 vigath(ng) = ibufm(k)
520 ENDDO
521 ENDDO
522
523
524 ENDIF
525
526#endif
527 RETURN
528 END
529
530
531
my_real
#define my_real
Definition cppsort.cpp:32
mpi_recv
subroutine mpi_recv(buf, cnt, datatype, source, tag, comm, status, ierr)
Definition mpi.f:461
mpi_get_count
subroutine mpi_get_count(status, datatype, cnt, ierr)
Definition mpi.f:296
mpi_send
subroutine mpi_send(buf, cnt, datatype, dest, tag, comm, ierr)
Definition mpi.f:480
mpi_probe
subroutine mpi_probe(source, tag, comm, status, ierr)
Definition mpi.f:449
mpi_gather
subroutine mpi_gather(sendbuf, cnt, datatype, recvbuf, reccnt, rectype, root, comm, ierr)
Definition mpi.f:56
mpi_gatherv
subroutine mpi_gatherv(sendbuf, cnt, datatype, recvbuf, reccnt, displs, rectype, root, comm, ierr)
Definition mpi.f:76
spmd_dstat_vgath
subroutine spmd_dstat_vgath(v, nodglob, weight, vgath, nodtag, nodtaglob)
Definition spmd_stat.F:212
spmd_istat_gath
subroutine spmd_istat_gath(vi, nodglob, vigath)
Definition spmd_stat.F:443
spmd_stat_pgather
subroutine spmd_stat_pgather(ptv, ptlen, ptv_p0, ptlen_p0)
Definition spmd_stat.F:53
spmd_iget_partn_sta
subroutine spmd_iget_partn_sta(size, stat_numel, stat_lenelg, leng, np, iadg, npglob, stat_indx)
Definition spmd_stat.F:129
spmd_dstat_gath
subroutine spmd_dstat_gath(v, nodglob, weight, vgath, nodtag, nodtaglob)
Definition spmd_stat.F:330