OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_stat.F File Reference
#include "implicit_f.inc"
#include "spmd.inc"
#include "task_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "spmd_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine spmd_stat_pgather (ptv, ptlen, ptv_p0, ptlen_p0)
subroutine spmd_iget_partn_sta (size, stat_numel, stat_lenelg, leng, np, iadg, npglob, stat_indx)
subroutine spmd_dstat_vgath (v, nodglob, weight, vgath, nodtag, nodtaglob)
subroutine spmd_dstat_gath (v, nodglob, weight, vgath, nodtag, nodtaglob)
subroutine spmd_istat_gath (vi, nodglob, vigath)

Function/Subroutine Documentation

◆ spmd_dstat_gath()

subroutine spmd_dstat_gath ( v,
integer, dimension(*) nodglob,
integer, dimension(*) weight,
vgath,
integer, dimension(*) nodtag,
integer, dimension(*) nodtaglob )

Definition at line 328 of file spmd_stat.F.

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
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

◆ spmd_dstat_vgath()

subroutine spmd_dstat_vgath ( v,
integer, dimension(*) nodglob,
integer, dimension(*) weight,
vgath,
integer, dimension(*) nodtag,
integer, dimension(*) nodtaglob )

Definition at line 210 of file spmd_stat.F.

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

◆ spmd_iget_partn_sta()

subroutine spmd_iget_partn_sta ( integer size,
integer stat_numel,
integer stat_lenelg,
integer leng,
integer, dimension(*) np,
integer, dimension(nspmd,*) iadg,
integer, dimension(*) npglob,
integer, dimension(*) stat_indx )

Definition at line 126 of file spmd_stat.F.

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

◆ spmd_istat_gath()

subroutine spmd_istat_gath ( integer, dimension(*) vi,
integer, dimension(*) nodglob,
integer, dimension(*) vigath )

Definition at line 442 of file spmd_stat.F.

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

◆ spmd_stat_pgather()

subroutine spmd_stat_pgather ( integer, dimension(ptlen) ptv,
integer ptlen,
integer, dimension(0:max(1,ptlen_p0)) ptv_p0,
integer ptlen_p0 )

Definition at line 52 of file spmd_stat.F.

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
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