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

Go to the source code of this file.

Functions/Subroutines

subroutine outp_arsz_ss (iparg, dd_iad, ipm, ixs, p0ars, wasz, wasz_wr)
subroutine outp_arsz_cs (iparg, ixc, ixtg, igeo, ipm, dd_iad, p0ars, wasz, wasz_wr)
subroutine outp_arsz_st (iparg, dd_iad, wasz, wasz_wr, p0ars)
subroutine outp_arsz_ct (iparg, dd_iad, wasz, waszp, wasz_wr, elbuf_tab)
subroutine outp_arsz_rs (iparg, dd_iad, wasz, waszp, wasz_wr)
subroutine outp_arsz_rt (iparg, igeo, geo, ixr, dd_iad, wasz, waszp, wasz_wr)
subroutine outp_arsz_sps (iparg, dd_iad, wasz, waszp, wasz_wr)
subroutine outp_arsz_spt (iparg, dd_iad, wasz, waszp, wasz_wr)
subroutine outp_arsz_sptt (iparg, dd_iad, wasz, waszp, wasz_wr)
subroutine spmd_doutp_vgath (v, nodglob, weight, vgath)
subroutine spmd_doutp_gath (v, nodglob, weight, vgath)
subroutine spmd_rgather9 (v, len, vp0, lenp0, iad)
subroutine spmd_rgather9_dp (v, len, vp0, lenp0, iad)
subroutine spmd_outpitab (v, weight, nodglob, vglob)
subroutine spmd_rgather9_1comm (v, sizv, len, vp0, sizv0, adress)

Function/Subroutine Documentation

◆ outp_arsz_cs()

subroutine outp_arsz_cs ( integer, dimension(nparg,*) iparg,
integer, dimension(nixc,*) ixc,
integer, dimension(nixtg,*) ixtg,
integer, dimension(npropgi,*) igeo,
integer, dimension(npropmi,*) ipm,
integer, dimension(nspmd+1,*) dd_iad,
integer, dimension(2) p0ars,
integer, dimension(2) wasz,
integer, dimension(2) wasz_wr )

Definition at line 111 of file spmd_outp.F.

113C-----------------------------------------------
114C I m p l i c i t T y p e s
115C-----------------------------------------------
116 USE spmd_comm_world_mod, ONLY : spmd_comm_world
117#include "implicit_f.inc"
118C-----------------------------------------------
119C M P I I n c l u d e s
120C-----------------------------------------------
121#include "spmd.inc"
122C-----------------------------------------------
123C C o m m o n B l o c k s
124C-----------------------------------------------
125#include "com01_c.inc"
126#include "scr16_c.inc"
127#include "param_c.inc"
128#include "task_c.inc"
129C-----------------------------------------------
130C D u m m y A r g u m e n t s
131C-----------------------------------------------
132 INTEGER IXC(NIXC,*),IXTG(NIXTG,*),DD_IAD(NSPMD+1,*) ,
133 . IPARG(NPARG,*),IPM(NPROPMI,*),WASZ(2),IGEO(NPROPGI,*),
134 , P0ARS(2),IUSER_FULL,J,WASZ_WR(2)
135
136C-----------------------------------------------
137C L o c a l V a r i a b l e s
138C-----------------------------------------------
139#ifdef MPI
140 INTEGER JJ,NGF,NGL,NN,ITY,IAD,NFT,LFT,LLT,NPT,
141 . IHBE,IGTYP,NUVAR,MLW,NG,NEL,NBX,I,NPG,MPT,
142 . SZP0(2*NSPGROUP+2),RSZP0(2*NSPGROUP+2),P0ARSZ26
143 INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
144
145
146 p0ars = 0
147 wasz = 0
148
149 CALL count_arsz_cs(iparg,ixc,ixtg,igeo,ipm,dd_iad,
150 . wasz,szp0)
151
152 iuser_full = 0
153 DO j=1,60
154 IF(outp_cs(26 + j) == 1) iuser_full = 1
155 ENDDO
156
157 IF ( outp_cs( 1) == 1.OR.outp_cs( 2) == 1.OR.outp_cs( 3) == 1
158 . .OR.outp_cs( 4) == 1.OR.outp_cs( 7) == 1.OR.outp_cs(25) == 1
159 . .OR.outp_cs(20) == 1.OR.outp_cs(21) == 1.OR.outp_cs(22) == 1
160 . .OR.outp_cs(23) == 1.OR.outp_cs(24) == 1.OR.outp_cs(26) == 1
161 . .OR.iuser_full == 1) THEN
162
163
164 CALL mpi_reduce(szp0,rszp0,2*nspgroup+2,
165 . mpi_integer,mpi_sum,it_spmd(1),
166 . spmd_comm_world,ierror )
167
168 IF (ispmd == 0) THEN
169 p0ars(1:2) = rszp0(2*nspgroup+1:2*nspgroup+2)
170 wasz_wr(1:2) = -1
171 DO i=1,nspgroup
172 wasz_wr(1) = max(wasz_wr(1),rszp0(i))
173 wasz_wr(2) = max(wasz_wr(2),rszp0(nspgroup+i))
174 ENDDO
175 wasz_wr(1) = wasz_wr(1)+6
176 wasz_wr(2) = wasz_wr(2)+6
177 ELSE
178 p0ars = 1
179 wasz_wr(:) = 1
180 ENDIF
181 ENDIF
182#endif
183 RETURN
max
#define max(a, b)
Definition macros.h:21
mpi_reduce
subroutine mpi_reduce(sendbuf, recvbuf, cnt, datatype, op, root, comm, ierr)
Definition mpi.f:120
count_arsz_cs
subroutine count_arsz_cs(iparg, ixc, ixtg, igeo, ipm, dd_iad, wasz, siz_write_loc)
Definition outp_c_s.F:661

◆ outp_arsz_ct()

