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 114 of file spmd_outp.F.

116C-----------------------------------------------
117C I m p l i c i t T y p e s
118C-----------------------------------------------
119 use element_mod , only : nixc,nixtg
120 USE spmd_comm_world_mod, ONLY : spmd_comm_world
121#include "implicit_f.inc"
122C-----------------------------------------------
123C M P I I n c l u d e s
124C-----------------------------------------------
125#include "spmd.inc"
126C-----------------------------------------------
127C C o m m o n B l o c k s
128C-----------------------------------------------
129#include "com01_c.inc"
130#include "scr16_c.inc"
131#include "param_c.inc"
132#include "task_c.inc"
133C-----------------------------------------------
134C D u m m y A r g u m e n t s
135C-----------------------------------------------
136 INTEGER IXC(NIXC,*),IXTG(NIXTG,*),DD_IAD(NSPMD+1,*) ,
137 . IPARG(NPARG,*),IPM(NPROPMI,*),WASZ(2),IGEO(NPROPGI,*),
138 , P0ARS(2),IUSER_FULL,J,WASZ_WR(2)
139
140C-----------------------------------------------
141C L o c a l V a r i a b l e s
142C-----------------------------------------------
143#ifdef MPI
144 INTEGER
145 . I,
146 . SZP0(2*NSPGROUP+2),RSZP0(2*NSPGROUP+2)
147 INTEGER IERROR
148
149
150 p0ars = 0
151 wasz = 0
152
153 CALL count_arsz_cs(iparg,ixc,ixtg,igeo,ipm,dd_iad,
154 . wasz,szp0)
155
156 iuser_full = 0
157 DO j=1,60
158 IF(outp_cs(26 + j) == 1) iuser_full = 1
159 ENDDO
160
161 IF ( outp_cs( 1) == 1.OR.outp_cs( 2) == 1.OR.outp_cs( 3) == 1
162 . .OR.outp_cs( 4) == 1.OR.outp_cs( 7) == 1.OR.outp_cs(25) == 1
163 . .OR.outp_cs(20) == 1.OR.outp_cs(21) == 1.OR.outp_cs(22) == 1
164 . .OR.outp_cs(23) == 1.OR.outp_cs(24) == 1.OR.outp_cs(26) == 1
165 . .OR.iuser_full == 1) THEN
166
167
168 CALL mpi_reduce(szp0,rszp0,2*nspgroup+2,
169 . mpi_integer,mpi_sum,it_spmd(1),
170 . spmd_comm_world,ierror )
171
172 IF (ispmd == 0) THEN
173 p0ars(1:2) = rszp0(2*nspgroup+1:2*nspgroup+2)
174 wasz_wr(1:2) = -1
175 DO i=1,nspgroup
176 wasz_wr(1) = max(wasz_wr(1),rszp0(i))
177 wasz_wr(2) = max(wasz_wr(2),rszp0(nspgroup+i))
178 ENDDO
179 wasz_wr(1) = wasz_wr(1)+6
180 wasz_wr(2) = wasz_wr(2)+6
181 ELSE
182 p0ars = 1
183 wasz_wr(:) = 1
184 ENDIF
185 ENDIF
186#endif
187 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:665

◆ 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 272 of file spmd_outp.F.

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

◆ 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 387 of file spmd_outp.F.

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

