OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_outp.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
26!||====================================================================
27!|| outp_arsz_ss ../engine/source/mpi/interfaces/spmd_outp.F
28!||--- called by ------------------------------------------------------
29!|| genoutp ../engine/source/output/sty/genoutp.F
30!||--- calls -----------------------------------------------------
31!|| count_arsz_ss ../engine/source/output/sty/outp_s_s.F
32!||--- uses -----------------------------------------------------
33!|| element_mod ../common_source/modules/elements/element_mod.F90
34!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
35!||====================================================================
36 SUBROUTINE outp_arsz_ss(IPARG,DD_IAD,IPM,IXS,P0ARS,WASZ,WASZ_WR)
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
101 END
102
103
104!||====================================================================
105!|| outp_arsz_cs ../engine/source/mpi/interfaces/spmd_outp.F
106!||--- called by ------------------------------------------------------
107!|| genoutp ../engine/source/output/sty/genoutp.F
108!||--- calls -----------------------------------------------------
109!|| count_arsz_cs ../engine/source/output/sty/outp_c_s.F
110!||--- uses -----------------------------------------------------
111!|| element_mod ../common_source/modules/elements/element_mod.F90
112!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
113!||====================================================================
114 SUBROUTINE outp_arsz_cs(IPARG,IXC,IXTG,IGEO,IPM,DD_IAD,
115 . P0ARS,WASZ,WASZ_WR)
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
188 END
189c
190!||====================================================================
191!|| outp_arsz_st ../engine/source/mpi/interfaces/spmd_outp.F
192!||--- called by ------------------------------------------------------
193!|| genoutp ../engine/source/output/sty/genoutp.F
194!||--- calls -----------------------------------------------------
195!|| count_arsz_st ../engine/source/output/sty/outp_s_t.F
196!||--- uses -----------------------------------------------------
197!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
198!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.f90
199!||====================================================================
200 SUBROUTINE outp_arsz_st(IPARG,DD_IAD,WASZ,WASZ_WR,P0ARS)
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
259 END
260
261
262!||====================================================================
263!|| outp_arsz_ct ../engine/source/mpi/interfaces/spmd_outp.F
264!||--- called by ------------------------------------------------------
265!|| genoutp ../engine/source/output/sty/genoutp.F
266!||--- calls -----------------------------------------------------
267!|| count_arsz_ct ../engine/source/output/sty/outp_c_t.F
268!||--- uses -----------------------------------------------------
269!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
270!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
271!||====================================================================
272 SUBROUTINE outp_arsz_ct(IPARG,DD_IAD,WASZ,WASZP,WASZ_WR,ELBUF_TAB)
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
375 END
376
377
378!||====================================================================
379!|| outp_arsz_rs ../engine/source/mpi/interfaces/spmd_outp.F
380!||--- called by ------------------------------------------------------
381!|| genoutp ../engine/source/output/sty/genoutp.F
382!||--- calls -----------------------------------------------------
383!|| count_arsz_rs ../engine/source/output/sty/outp_r_s.F
384!||--- uses -----------------------------------------------------
385!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
386!||====================================================================
387 SUBROUTINE outp_arsz_rs(IPARG,DD_IAD,WASZ,WASZP,WASZ_WR)
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
442 END
443!||====================================================================
444!|| outp_arsz_rt ../engine/source/mpi/interfaces/spmd_outp.F
445!||--- called by ------------------------------------------------------
446!|| genoutp ../engine/source/output/sty/genoutp.F
447!||--- calls -----------------------------------------------------
448!|| count_arsz_rt ../engine/source/output/sty/outp_r_t.F
449!||--- uses -----------------------------------------------------
450!|| element_mod ../common_source/modules/elements/element_mod.f90
451!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
452!||====================================================================
453 SUBROUTINE outp_arsz_rt(IPARG,IGEO,GEO,IXR,DD_IAD,WASZ,WASZP,WASZ_WR)
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
511 END
512!||====================================================================
513!|| outp_arsz_sps ../engine/source/mpi/interfaces/spmd_outp.F
514!||--- called by ------------------------------------------------------
515!|| genoutp ../engine/source/output/sty/genoutp.F
516!||--- calls -----------------------------------------------------
517!|| count_arsz_sps ../engine/source/output/sty/outp_sp_s.F
518!||--- uses -----------------------------------------------------
519!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
520!||====================================================================
521 SUBROUTINE outp_arsz_sps(IPARG,DD_IAD,WASZ,WASZP,WASZ_WR)
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
582 END
583!||====================================================================
584!|| outp_arsz_spt ../engine/source/mpi/interfaces/spmd_outp.F
585!||--- called by ------------------------------------------------------
586!|| genoutp ../engine/source/output/sty/genoutp.F
587!||--- calls -----------------------------------------------------
588!|| count_arsz_spt ../engine/source/output/sty/outp_sp_t.F
589!||--- uses -----------------------------------------------------
590!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
591!||====================================================================
592 SUBROUTINE outp_arsz_spt(IPARG,DD_IAD,WASZ,WASZP,WASZ_WR)
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
645 END
646!||====================================================================
647!|| outp_arsz_sptt ../engine/source/mpi/interfaces/spmd_outp.F
648!||--- called by ------------------------------------------------------
649!|| genoutp ../engine/source/output/sty/genoutp.F
650!||--- calls -----------------------------------------------------
651!|| count_arsz_sptt ../engine/source/output/sty/outp_sp_t.F
652!||--- uses -----------------------------------------------------
653!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
654!||====================================================================
655 SUBROUTINE outp_arsz_sptt(IPARG,DD_IAD,WASZ,WASZP,WASZ_WR)
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
708 END
709!||====================================================================
710!|| spmd_doutp_vgath ../engine/source/mpi/interfaces/spmd_outp.F
711!||--- called by ------------------------------------------------------
712!|| outp_n_v ../engine/source/output/sty/outp_n_v.F
713!||--- calls -----------------------------------------------------
714!||--- uses -----------------------------------------------------
715!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
716!||====================================================================
717 SUBROUTINE spmd_doutp_vgath(V,NODGLOB,WEIGHT,VGATH)
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
821 END
822
823!||====================================================================
824!|| spmd_doutp_gath ../engine/source/mpi/interfaces/spmd_outp.F
825!||--- called by ------------------------------------------------------
826!|| outp_no ../engine/source/output/sty/outp_no.F
827!||--- calls -----------------------------------------------------
828!||--- uses -----------------------------------------------------
829!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
830!||====================================================================
831 SUBROUTINE spmd_doutp_gath(V,NODGLOB,WEIGHT,VGATH)
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
927 END
928
929
930!||====================================================================
931!|| spmd_rgather9 ../engine/source/mpi/interfaces/spmd_outp.F
932!||--- calls -----------------------------------------------------
933!||--- uses -----------------------------------------------------
934!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
935!||====================================================================
936 SUBROUTINE spmd_rgather9(V,LEN,VP0,LENP0,IAD)
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
983 END
984
985
986!||====================================================================
987!|| spmd_rgather9_dp ../engine/source/mpi/interfaces/spmd_outp.F
988!||--- called by ------------------------------------------------------
989!|| dynain_c_strag ../engine/source/output/dynain/dynain_c_strag.F
990!|| dynain_c_strsg ../engine/source/output/dynain/dynain_c_strsg.F
991!|| dynain_shel_spmd ../engine/source/output/dynain/dynain_shel_spmd.F
992!|| stat_c_auxf ../engine/source/output/sta/stat_c_auxf.F
993!|| stat_c_epspf ../engine/source/output/sta/stat_c_epspf.F
994!|| stat_c_fail ../engine/source/output/sta/stat_c_fail.F
995!|| stat_c_off ../engine/source/output/sta/stat_c_off.F
996!|| stat_c_orth_loc ../engine/source/output/sta/stat_c_orth_loc.f
997!|| stat_c_straf ../engine/source/output/sta/stat_c_straf.F
998!|| stat_c_strafg ../engine/source/output/sta/stat_c_strafg.F
999!|| stat_c_strsf ../engine/source/output/sta/stat_c_strsf.F
1000!|| stat_c_strsfg ../engine/source/output/sta/stat_c_strsfg.F
1001!|| stat_c_thk ../engine/source/output/sta/stat_c_thk.F
1002!|| stat_p_aux ../engine/source/output/sta/stat_p_aux.F
1003!|| stat_p_full ../engine/source/output/sta/stat_p_full.F
1004!|| stat_r_full ../engine/source/output/sta/stat_r_full.F
1005!|| stat_s_auxf ../engine/source/output/sta/stat_s_auxf.F
1006!|| stat_s_eref ../engine/source/output/sta/stat_s_eref.F
1007!|| stat_s_fail ../engine/source/output/sta/stat_s_fail.F
1008!|| stat_s_ortho ../engine/source/output/sta/stat_s_ortho.F
1009!|| stat_s_straf ../engine/source/output/sta/stat_s_straf.F
1010!|| stat_s_strsf ../engine/source/output/sta/stat_s_strsf.F
1011!|| stat_shel_spmd ../engine/source/output/sta/stat_shel_spmd.F
1012!|| stat_sphcel_full ../engine/source/output/sta/stat_sphcel_full.F90
1013!|| stat_t_full ../engine/source/output/sta/stat_t_full.F
1014!||--- calls -----------------------------------------------------
1015!||--- uses -----------------------------------------------------
1016!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
1017!||====================================================================
1018 SUBROUTINE spmd_rgather9_dp(V,LEN,VP0,LENP0,IAD)
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
1066 END
1067
1068!||====================================================================
1069!|| spmd_outpitab ../engine/source/mpi/interfaces/spmd_outp.F
1070!||--- called by ------------------------------------------------------
1071!|| gendynain ../engine/source/output/dynain/gendynain.F
1072!|| genh3d ../engine/source/output/h3d/h3d_results/genh3d.F
1073!|| genoutp ../engine/source/output/sty/genoutp.F
1074!|| genstat ../engine/source/output/sta/genstat.F
1075!|| spmd_vgath_err ../engine/source/mpi/anim/spmd_vgath_err.F
1076!||--- calls -----------------------------------------------------
1077!||--- uses -----------------------------------------------------
1078!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.f90
1079!||====================================================================
1080 SUBROUTINE spmd_outpitab(V,WEIGHT,NODGLOB,VGLOB)
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
1161 END
1162!||====================================================================
1163!|| spmd_rgather9_1comm ../engine/source/mpi/interfaces/spmd_outp.F
1164!||--- called by ------------------------------------------------------
1165!|| outp_c_s ../engine/source/output/sty/outp_c_s.F
1166!|| outp_c_t ../engine/source/output/sty/outp_c_t.F
1167!|| outp_c_tf ../engine/source/output/sty/outp_c_t.F
1168!|| outp_r_s ../engine/source/output/sty/outp_r_s.F
1169!|| outp_r_t ../engine/source/output/sty/outp_r_t.F
1170!|| outp_s_s ../engine/source/output/sty/outp_s_s.F
1171!|| outp_s_t ../engine/source/output/sty/outp_s_t.F
1172!|| outp_s_tt ../engine/source/output/sty/outp_s_t.F
1173!|| outp_sp_s ../engine/source/output/sty/outp_sp_s.F
1174!|| outp_sp_t ../engine/source/output/sty/outp_sp_t.F
1175!|| outp_sp_tt ../engine/source/output/sty/outp_sp_t.F
1176!||--- calls -----------------------------------------------------
1177!||--- uses -----------------------------------------------------
1178!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
1179!||====================================================================
1180 SUBROUTINE spmd_rgather9_1comm(V,SIZV,LEN,VP0,SIZV0,ADRESS)
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
1241 END
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21
mpi_recv
subroutine mpi_recv(buf, cnt, datatype, source, tag, comm, status, ierr)
Definition mpi.f:461
mpi_reduce
subroutine mpi_reduce(sendbuf, recvbuf, cnt, datatype, op, root, comm, ierr)
Definition mpi.f:120
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
count_arsz_cs
subroutine count_arsz_cs(iparg, ixc, ixtg, igeo, ipm, dd_iad, wasz, siz_write_loc)
Definition outp_c_s.F:665
count_arsz_ct
subroutine count_arsz_ct(iparg, dd_iad, wasz, siz_write, elbuf_tab)
Definition outp_c_t.F:958
count_arsz_rs
subroutine count_arsz_rs(iparg, dd_iad, wasz, siz_write_loc)
Definition outp_r_s.F:175
count_arsz_rt
subroutine count_arsz_rt(iparg, igeo, geo, ixr, dd_iad, wasz, siz_write_loc)
Definition outp_r_t.F:482
count_arsz_ss
subroutine count_arsz_ss(iparg, dd_iad, ipm, ixs, wasz, siz_write_loc)
Definition outp_s_s.F:401
count_arsz_st
subroutine count_arsz_st(iparg, dd_iad, wasz, szp0)
Definition outp_s_t.F:1018
count_arsz_sps
subroutine count_arsz_sps(iparg, dd_iad, wasz, siz_write_loc)
Definition outp_sp_s.F:254
count_arsz_sptt
subroutine count_arsz_sptt(iparg, dd_iad, wasz, siz_write_loc)
Definition outp_sp_t.F:415
count_arsz_spt
subroutine count_arsz_spt(iparg, dd_iad, wasz, siz_write_loc)
Definition outp_sp_t.F:362
outp_arsz_ct
subroutine outp_arsz_ct(iparg, dd_iad, wasz, waszp, wasz_wr, elbuf_tab)
Definition spmd_outp.F:273
outp_arsz_sps
subroutine outp_arsz_sps(iparg, dd_iad, wasz, waszp, wasz_wr)
Definition spmd_outp.F:522
outp_arsz_rs
subroutine outp_arsz_rs(iparg, dd_iad, wasz, waszp, wasz_wr)
Definition spmd_outp.F:388
outp_arsz_rt
subroutine outp_arsz_rt(iparg, igeo, geo, ixr, dd_iad, wasz, waszp, wasz_wr)
Definition spmd_outp.F:454
outp_arsz_spt
subroutine outp_arsz_spt(iparg, dd_iad, wasz, waszp, wasz_wr)
Definition spmd_outp.F:593
outp_arsz_cs
subroutine outp_arsz_cs(iparg, ixc, ixtg, igeo, ipm, dd_iad, p0ars, wasz, wasz_wr)
Definition spmd_outp.F:116
spmd_outpitab
subroutine spmd_outpitab(v, weight, nodglob, vglob)
Definition spmd_outp.F:1081
spmd_doutp_gath
subroutine spmd_doutp_gath(v, nodglob, weight, vgath)
Definition spmd_outp.F:832
outp_arsz_ss
subroutine outp_arsz_ss(iparg, dd_iad, ipm, ixs, p0ars, wasz, wasz_wr)
Definition spmd_outp.F:37
spmd_rgather9_1comm
subroutine spmd_rgather9_1comm(v, sizv, len, vp0, sizv0, adress)
Definition spmd_outp.F:1181
spmd_rgather9
subroutine spmd_rgather9(v, len, vp0, lenp0, iad)
Definition spmd_outp.F:937
spmd_doutp_vgath
subroutine spmd_doutp_vgath(v, nodglob, weight, vgath)
Definition spmd_outp.F:718
outp_arsz_st
subroutine outp_arsz_st(iparg, dd_iad, wasz, wasz_wr, p0ars)
Definition spmd_outp.F:201
spmd_rgather9_dp
subroutine spmd_rgather9_dp(v, len, vp0, lenp0, iad)
Definition spmd_outp.F:1019
outp_arsz_sptt
subroutine outp_arsz_sptt(iparg, dd_iad, wasz, waszp, wasz_wr)
Definition spmd_outp.F:656
stat_c_orth_loc
subroutine stat_c_orth_loc(elbuf_tab, iparg, ipm, igeo, ixc, ixtg, wa, wap0, ipartc, iparttg, ipart_state, stat_indxc, stat_indxtg, x, idel, sizp0)
Definition stat_c_orth_loc.F:41