subroutine outp_arsz_ct ( integer, dimension(nparg,*) iparg,
integer, dimension(nspmd+1,*) dd_iad,
integer, dimension(3) wasz,
integer, dimension(3) waszp,
integer, dimension(3) wasz_wr,
type (elbuf_struct_), dimension(ngroup), target elbuf_tab )

Definition at line 268 of file spmd_outp.F.

269C-----------------------------------------------
270C M o d u l e s
271C-----------------------------------------------
272 USE elbufdef_mod
273C-----------------------------------------------
274C I m p l i c i t T y p e s
275C-----------------------------------------------
276 USE spmd_comm_world_mod, ONLY : spmd_comm_world
277#include "implicit_f.inc"
278C-----------------------------------------------
279C M P I I n c l u d e s
280C-----------------------------------------------
281#include "spmd.inc"
282C-----------------------------------------------
283C C o m m o n B l o c k s
284C-----------------------------------------------
285#include "param_c.inc"
286#include "task_c.inc"
287#include "com01_c.inc"
288#include "scr16_c.inc"
289C-----------------------------------------------
290C D u m m y A r g u m e n t s
291C-----------------------------------------------
292 INTEGER IPARG(NPARG,*),DD_IAD(NSPMD+1,*),WASZ(3),WASZP(3),WASZ_WR(3)
293 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
294C-----------------------------------------------
295C L o c a l V a r i a b l e s
296C-----------------------------------------------
297#ifdef MPI
298 INTEGER NGF,NGL,NN,ITY,MLW,NEL,NPT,IHBE,NPG,MPT,NG,JJ,COUNT,I,
299 . SZP0(3*NSPGROUP+3),RSZP0(3*NSPGROUP+3),
300 . IL,NLAY,IGTYP,NPT_ALL,
301 . NPTR,NPTS
302C-----------------------------------------------
303 INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
304
305 wasz = 0
306 waszp = 0
307 wasz_wr = 0
308 CALL count_arsz_ct(iparg,dd_iad,wasz,szp0,elbuf_tab)
309
310 count = 0
311 DO i=1,30
312 count = count + outp_ct(10+i)+outp_ct(50+i)+outp_ct(100+i)
313 ENDDO
314
315 IF ( outp_ct( 1) == 1.OR.outp_ct( 2) == 1.OR.outp_ct( 3) == 1
316 . .OR.outp_ct( 4) == 1.OR.outp_ct( 5) == 1.OR.outp_ct( 6) == 1
317 . .OR.outp_ct( 7) == 1.OR.outp_ct( 8) == 1.OR.outp_ct(91) == 1
318 . .OR.outp_ct(92) == 1.OR.outp_ct(93) == 1.OR.outp_ct(94) == 1
319 . .OR.count>0.OR.outp_ct(95)==1.OR.outp_ct(96)==1) THEN
320
321
322 CALL mpi_reduce(szp0,rszp0,3*nspgroup+3,
323 . mpi_integer,mpi_sum,it_spmd(1),
324 . spmd_comm_world,ierror )
325
326! ------
327 IF ( outp_ct(95) == 1) THEN
328 IF (ispmd == 0) THEN
329 waszp(2) = rszp0(3*nspgroup+2)
330 DO i=1,nspgroup
331 wasz_wr(2) = max(wasz_wr(2),rszp0(nspgroup+i))
332 ENDDO
333 ELSE
334 waszp(2) = 1
335 wasz_wr(2) = 1
336 ENDIF
337 ENDIF
338! ------
339 IF ( outp_ct(96) == 1) THEN
340 IF (ispmd == 0) THEN
341 waszp(3) = rszp0(3*nspgroup+3)
342 DO i=1,nspgroup
343 wasz_wr(3) = max(wasz_wr(3),rszp0(nspgroup+i))
344 ENDDO
345 ELSE
346 waszp(3) = 1
347 wasz_wr(3) = 1
348 ENDIF
349 ENDIF
350! ------
351 IF ( outp_ct( 1) == 1.OR.outp_ct( 2) == 1.OR.outp_ct( 3) == 1
352 . .OR.outp_ct( 4) == 1.OR.outp_ct( 5) == 1.OR.outp_ct( 6) == 1
353 . .OR.outp_ct( 7) == 1.OR.outp_ct( 8) == 1.OR.outp_ct(91) == 1
354 . .OR.outp_ct(92) == 1.OR.outp_ct(93) == 1.OR.outp_ct(94) == 1
355 . .OR.count>0) THEN
356 IF (ispmd == 0) THEN
357 waszp(1) = rszp0(3*nspgroup+1)
358 DO i=1,nspgroup
359 wasz_wr(1) = max(wasz_wr(1),rszp0(i))
360 ENDDO
361 wasz_wr(1) = wasz_wr(1) + 6
362 ELSE
363 waszp(1) = 1
364 wasz_wr(1) = 1
365 ENDIF
366 ENDIF
367! ------
368 ENDIF
369C--------
370c-----------
371#endif
372 RETURN
count_arsz_ct
subroutine count_arsz_ct(iparg, dd_iad, wasz, siz_write, elbuf_tab)
Definition outp_c_t.F:956

◆ outp_arsz_rs()

subroutine outp_arsz_rs ( integer, dimension(nparg,*) iparg,
integer, dimension(nspmd+1,*) dd_iad,
integer wasz,
integer waszp,
integer wasz_wr )

Definition at line 385 of file spmd_outp.F.