454C-----------------------------------------------
455C I m p l i c i t T y p e s
456C-----------------------------------------------
457 use element_mod , only : nixr
458 USE spmd_comm_world_mod, ONLY : spmd_comm_world
459#include "implicit_f.inc"
460C-----------------------------------------------
461C M P I I n c l u d e s
462C-----------------------------------------------
463#include "spmd.inc"
464C-----------------------------------------------
465C C o m m o n B l o c k s
466C-----------------------------------------------
467#include "param_c.inc"
468#include "com01_c.inc"
469#include "task_c.inc"
470#include "scr16_c.inc"
471C-----------------------------------------------
472C D u m m y A r g u m e n t s
473C-----------------------------------------------
474 INTEGER IPARG(NPARG,*),DD_IAD(NSPMD+1,*),WASZ,WASZP,
475 . IXR(NIXR,*),IGEO(NPROPGI,*),WASZ_WR
476 my_real
477 . geo(npropg,*)
478C-----------------------------------------------
479C L o c a l V a r i a b l e s
480C-----------------------------------------------
481#ifdef MPI
482 INTEGER SZP0(NSPGROUP+1), RSZP0(NSPGROUP+1),
483 . I
484
485 INTEGER IERROR
486C-----------------------------------------------
487
488 waszp = 0
489 wasz = 0
490 CALL count_arsz_rt(iparg,igeo,geo,ixr,dd_iad,wasz,szp0)
491
492 IF (outp_rs(2) == 1) THEN
493 CALL mpi_reduce(szp0,rszp0,nspgroup+1,
494 . mpi_integer,mpi_sum,it_spmd(1),
495 . spmd_comm_world,ierror )
496
497 IF (ispmd == 0) THEN
498 waszp=rszp0(nspgroup+1)
499 wasz_wr = -1
500 DO i=1,nspgroup
501 wasz_wr = max(wasz_wr,rszp0(i))
502 ENDDO
503 wasz_wr = wasz_wr + 6
504 ELSE
505 waszp = 1
506 wasz_wr = 1
507 END IF
508 ENDIF
509#endif
510 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:482

◆ 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 521 of file spmd_outp.F.

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

593C-----------------------------------------------
594C I m p l i c i t T y p e s
595C-----------------------------------------------
596 USE spmd_comm_world_mod, ONLY : spmd_comm_world
597#include "implicit_f.inc"
598C-----------------------------------------------
599C M P I I n c l u d e s
600C-----------------------------------------------
601#include "spmd.inc"
602C-----------------------------------------------
603C C o m m o n B l o c k s
604C-----------------------------------------------
605#include "param_c.inc"
606#include "com01_c.inc"
607#include "task_c.inc"
608#include "scr16_c.inc"
609C-----------------------------------------------
610C D u m m y A r g u m e n t s
611C-----------------------------------------------
612 INTEGER IPARG(NPARG,*),DD_IAD(NSPMD+1,*),WASZ,WASZP,WASZ_WR
613C-----------------------------------------------
614C L o c a l V a r i a b l e s
615C-----------------------------------------------
616#ifdef MPI
617 INTEGER SZP0(NSPGROUP+1), RSZP0(NSPGROUP+1),
618 . I
619
620 INTEGER IERROR
621C-----------------------------------------------
622 waszp = 0
623 wasz = 0
624 CALL count_arsz_spt(iparg,dd_iad,wasz,szp0)
625
626 IF (outp_spt( 1) == 1 ) THEN
627 CALL mpi_reduce(szp0,rszp0,nspgroup+1,
628 . mpi_integer,mpi_sum,it_spmd(1),
629 . spmd_comm_world,ierror )
630
631 IF (ispmd == 0) THEN
632 waszp=rszp0(nspgroup+1)
633 wasz_wr = -1
634 DO i=1,nspgroup
635 wasz_wr = max(wasz_wr,rszp0(i))
636 ENDDO
637 wasz_wr = wasz_wr + 6
638 ELSE
639 waszp = 1
640 wasz_wr = 1
641 END IF
642 ENDIF
643#endif
644 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 655 of file spmd_outp.F.