386C-----------------------------------------------
387C I m p l i c i t T y p e s
388C-----------------------------------------------
389 USE spmd_comm_world_mod, ONLY : spmd_comm_world
390#include "implicit_f.inc"
391C-----------------------------------------------
392C M P I I n c l u d e s
393C-----------------------------------------------
394#include "spmd.inc"
395C-----------------------------------------------
396C C o m m o n B l o c k s
397C-----------------------------------------------
398#include "param_c.inc"
399#include "com01_c.inc"
400#include "task_c.inc"
401#include "scr16_c.inc"
402C-----------------------------------------------
403C D u m m y A r g u m e n t s
404C-----------------------------------------------
405 INTEGER IPARG(NPARG,*),DD_IAD(NSPMD+1,*),WASZ,WASZP,WASZ_WR
406C-----------------------------------------------
407C L o c a l V a r i a b l e s
408C-----------------------------------------------
409#ifdef MPI
410 INTEGER NGF,NGL,NN,ITY,NEL,NG,JJ,SZP0(NSPGROUP+1),RSZP0(NSPGROUP+1),
411 . P0ARSZ2,WASZ2,I
412
413 INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
414C-----------------------------------------------
415
416 waszp = 0
417 wasz = 0
418 CALL count_arsz_rs(iparg,dd_iad,wasz,szp0)
419
420 IF (outp_rs(1) == 1) THEN
421 CALL mpi_reduce(szp0,rszp0,nspgroup+1,
422 . mpi_integer,mpi_sum,it_spmd(1),
423 . spmd_comm_world,ierror )
424
425 IF (ispmd == 0) THEN
426 waszp=rszp0(nspgroup+1)
427 wasz_wr = -1
428 DO i=1,nspgroup
429 wasz_wr = max(wasz_wr,rszp0(i))
430 ENDDO
431 wasz_wr = wasz_wr + 6
432 ELSE
433 waszp = 1
434 wasz_wr = 1
435 END IF
436 ENDIF
437
438#endif
439 RETURN
count_arsz_rs
subroutine count_arsz_rs(iparg, dd_iad, wasz, siz_write_loc)
Definition outp_r_s.F:175

◆ outp_arsz_rt()

subroutine outp_arsz_rt ( integer, dimension(nparg,*) iparg,
integer, dimension(npropgi,*) igeo,
geo,
integer, dimension(nixr,*) ixr,
integer, dimension(nspmd+1,*) dd_iad,
integer wasz,
integer waszp,
integer wasz_wr )

Definition at line 450 of file spmd_outp.F.

451C-----------------------------------------------
452C I m p l i c i t T y p e s
453C-----------------------------------------------
454 USE spmd_comm_world_mod, ONLY : spmd_comm_world
455#include "implicit_f.inc"
456C-----------------------------------------------
457C M P I I n c l u d e s
458C-----------------------------------------------
459#include "spmd.inc"
460C-----------------------------------------------
461C C o m m o n B l o c k s
462C-----------------------------------------------
463#include "param_c.inc"
464#include "com01_c.inc"
465#include "task_c.inc"
466#include "scr16_c.inc"
467C-----------------------------------------------
468C D u m m y A r g u m e n t s
469C-----------------------------------------------
470 INTEGER IPARG(NPARG,*),DD_IAD(NSPMD+1,*),WASZ,WASZP,
471 . IXR(NIXR,*),IGEO(NPROPGI,*),WASZ_WR
472 my_real
473 . geo(npropg,*)
474C-----------------------------------------------
475C L o c a l V a r i a b l e s
476C-----------------------------------------------
477#ifdef MPI
478 INTEGER NGF,NGL,NN,ITY,NEL,NG,JJ,SZP0(NSPGROUP+1),RSZP0(NSPGROUP+1),
479 . P0ARSZ2,WASZ2,IPROP,NUVAR,IGTYP,NFT,I
480
481 INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
482C-----------------------------------------------
483
484 waszp = 0
485 wasz = 0
486 CALL count_arsz_rt(iparg,igeo,geo,ixr,dd_iad,wasz,szp0)
487
488 IF (outp_rs(2) == 1) THEN
489 CALL mpi_reduce(szp0,rszp0,nspgroup+1,
490 . mpi_integer,mpi_sum,it_spmd(1),
491 . spmd_comm_world,ierror )
492
493 IF (ispmd == 0) THEN
494 waszp=rszp0(nspgroup+1)
495 wasz_wr = -1
496 DO i=1,nspgroup
497 wasz_wr = max(wasz_wr,rszp0(i))
498 ENDDO
499 wasz_wr = wasz_wr + 6
500 ELSE
501 waszp = 1
502 wasz_wr = 1
503 END IF
504 ENDIF
505#endif
506 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
count_arsz_rt
subroutine count_arsz_rt(iparg, igeo, geo, ixr, dd_iad, wasz, siz_write_loc)
Definition outp_r_t.F:478

◆ outp_arsz_sps()

subroutine outp_arsz_sps ( integer, dimension(nparg,*) iparg,
integer, dimension(nspmd+1,*) dd_iad,
integer wasz,
integer waszp,
integer wasz_wr )

Definition at line 517 of file spmd_outp.F.

518C-----------------------------------------------
519C I m p l i c i t T y p e s
520C-----------------------------------------------
521 USE spmd_comm_world_mod, ONLY : spmd_comm_world
522#include "implicit_f.inc"
523C-----------------------------------------------
524C M P I I n c l u d e s
525C-----------------------------------------------
526#include "spmd.inc"
527C-----------------------------------------------
528C C o m m o n B l o c k s
529C-----------------------------------------------
530#include "param_c.inc"
531#include "com01_c.inc"
532#include "task_c.inc"
533#include "scr16_c.inc"
534C-----------------------------------------------
535C D u m m y A r g u m e n t s
536C-----------------------------------------------
537 INTEGER IPARG(NPARG,*),DD_IAD(NSPMD+1,*),WASZ,WASZP,WASZ_WR
538C-----------------------------------------------
539C L o c a l V a r i a b l e s
540C-----------------------------------------------
541#ifdef MPI
542 INTEGER NGF,NGL,NN,ITY,NEL,NG,JJ,SZP0(NSPGROUP+1),RSZP0(NSPGROUP+1),
543 . P0ARSZ2,WASZ2,I
544
545 INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
546C-----------------------------------------------
547 waszp = 0
548 wasz = 0
549 CALL count_arsz_sps(iparg,dd_iad,wasz,szp0)
550
551 IF (outp_sps( 1) == 1.OR.outp_sps( 2) == 1.OR.
552 . outp_sps( 3) == 1.OR.outp_sps( 4) == 1.OR.
553 . outp_sps( 5) == 1.OR.outp_sps( 6) == 1.OR.
554 . outp_sps( 7) == 1.OR.outp_sps(25) == 1.OR.
555 . outp_sps(20) == 1.OR.outp_sps(21) == 1.OR.
556 . outp_sps(22) == 1.OR.outp_sps(23) == 1.OR.
557 . outp_sps(24) == 1 ) THEN
558
559
560 CALL mpi_reduce(szp0,rszp0,nspgroup+1,
561 . mpi_integer,mpi_sum,it_spmd(1),
562 . spmd_comm_world,ierror )
563
564 IF (ispmd == 0) THEN
565 waszp=rszp0(nspgroup+1)
566 wasz_wr = -1
567 DO i=1,nspgroup
568 wasz_wr = max(wasz_wr,rszp0(i))
569 ENDDO
570 wasz_wr = wasz_wr + 6
571 ELSE
572 waszp = 1
573 wasz_wr = 1
574 END IF
575 ENDIF
576#endif
577 RETURN
count_arsz_sps
subroutine count_arsz_sps(iparg, dd_iad, wasz, siz_write_loc)
Definition outp_sp_s.F:254

◆ outp_arsz_spt()

subroutine outp_arsz_spt ( integer, dimension(nparg,*) iparg,
integer, dimension(nspmd+1,*) dd_iad,
integer wasz,
integer waszp,
integer wasz_wr )

Definition at line 588 of file spmd_outp.F.

589C-----------------------------------------------
590C I m p l i c i t T y p e s
591C-----------------------------------------------
592 USE spmd_comm_world_mod, ONLY : spmd_comm_world
593#include "implicit_f.inc"
594C-----------------------------------------------
595C M P I I n c l u d e s
596C-----------------------------------------------
597#include "spmd.inc"
598C-----------------------------------------------
599C C o m m o n B l o c k s
600C-----------------------------------------------
601#include "param_c.inc"
602#include "com01_c.inc"
603#include "task_c.inc"
604#include "scr16_c.inc"
605C-----------------------------------------------
606C D u m m y A r g u m e n t s
607C-----------------------------------------------
608 INTEGER IPARG(NPARG,*),DD_IAD(NSPMD+1,*),WASZ,WASZP,WASZ_WR
609C-----------------------------------------------
610C L o c a l V a r i a b l e s
611C-----------------------------------------------
612#ifdef MPI
613 INTEGER NGF,NGL,NN,ITY,NEL,NG,JJ,SZP0(NSPGROUP+1),RSZP0(NSPGROUP+1),
614 . P0ARSZ2,WASZ2,I
615
616 INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
617C-----------------------------------------------
618 waszp = 0
619 wasz = 0
620 CALL count_arsz_spt(iparg,dd_iad,wasz,szp0)
621
622 IF (outp_spt( 1) == 1 ) THEN
623 CALL mpi_reduce(szp0,rszp0,nspgroup+1,
624 . mpi_integer,mpi_sum,it_spmd(1),
625 . spmd_comm_world,ierror )
626
627 IF (ispmd == 0) THEN
628 waszp=rszp0(nspgroup+1)
629 wasz_wr = -1
630 DO i=1,nspgroup
631 wasz_wr = max(wasz_wr,rszp0(i))
632 ENDDO
633 wasz_wr = wasz_wr + 6
634 ELSE
635 waszp = 1
636 wasz_wr = 1
637 END IF
638 ENDIF
639#endif
640 RETURN
count_arsz_spt
subroutine count_arsz_spt(iparg, dd_iad, wasz, siz_write_loc)
Definition outp_sp_t.F:362

◆ outp_arsz_sptt()

subroutine outp_arsz_sptt ( integer, dimension(nparg,*) iparg,
integer, dimension(nspmd+1,*) dd_iad,
integer wasz,
integer waszp,
integer wasz_wr )

Definition at line 651 of file spmd_outp.F.

652C-----------------------------------------------
653C I m p l i c i t T y p e s
654C-----------------------------------------------
655 USE spmd_comm_world_mod, ONLY : spmd_comm_world
656#include "implicit_f.inc"
657C-----------------------------------------------
658C M P I I n c l u d e s
659C-----------------------------------------------
660#include "spmd.inc"
661C-----------------------------------------------
662C C o m m o n B l o c k s
663C-----------------------------------------------
664#include "param_c.inc"
665#include "com01_c.inc"
666#include "task_c.inc"
667#include "scr16_c.inc"
668C-----------------------------------------------
669C D u m m y A r g u m e n t s
670C-----------------------------------------------
671 INTEGER IPARG(NPARG,*),DD_IAD(NSPMD+1,*),WASZ,WASZP,WASZ_WR
672C-----------------------------------------------
673C L o c a l V a r i a b l e s
674C-----------------------------------------------
675#ifdef MPI
676 INTEGER NGF,NGL,NN,ITY,NEL,NG,JJ,SZP0(NSPGROUP+1),RSZP0(NSPGROUP+1),
677 . P0ARSZ2,WASZ2,I
678
679 INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
680C-----------------------------------------------
681 waszp = 0
682 wasz = 0
683 CALL count_arsz_sptt(iparg,dd_iad,wasz,szp0)
684
685 IF (outp_spt( 1) == 1 ) THEN
686
687 CALL mpi_reduce(szp0,rszp0,nspgroup+1,
688 . mpi_integer,mpi_sum,it_spmd(1),
689 . spmd_comm_world,ierror )
690
691 IF (ispmd /= 0) THEN
692 waszp = 1
693 wasz_wr = 1
694 ELSE
695 wasz_wr = -1
696 DO i=1,nspgroup
697 wasz_wr = max(wasz_wr,rszp0(i))
698 ENDDO
699 waszp = rszp0(nspgroup+1)
700 END IF
701 ENDIF
702#endif
703 RETURN
count_arsz_sptt
subroutine count_arsz_sptt(iparg, dd_iad, wasz, siz_write_loc)
Definition outp_sp_t.F:415