656C-----------------------------------------------
657C I m p l i c i t T y p e s
658C-----------------------------------------------
659 USE spmd_comm_world_mod, ONLY : spmd_comm_world
660#include "implicit_f.inc"
661C-----------------------------------------------
662C M P I I n c l u d e s
663C-----------------------------------------------
664#include "spmd.inc"
665C-----------------------------------------------
666C C o m m o n B l o c k s
667C-----------------------------------------------
668#include "param_c.inc"
669#include "com01_c.inc"
670#include "task_c.inc"
671#include "scr16_c.inc"
672C-----------------------------------------------
673C D u m m y A r g u m e n t s
674C-----------------------------------------------
675 INTEGER IPARG(NPARG,*),DD_IAD(NSPMD+1,*),WASZ,WASZP,WASZ_WR
676C-----------------------------------------------
677C L o c a l V a r i a b l e s
678C-----------------------------------------------
679#ifdef MPI
680 INTEGER SZP0(NSPGROUP+1), RSZP0(NSPGROUP+1),
681 . I
682
683 INTEGER IERROR
684C-----------------------------------------------
685 waszp = 0
686 wasz = 0
687 CALL count_arsz_sptt(iparg,dd_iad,wasz,szp0)
688
689 IF (outp_spt( 1) == 1 ) THEN
690
691 CALL mpi_reduce(szp0,rszp0,nspgroup+1,
692 . mpi_integer,mpi_sum,it_spmd(1),
693 . spmd_comm_world,ierror )
694
695 IF (ispmd /= 0) THEN
696 waszp = 1
697 wasz_wr = 1
698 ELSE
699 wasz_wr = -1
700 DO i=1,nspgroup
701 wasz_wr = max(wasz_wr,rszp0(i))
702 ENDDO
703 waszp = rszp0(nspgroup+1)
704 END IF
705 ENDIF
706#endif
707 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 36 of file spmd_outp.F.

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

◆ 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 200 of file spmd_outp.F.

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

◆ spmd_doutp_gath()

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

Definition at line 831 of file spmd_outp.F.

832C-----------------------------------------------
833C I m p l i c i t T y p e s
834C-----------------------------------------------
835 USE spmd_comm_world_mod, ONLY : spmd_comm_world
836#include "implicit_f.inc"
837#include "spmd.inc"
838C-----------------------------------------------
839C C o m m o n B l o c k s
840C-----------------------------------------------
841#include "com01_c.inc"
842#include "com04_c.inc"
843#include "task_c.inc"
844#include "spmd_c.inc"
845C-----------------------------------------------
846C D u m m y A r g u m e n t s
847C-----------------------------------------------
848 my_real
849 . v(*),vgath(*)
850 INTEGER WEIGHT(*), NODGLOB(*)
851C-----------------------------------------------
852C L O C A L V A R I A B L E S
853C-----------------------------------------------
854#ifdef MPI
855 INTEGER STATUS(MPI_STATUS_SIZE),IERROR,MSGOFF
856 INTEGER SIZ,MSGTYP,I,K,NG,NREC,MSGOFF2
857
858 DATA msgoff/9003/
859 DATA msgoff2/9004/
860 my_real
861 . bufsr(numnodm)
862 INTEGER IBUF(NUMNODM)
863C Table used by Pro 0
864
865 IF (ispmd/=0) THEN
866
867 siz = 0
868 DO i=1,numnod
869 IF (weight(i) == 1) THEN
870 siz = siz + 1
871 ibuf(siz) = nodglob(i)
872 bufsr(siz) = v(i)
873 END IF
874 END DO
875
876C Because of the simple precision version, we cannot put the integer
877C In the floating buffer because there are only 2 24 bits available ~ 16 million
878C of nodes at most
879
880 msgtyp = msgoff2
881 CALL mpi_send(ibuf,siz,mpi_integer,it_spmd(1),msgtyp,
882 . spmd_comm_world,ierror)
883
884 msgtyp = msgoff
885 CALL mpi_send(bufsr,siz,real,it_spmd(1),msgtyp,
886 . spmd_comm_world,ierror)
887
888 ELSE
889
890 DO i=1,numnod
891 IF (weight(i) == 1) THEN
892 ng = nodglob(i)
893 vgath(ng) = v(i)
894 ENDIF
895 ENDDO
896
897 DO i=2,nspmd
898
899C Reception of the entire buffer of NODGLOB addresses
900 msgtyp = msgoff2
901
902 CALL mpi_probe(it_spmd(i),msgtyp,
903 . spmd_comm_world,status,ierror)
904 CALL mpi_get_count(status,mpi_integer,siz,ierror)
905
906 CALL mpi_recv(ibuf,siz,mpi_integer,it_spmd(i),msgtyp,
907 . spmd_comm_world,status,ierror)
908
909C Reception of the double floating buffer of NODGLOB addresses
910
911 msgtyp = msgoff
912 CALL mpi_recv(bufsr,siz,real,it_spmd(i),msgtyp,
913 . spmd_comm_world,status,ierror)
914
915 nrec = siz
916 DO k = 1, nrec
917 ng = ibuf(k)
918 vgath(ng) = bufsr(k)
919 ENDDO
920 ENDDO
921
922
923 ENDIF
924
925#endif
926 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 717 of file spmd_outp.F.