◆ outp_arsz_ss()

subroutine outp_arsz_ss ( integer, dimension(nparg,*) iparg,
integer, dimension(nspmd+1,*) dd_iad,
integer, dimension(npropmi,*) ipm,
integer, dimension(nixs,*) ixs,
integer, dimension(2) p0ars,
integer, dimension(2) wasz,
integer, dimension(2) wasz_wr )

Definition at line 35 of file spmd_outp.F.

36C-----------------------------------------------
37C I m p l i c i t T y p e s
38C-----------------------------------------------
39 USE spmd_comm_world_mod, ONLY : spmd_comm_world
40#include "implicit_f.inc"
41C-----------------------------------------------
42C M P I I n c l u d e s
43C-----------------------------------------------
44#include "spmd.inc"
45C-----------------------------------------------
46C C o m m o n B l o c k s
47C-----------------------------------------------
48#include "param_c.inc"
49#include "com01_c.inc"
50#include "scr16_c.inc"
51#include "task_c.inc"
52C-----------------------------------------------
53C D u m m y A r g u m e n t s
54C-----------------------------------------------
55 INTEGER IPARG(NPARG,*),DD_IAD(NSPMD+1,*),P0ARS(2),WASZ(2),WASZ_WR(2),
56 . IXS(NIXS,*),IPM(NPROPMI,*)
57C-----------------------------------------------
58C L o c a l V a r i a b l e s
59C-----------------------------------------------
60#ifdef MPI
61 INTEGER NN,NG,SZP0(2*NSPGROUP+2),RSZP0(2*NSPGROUP+2),NGF,NGL,JJ,
62 . WASZ26,P0ARS26,MLW,NEL,NPT,JHBE,ISOLNOD,
63 . NUVAR,I,LFT,LLT,NFT,ITY
64
65 INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
66C-----------------------------------------------
67 p0ars = 0
68 wasz = 0
69 CALL count_arsz_ss(iparg,dd_iad,ipm,ixs,wasz,szp0)
70
71 IF ( outp_ss(1) == 1.OR.outp_ss(2) == 1.OR.outp_ss(3) == 1
72 . .OR.outp_ss(4) == 1.OR.outp_ss(5) == 1.OR.outp_ss(6) == 1
73 . .OR.outp_ss(7) == 1.OR.outp_ss(25) == 1.OR.outp_ss(20) == 1
74 . .OR.outp_ss(21) == 1.OR.outp_ss(22) == 1.OR.outp_ss(23) == 1
75 . .OR.outp_ss(24) == 1.OR.outp_ss(26) == 1 ) THEN
76
77 CALL mpi_reduce(szp0,rszp0,2*nspgroup+2,
78 . mpi_integer,mpi_sum,it_spmd(1),
79 . spmd_comm_world,ierror )
80
81
82 IF (ispmd == 0) THEN
83 p0ars(1) =rszp0(2*nspgroup+1)
84 p0ars(2) =rszp0(2*nspgroup+2)
85 wasz_wr(:) = -1
86 DO i=1,nspgroup
87 wasz_wr(1) = max(wasz_wr(1),rszp0(i))
88 wasz_wr(2) = max(wasz_wr(2),rszp0(nspgroup+i))
89 ENDDO
90 wasz_wr(1) = wasz_wr(1)+6
91 wasz_wr(2) = wasz_wr(2)+6
92 ELSE
93 p0ars(:) = 1
94 wasz_wr(:) = 1
95 ENDIF
96 END IF
97#endif
98 RETURN
count_arsz_ss
subroutine count_arsz_ss(iparg, dd_iad, ipm, ixs, wasz, siz_write_loc)
Definition outp_s_s.F:397

◆ outp_arsz_st()

subroutine outp_arsz_st ( integer, dimension(nparg,*) iparg,
integer, dimension(nspmd+1,*) dd_iad,
integer, dimension(3) wasz,
integer, dimension(3) wasz_wr,
integer, dimension(3) p0ars )

Definition at line 196 of file spmd_outp.F.

197C-----------------------------------------------
198C M o d u l e s
199C-----------------------------------------------
200 USE elbufdef_mod
201C-----------------------------------------------
202C I m p l i c i t T y p e s
203C-----------------------------------------------
204 USE spmd_comm_world_mod, ONLY : spmd_comm_world
205#include "implicit_f.inc"
206C-----------------------------------------------
207C M P I I n c l u d e s
208C-----------------------------------------------
209#include "spmd.inc"
210C-----------------------------------------------
211C C o m m o n B l o c k s
212C-----------------------------------------------
213#include "com01_c.inc"
214#include "scr16_c.inc"
215#include "task_c.inc"
216#include "param_c.inc"
217C-----------------------------------------------
218C D u m m y A r g u m e n t s
219C-----------------------------------------------
220 INTEGER IPARG(NPARG,*), DD_IAD(NSPMD+1,*),WASZ(3),WASZ_WR(3),P0ARS(3)
221C-----------------------------------------------
222C L o c a l V a r i a b l e s
223C-----------------------------------------------
224#ifdef MPI
225 INTEGER NGL,ITY,NRL,KHBE,MLW,NPT,ISOLNOD,NGF,NN,NEL,
226 . NG,NLAY,NPTR,NPTS,NPTT,NPTG,JJ,I,
227 . SZP0(3*NSPGROUP+3),RSZP0(3*NSPGROUP+3)
228 INTEGER IERROR,STATUS(MPI_STATUS_SIZE)
229C=======================================================================
230 wasz = 0
231 p0ars = 0
232c------------------------------
233 IF (outp_st(1)==1.OR.outp_st(2)==1.OR.outp_st(3)==1) THEN
234 CALL count_arsz_st(iparg,dd_iad,wasz,szp0)
235
236 CALL mpi_reduce(szp0,rszp0,3*nspgroup+3,
237 . mpi_integer,mpi_sum,it_spmd(1),
238 . spmd_comm_world,ierror )
239
240 IF (ispmd == 0) THEN
241 p0ars(1:3) = rszp0(3*nspgroup+1:3*nspgroup+3)+8
242 wasz_wr(1:3) = -1
243 DO i=1,nspgroup
244 wasz_wr(1) = max(wasz_wr(1),rszp0(i))
245 wasz_wr(2) = max(wasz_wr(2),rszp0(nspgroup+i))
246 wasz_wr(3) = max(wasz_wr(3),rszp0(2*nspgroup+i))
247 ENDDO
248 ELSE
249 p0ars(:) = 1
250 wasz_wr(:) = 1
251 ENDIF
252 ENDIF
253#endif
254 RETURN
count_arsz_st
subroutine count_arsz_st(iparg, dd_iad, wasz, szp0)
Definition outp_s_t.F:1016

◆ spmd_doutp_gath()

subroutine spmd_doutp_gath ( v,
integer, dimension(*) nodglob,
integer, dimension(*) weight,
vgath )

Definition at line 827 of file spmd_outp.F.

828C-----------------------------------------------
829C I m p l i c i t T y p e s
830C-----------------------------------------------
831 USE spmd_comm_world_mod, ONLY : spmd_comm_world
832#include "implicit_f.inc"
833#include "spmd.inc"
834C-----------------------------------------------
835C C o m m o n B l o c k s
836C-----------------------------------------------
837#include "com01_c.inc"
838#include "com04_c.inc"
839#include "task_c.inc"
840#include "spmd_c.inc"
841C-----------------------------------------------
842C D u m m y A r g u m e n t s
843C-----------------------------------------------
844 my_real
845 . v(*),vgath(*)
846 INTEGER WEIGHT(*),NODGLOB(*),NUM,SRECBUF
847C-----------------------------------------------
848C L O C A L V A R I A B L E S
849C-----------------------------------------------
850#ifdef MPI
851 INTEGER STATUS(MPI_STATUS_SIZE),IERROR,MSGOFF
852 INTEGER SIZ,MSGTYP,I,K,NG,NREC,MSGOFF2
853
854 DATA msgoff/9003/
855 DATA msgoff2/9004/
856 my_real
857 . bufsr(numnodm)
858 INTEGER IBUF(NUMNODM)
859C Tableau utilise par proc 0
860
861 IF (ispmd/=0) THEN
862
863 siz = 0
864 DO i=1,numnod
865 IF (weight(i) == 1) THEN
866 siz = siz + 1
867 ibuf(siz) = nodglob(i)
868 bufsr(siz) = v(i)
869 END IF
870 END DO
871
872C a cause de la version simple precision, on ne peux pas metre l'entier
873C dans le buffer flottant car on n a que 2puiss 24 bits dispo ~ 16 Million
874C de noeuds au max
875
876 msgtyp = msgoff2
877 CALL mpi_send(ibuf,siz,mpi_integer,it_spmd(1),msgtyp,
878 . spmd_comm_world,ierror)
879
880 msgtyp = msgoff
881 CALL mpi_send(bufsr,siz,real,it_spmd(1),msgtyp,
882 . spmd_comm_world,ierror)
883
884 ELSE
885
886 DO i=1,numnod
887 IF (weight(i) == 1) THEN
888 ng = nodglob(i)
889 vgath(ng) = v(i)
890 ENDIF
891 ENDDO
892
893 DO i=2,nspmd
894
895C Reception du buffer entier des adresses NODGLOB
896 msgtyp = msgoff2
897
898 CALL mpi_probe(it_spmd(i),msgtyp,
899 . spmd_comm_world,status,ierror)
900 CALL mpi_get_count(status,mpi_integer,siz,ierror)
901
902 CALL mpi_recv(ibuf,siz,mpi_integer,it_spmd(i),msgtyp,
903 . spmd_comm_world,status,ierror)
904
905C Reception du buffer flottant double des adresses NODGLOB
906
907 msgtyp = msgoff
908 CALL mpi_recv(bufsr,siz,real,it_spmd(i),msgtyp,
909 . spmd_comm_world,status,ierror)
910
911 nrec = siz
912 DO k = 1, nrec
913 ng = ibuf(k)
914 vgath(ng) = bufsr(k)
915 ENDDO
916 ENDDO
917
918
919 ENDIF
920
921#endif
922 RETURN
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_doutp_vgath()

subroutine spmd_doutp_vgath ( v,
integer, dimension(*) nodglob,
integer, dimension(*) weight,
vgath )

Definition at line 713 of file spmd_outp.F.