718C-----------------------------------------------
719C I m p l i c i t T y p e s
720C-----------------------------------------------
721 USE spmd_comm_world_mod, ONLY : spmd_comm_world
722#include "implicit_f.inc"
723#include "spmd.inc"
724C-----------------------------------------------
725C C o m m o n B l o c k s
726C-----------------------------------------------
727#include "com01_c.inc"
728#include "com04_c.inc"
729#include "task_c.inc"
730#include "spmd_c.inc"
731C-----------------------------------------------
732C D u m m y A r g u m e n t s
733C-----------------------------------------------
734 my_real
735 . v(3,*),vgath(3,*)
736 INTEGER WEIGHT(*), NODGLOB(*)
737C-----------------------------------------------
738C L O C A L V A R I A B L E S
739C-----------------------------------------------
740#ifdef MPI
741 INTEGER STATUS(MPI_STATUS_SIZE),IERROR,MSGOFF
742 INTEGER SIZ,MSGTYP,I,K,NG,NREC,MSGOFF2
743
744 DATA msgoff/9001/
745 DATA msgoff2/9002/
746 my_real
747 . bufsr(3,numnodm)
748 INTEGER IBUF(NUMNODM)
749C Table used by Pro 0
750
751 IF (ispmd/=0) THEN
752
753 siz = 0
754 DO i=1,numnod
755 IF (weight(i) == 1) THEN
756 siz = siz + 1
757 ibuf(siz) = nodglob(i)
758 bufsr(1,siz) = v(1,i)
759 bufsr(2,siz) = v(2,i)
760 bufsr(3,siz) = v(3,i)
761 END IF
762 END DO
763
764C Because of the simple precision version, we cannot put the integer
765C In the floating buffer because there are only 2 24 bits available ~ 16 million
766C of nodes at most
767
768 msgtyp = msgoff2
769 CALL mpi_send(ibuf,siz,mpi_integer,it_spmd(1),msgtyp,
770 . spmd_comm_world,ierror)
771
772 msgtyp = msgoff
773 CALL mpi_send(bufsr,3*siz,real,it_spmd(1),msgtyp,
774 . spmd_comm_world,ierror)
775
776
777 ELSE
778
779 DO i=1,numnod
780 IF (weight(i) == 1) THEN
781 ng = nodglob(i)
782 vgath(1,ng) = v(1,i)
783 vgath(2,ng) = v(2,i)
784 vgath(3,ng) = v(3,i)
785 ENDIF
786 ENDDO
787
788
789 DO i=2,nspmd
790
791C Reception of the entire buffer of NODGLOB addresses
792 msgtyp = msgoff2
793
794 CALL mpi_probe(it_spmd(i),msgtyp,
795 . spmd_comm_world,status,ierror)
796 CALL mpi_get_count(status,mpi_integer,siz,ierror)
797
798 CALL mpi_recv(ibuf,siz,mpi_integer,it_spmd(i),msgtyp,
799 . spmd_comm_world,status,ierror)
800
801C Reception of the double floating buffer of NODGLOB addresses
802
803 msgtyp = msgoff
804 CALL mpi_recv(bufsr,3*siz,real,it_spmd(i),msgtyp,
805 . spmd_comm_world,status,ierror)
806
807 nrec = siz
808 DO k = 1, nrec
809 ng = ibuf(k)
810 vgath(1,ng) = bufsr(1,k)
811 vgath(2,ng) = bufsr(2,k)
812 vgath(3,ng) = bufsr(3,k)
813 ENDDO
814 ENDDO
815
816
817 ENDIF
818
819#endif
820 RETURN

◆ spmd_outpitab()

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

Definition at line 1080 of file spmd_outp.F.

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

◆ spmd_rgather9()

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

Definition at line 936 of file spmd_outp.F.

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

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

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