714C-----------------------------------------------
715C I m p l i c i t T y p e s
716C-----------------------------------------------
717 USE spmd_comm_world_mod, ONLY : spmd_comm_world
718#include "implicit_f.inc"
719#include "spmd.inc"
720C-----------------------------------------------
721C C o m m o n B l o c k s
722C-----------------------------------------------
723#include "com01_c.inc"
724#include "com04_c.inc"
725#include "task_c.inc"
726#include "spmd_c.inc"
727C-----------------------------------------------
728C D u m m y A r g u m e n t s
729C-----------------------------------------------
730 my_real
731 . v(3,*),vgath(3,*)
732 INTEGER WEIGHT(*),NODGLOB(*),NUM,SRECBUF
733C-----------------------------------------------
734C L O C A L V A R I A B L E S
735C-----------------------------------------------
736#ifdef MPI
737 INTEGER STATUS(MPI_STATUS_SIZE),IERROR,MSGOFF
738 INTEGER SIZ,MSGTYP,I,K,NG,NREC,MSGOFF2
739
740 DATA msgoff/9001/
741 DATA msgoff2/9002/
742 my_real
743 . bufsr(3,numnodm)
744 INTEGER IBUF(NUMNODM)
745C Tableau utilise par proc 0
746
747 IF (ispmd/=0) THEN
748
749 siz = 0
750 DO i=1,numnod
751 IF (weight(i) == 1) THEN
752 siz = siz + 1
753 ibuf(siz) = nodglob(i)
754 bufsr(1,siz) = v(1,i)
755 bufsr(2,siz) = v(2,i)
756 bufsr(3,siz) = v(3,i)
757 END IF
758 END DO
759
760C a cause de la version simple precision, on ne peux pas metre l'entier
761C dans le buffer flottant car on n a que 2puiss 24 bits dispo ~ 16 Million
762C de noeuds au max
763
764 msgtyp = msgoff2
765 CALL mpi_send(ibuf,siz,mpi_integer,it_spmd(1),msgtyp,
766 . spmd_comm_world,ierror)
767
768 msgtyp = msgoff
769 CALL mpi_send(bufsr,3*siz,real,it_spmd(1),msgtyp,
770 . spmd_comm_world,ierror)
771
772
773 ELSE
774
775 DO i=1,numnod
776 IF (weight(i) == 1) THEN
777 ng = nodglob(i)
778 vgath(1,ng) = v(1,i)
779 vgath(2,ng) = v(2,i)
780 vgath(3,ng) = v(3,i)
781 ENDIF
782 ENDDO
783
784
785 DO i=2,nspmd
786
787C Reception du buffer entier des adresses NODGLOB
788 msgtyp = msgoff2
789
790 CALL mpi_probe(it_spmd(i),msgtyp,
791 . spmd_comm_world,status,ierror)
792 CALL mpi_get_count(status,mpi_integer,siz,ierror)
793
794 CALL mpi_recv(ibuf,siz,mpi_integer,it_spmd(i),msgtyp,
795 . spmd_comm_world,status,ierror)
796
797C Reception du buffer flottant double des adresses NODGLOB
798
799 msgtyp = msgoff
800 CALL mpi_recv(bufsr,3*siz,real,it_spmd(i),msgtyp,
801 . spmd_comm_world,status,ierror)
802
803 nrec = siz
804 DO k = 1, nrec
805 ng = ibuf(k)
806 vgath(1,ng) = bufsr(1,k)
807 vgath(2,ng) = bufsr(2,k)
808 vgath(3,ng) = bufsr(3,k)
809 ENDDO
810 ENDDO
811
812
813 ENDIF
814
815#endif
816 RETURN

◆ spmd_outpitab()

subroutine spmd_outpitab ( integer, dimension(*) v,
integer, dimension(*) weight,
integer, dimension(*) nodglob,
integer, dimension(*) vglob )

Definition at line 1076 of file spmd_outp.F.

1077C-----------------------------------------------
1078C I m p l i c i t T y p e s
1079C-----------------------------------------------
1080 USE spmd_comm_world_mod, ONLY : spmd_comm_world
1081#include "implicit_f.inc"
1082#include "spmd.inc"
1083C-----------------------------------------------
1084C C o m m o n B l o c k s
1085C-----------------------------------------------
1086#include "com01_c.inc"
1087#include "com04_c.inc"
1088#include "task_c.inc"
1089#include "spmd_c.inc"
1090C-----------------------------------------------
1091C D u m m y A r g u m e n t s
1092C-----------------------------------------------
1093 integer
1094 . vglob(*),v(*)
1095
1096 INTEGER WEIGHT(*),NODGLOB(*),NUM,SRECBUF
1097C-----------------------------------------------
1098C L O C A L V A R I A B L E S
1099C-----------------------------------------------
1100#ifdef MPI
1101 INTEGER STATUS(MPI_STATUS_SIZE),IERROR,MSGOFF
1102 INTEGER SIZ,MSGTYP,I,K,NG,NREC
1103
1104 DATA msgoff/9005/
1105
1106 INTEGER BUFSR(2,NUMNODM)
1107
1108 IF (ispmd/=0) THEN
1109
1110 siz = 0
1111 DO i=1,numnod
1112 IF (weight(i) == 1) THEN
1113 siz = siz + 1
1114 bufsr(1,siz) = nodglob(i)
1115 bufsr(2,siz) = v(i)
1116 END IF
1117 END DO
1118
1119
1120 msgtyp = msgoff
1121 CALL mpi_send(bufsr,2*siz,mpi_integer,it_spmd(1),msgtyp,
1122 . spmd_comm_world,ierror)
1123
1124 ELSE
1125 DO i=1,numnod
1126 IF (weight(i) == 1) THEN
1127 ng = nodglob(i)
1128 vglob(ng) = v(i)
1129 ENDIF
1130 ENDDO
1131
1132 DO i=2,nspmd
1133
1134C Reception du buffer entier des adresses NODGLOB
1135 msgtyp = msgoff
1136
1137 CALL mpi_probe(it_spmd(i),msgtyp,
1138 . spmd_comm_world,status,ierror)
1139 CALL mpi_get_count(status,mpi_integer,siz,ierror)
1140
1141
1142 CALL mpi_recv(bufsr,siz,mpi_integer,it_spmd(i),msgtyp,
1143 . spmd_comm_world,status,ierror)
1144
1145 nrec = siz/2
1146
1147 DO k = 1, nrec
1148 ng = bufsr(1,k)
1149 vglob(ng) = bufsr(2,k)
1150 ENDDO
1151 ENDDO
1152
1153 ENDIF
1154
1155#endif
1156 RETURN

◆ spmd_rgather9()

subroutine spmd_rgather9 ( v,
integer len,
vp0,
integer lenp0,
integer iad )

Definition at line 932 of file spmd_outp.F.

933C-----------------------------------------------
934C I m p l i c i t T y p e s
935C-----------------------------------------------
936 USE spmd_comm_world_mod, ONLY : spmd_comm_world
937#include "implicit_f.inc"
938#include "spmd.inc"
939C-----------------------------------------------
940C C o m m o n B l o c k s
941C-----------------------------------------------
942#include "task_c.inc"
943#include "com01_c.inc"
944C-----------------------------------------------
945C D u m m y A r g u m e n t s
946C-----------------------------------------------
947 INTEGER LEN,LENP0,IAD
948 my_real
949 . v(len),vp0(lenp0)
950
951C-----------------------------------------------
952C L O C A L V A R I A B L E S
953C-----------------------------------------------
954#ifdef MPI
955 INTEGER STATUS(MPI_STATUS_SIZE),IERROR,
956 . MSGTYP,I,SIZ,LENP(NSPMD),DISP(NSPMD)
957
958C=======================================================================
959 CALL mpi_gather(
960 s len ,1 ,mpi_integer,
961 r lenp ,1 ,mpi_integer,it_spmd(1),
962 g spmd_comm_world,ierror)
963C
964 iad=0
965 IF(ispmd == 0)THEN
966 DO i=1,nspmd
967 disp(i) = iad
968 iad = iad+lenp(i)
969 END DO
970 END IF
971C
972 CALL mpi_gatherv(
973 s v ,len ,real,
974 r vp0 ,lenp ,disp,real ,it_spmd(1),
975 g spmd_comm_world,ierror)
976c------------
977#endif
978 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

◆ spmd_rgather9_1comm()

subroutine spmd_rgather9_1comm ( v,
integer sizv,
integer, dimension(nspgroup) len,
vp0,
integer sizv0,
integer, dimension(nspgroup+1,nspmd) adress )

Definition at line 1176 of file spmd_outp.F.

1177C-----------------------------------------------
1178C I m p l i c i t T y p e s
1179C-----------------------------------------------
1180 USE spmd_comm_world_mod, ONLY : spmd_comm_world
1181#include "implicit_f.inc"
1182#include "spmd.inc"
1183C-----------------------------------------------
1184C C o m m o n B l o c k s
1185C-----------------------------------------------
1186#include "task_c.inc"
1187#include "com01_c.inc"
1188C-----------------------------------------------
1189C D u m m y A r g u m e n t s
1190C-----------------------------------------------
1191 INTEGER LEN(NSPGROUP),SIZV,SIZV0,ADRESS(NSPGROUP+1,NSPMD)
1192 my_real
1193 . v(sizv),vp0(*)!SIZV0,NSPMD)
1194
1195C-----------------------------------------------
1196C L O C A L V A R I A B L E S
1197C-----------------------------------------------
1198#ifdef MPI
1199 INTEGER STATUS(MPI_STATUS_SIZE),IERROR,
1200 . MSGTYP,I,SIZ,DISP(NSPMD),
1201 . LENP(NSPMD*NSPGROUP),LENP_LOC(NSPMD)
1202 INTEGER IAD,J,LEN_LOC
1203C=======================================================================
1204 CALL mpi_gather(
1205 s len ,nspgroup ,mpi_integer,
1206 r lenp ,nspgroup ,mpi_integer,it_spmd(1),
1207 g spmd_comm_world,ierror)
1208C
1209C
1210 IF(ispmd == 0)THEN
1211 iad=0
1212 DO i=1,nspmd
1213 lenp_loc(i) = 0
1214 disp(i) = iad
1215 DO j=1,nspgroup
1216 iad = iad+lenp((i-1)*nspgroup+j)
1217 lenp_loc(i) = lenp_loc(i) + lenp((i-1)*nspgroup+j)
1218 ENDDO
1219 END DO
1220
1221 DO i=1,nspmd
1222 adress(1,i) = disp(i) + 1
1223 DO j=2,nspgroup+1
1224 adress(j,i) = lenp((i-1)*nspgroup+j-1) + adress(j-1,i)
1225 ENDDO
1226 ENDDO
1227 END IF ! end if(ispmd = 0)
1228C
1229 CALL mpi_gatherv(
1230 s v ,sizv ,real,
1231 r vp0 ,lenp_loc ,disp,real ,it_spmd(1),
1232 g spmd_comm_world,ierror)
1233
1234c------------
1235#endif
1236 RETURN

◆ spmd_rgather9_dp()

subroutine spmd_rgather9_dp ( double precision, dimension(len) v,
integer len,
double precision, dimension(lenp0) vp0,
integer lenp0,
integer iad )

Definition at line 1014 of file spmd_outp.F.

1015C-----------------------------------------------
1016C I m p l i c i t T y p e s
1017C-----------------------------------------------
1018 USE spmd_comm_world_mod, ONLY : spmd_comm_world
1019#include "implicit_f.inc"
1020#include "spmd.inc"
1021C-----------------------------------------------
1022C C o m m o n B l o c k s
1023C-----------------------------------------------
1024#include "task_c.inc"
1025#include "com01_c.inc"
1026C-----------------------------------------------
1027C D u m m y A r g u m e n t s
1028C-----------------------------------------------
1029 INTEGER LEN,LENP0,IAD
1030 double precision
1031 . v(len),vp0(lenp0)
1032
1033C-----------------------------------------------
1034C L O C A L V A R I A B L E S
1035C-----------------------------------------------
1036#ifdef MPI
1037 INTEGER STATUS(MPI_STATUS_SIZE),IERROR,
1038 . MSGTYP,I,SIZ,LENP(NSPMD),DISP(NSPMD)
1039
1040
1041
1042
1043 CALL mpi_gather(
1044 s len ,1 ,mpi_integer,
1045 r lenp ,1 ,mpi_integer,it_spmd(1),
1046 g spmd_comm_world,ierror)
1047C
1048 iad=0
1049 IF(ispmd == 0)THEN
1050 DO i=1,nspmd
1051 disp(i) = iad
1052 iad = iad+lenp(i)
1053 END DO
1054 END IF
1055C
1056 CALL mpi_gatherv(
1057 s v ,len ,mpi_double_precision,
1058 r vp0 ,lenp ,disp,mpi_double_precision,it_spmd(1),
1059 g spmd_comm_world,ierror)
1060#endif
1061 RETURN