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!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
34!||====================================================================
35 SUBROUTINE outp_arsz_ss(IPARG,DD_IAD,IPM,IXS,P0ARS,WASZ,WASZ_WR)
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
99 END
100
101
102!||====================================================================
103!|| outp_arsz_cs ../engine/source/mpi/interfaces/spmd_outp.f
104!||--- called by ------------------------------------------------------
105!|| genoutp ../engine/source/output/sty/genoutp.f
106!||--- calls -----------------------------------------------------
107!|| count_arsz_cs ../engine/source/output/sty/outp_c_s.F
108!||--- uses -----------------------------------------------------
109!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
110!||====================================================================
111 SUBROUTINE outp_arsz_cs(IPARG,IXC,IXTG,IGEO,IPM,DD_IAD,
112 . P0ARS,WASZ,WASZ_WR)
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
184 END
185c
186!||====================================================================
187!|| outp_arsz_st ../engine/source/mpi/interfaces/spmd_outp.F
188!||--- called by ------------------------------------------------------
189!|| genoutp ../engine/source/output/sty/genoutp.F
190!||--- calls -----------------------------------------------------
191!|| count_arsz_st ../engine/source/output/sty/outp_s_t.F
192!||--- uses -----------------------------------------------------
193!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
194!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.f90
195!||====================================================================
196 SUBROUTINE outp_arsz_st(IPARG,DD_IAD,WASZ,WASZ_WR,P0ARS)
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
255 END
256
257
258!||====================================================================
259!|| outp_arsz_ct ../engine/source/mpi/interfaces/spmd_outp.F
260!||--- called by ------------------------------------------------------
261!|| genoutp ../engine/source/output/sty/genoutp.f
262!||--- calls -----------------------------------------------------
263!|| count_arsz_ct ../engine/source/output/sty/outp_c_t.F
264!||--- uses -----------------------------------------------------
265!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
266!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
267!||====================================================================
268 SUBROUTINE outp_arsz_ct(IPARG,DD_IAD,WASZ,WASZP,WASZ_WR,ELBUF_TAB)
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
373 END
374
375
376!||====================================================================
377!|| outp_arsz_rs ../engine/source/mpi/interfaces/spmd_outp.F
378!||--- called by ------------------------------------------------------
379!|| genoutp ../engine/source/output/sty/genoutp.F
380!||--- calls -----------------------------------------------------
381!|| count_arsz_rs ../engine/source/output/sty/outp_r_s.F
382!||--- uses -----------------------------------------------------
383!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
384!||====================================================================
385 SUBROUTINE outp_arsz_rs(IPARG,DD_IAD,WASZ,WASZP,WASZ_WR)
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
440 END
441!||====================================================================
442!|| outp_arsz_rt ../engine/source/mpi/interfaces/spmd_outp.f
443!||--- called by ------------------------------------------------------
444!|| genoutp ../engine/source/output/sty/genoutp.F
445!||--- calls -----------------------------------------------------
446!|| count_arsz_rt ../engine/source/output/sty/outp_r_t.F
447!||--- uses -----------------------------------------------------
448!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
449!||====================================================================
450 SUBROUTINE outp_arsz_rt(IPARG,IGEO,GEO,IXR,DD_IAD,WASZ,WASZP,WASZ_WR)
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
507 END
508!||====================================================================
509!|| outp_arsz_sps ../engine/source/mpi/interfaces/spmd_outp.F
510!||--- called by ------------------------------------------------------
511!|| genoutp ../engine/source/output/sty/genoutp.f
512!||--- calls -----------------------------------------------------
513!|| count_arsz_sps ../engine/source/output/sty/outp_sp_s.F
514!||--- uses -----------------------------------------------------
515!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.f90
516!||====================================================================
517 SUBROUTINE outp_arsz_sps(IPARG,DD_IAD,WASZ,WASZP,WASZ_WR)
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
578 END
579!||====================================================================
580!|| outp_arsz_spt ../engine/source/mpi/interfaces/spmd_outp.F
581!||--- called by ------------------------------------------------------
582!|| genoutp ../engine/source/output/sty/genoutp.F
583!||--- calls -----------------------------------------------------
584!|| count_arsz_spt ../engine/source/output/sty/outp_sp_t.F
585!||--- uses -----------------------------------------------------
586!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
587!||====================================================================
588 SUBROUTINE outp_arsz_spt(IPARG,DD_IAD,WASZ,WASZP,WASZ_WR)
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
641 END
642!||====================================================================
643!|| outp_arsz_sptt ../engine/source/mpi/interfaces/spmd_outp.F
644!||--- called by ------------------------------------------------------
645!|| genoutp ../engine/source/output/sty/genoutp.F
646!||--- calls -----------------------------------------------------
647!|| count_arsz_sptt ../engine/source/output/sty/outp_sp_t.F
648!||--- uses -----------------------------------------------------
649!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
650!||====================================================================
651 SUBROUTINE outp_arsz_sptt(IPARG,DD_IAD,WASZ,WASZP,WASZ_WR)
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
704 END
705!||====================================================================
706!|| spmd_doutp_vgath ../engine/source/mpi/interfaces/spmd_outp.F
707!||--- called by ------------------------------------------------------
708!|| outp_n_v ../engine/source/output/sty/outp_n_v.F
709!||--- calls -----------------------------------------------------
710!||--- uses -----------------------------------------------------
711!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
712!||====================================================================
713 SUBROUTINE spmd_doutp_vgath(V,NODGLOB,WEIGHT,VGATH)
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
817 END
818
819!||====================================================================
820!|| spmd_doutp_gath ../engine/source/mpi/interfaces/spmd_outp.F
821!||--- called by ------------------------------------------------------
822!|| outp_no ../engine/source/output/sty/outp_no.F
823!||--- calls -----------------------------------------------------
824!||--- uses -----------------------------------------------------
825!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
826!||====================================================================
827 SUBROUTINE spmd_doutp_gath(V,NODGLOB,WEIGHT,VGATH)
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
923 END
924
925
926!||====================================================================
927!|| spmd_rgather9 ../engine/source/mpi/interfaces/spmd_outp.F
928!||--- calls -----------------------------------------------------
929!||--- uses -----------------------------------------------------
930!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
931!||====================================================================
932 SUBROUTINE spmd_rgather9(V,LEN,VP0,LENP0,IAD)
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
979 END
980
981
982!||====================================================================
983!|| spmd_rgather9_dp ../engine/source/mpi/interfaces/spmd_outp.F
984!||--- called by ------------------------------------------------------
985!|| dynain_c_strag ../engine/source/output/dynain/dynain_c_strag.F
986!|| dynain_c_strsg ../engine/source/output/dynain/dynain_c_strsg.F
987!|| dynain_shel_spmd ../engine/source/output/dynain/dynain_shel_spmd.F
988!|| stat_c_auxf ../engine/source/output/sta/stat_c_auxf.F
989!|| stat_c_epspf ../engine/source/output/sta/stat_c_epspf.f
990!|| stat_c_fail ../engine/source/output/sta/stat_c_fail.f
991!|| stat_c_off ../engine/source/output/sta/stat_c_off.F
992!|| stat_c_orth_loc ../engine/source/output/sta/stat_c_orth_loc.F
993!|| stat_c_straf ../engine/source/output/sta/stat_c_straf.F
994!|| stat_c_strafg ../engine/source/output/sta/stat_c_strafg.F
995!|| stat_c_strsf ../engine/source/output/sta/stat_c_strsf.F
996!|| stat_c_strsfg ../engine/source/output/sta/stat_c_strsfg.F
997!|| stat_c_thk ../engine/source/output/sta/stat_c_thk.F
998!|| stat_p_aux ../engine/source/output/sta/stat_p_aux.f
999!|| stat_p_full ../engine/source/output/sta/stat_p_full.F
1000!|| stat_r_full ../engine/source/output/sta/stat_r_full.F
1001!|| stat_s_auxf ../engine/source/output/sta/stat_s_auxf.f
1002!|| stat_s_eref ../engine/source/output/sta/stat_s_eref.F
1003!|| stat_s_fail ../engine/source/output/sta/stat_s_fail.F
1004!|| stat_s_ortho ../engine/source/output/sta/stat_s_ortho.F
1005!|| stat_s_straf ../engine/source/output/sta/stat_s_straf.f
1006!|| stat_s_strsf ../engine/source/output/sta/stat_s_strsf.F
1007!|| stat_shel_spmd ../engine/source/output/sta/stat_shel_spmd.F
1008!|| stat_sphcel_full ../engine/source/output/sta/stat_sphcel_full.F90
1009!|| stat_t_full ../engine/source/output/sta/stat_t_full.F
1010!||--- calls -----------------------------------------------------
1011!||--- uses -----------------------------------------------------
1012!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
1013!||====================================================================
1014 SUBROUTINE spmd_rgather9_dp(V,LEN,VP0,LENP0,IAD)
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
1062 END
1063
1064!||====================================================================
1065!|| spmd_outpitab ../engine/source/mpi/interfaces/spmd_outp.F
1066!||--- called by ------------------------------------------------------
1067!|| gendynain ../engine/source/output/dynain/gendynain.F
1068!|| genh3d ../engine/source/output/h3d/h3d_results/genh3d.F
1069!|| genoutp ../engine/source/output/sty/genoutp.F
1070!|| genstat ../engine/source/output/sta/genstat.F
1071!|| spmd_vgath_err ../engine/source/mpi/anim/spmd_vgath_err.f
1072!||--- calls -----------------------------------------------------
1073!||--- uses -----------------------------------------------------
1074!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.f90
1075!||====================================================================
1076 SUBROUTINE spmd_outpitab(V,WEIGHT,NODGLOB,VGLOB)
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
1157 END
1158!||====================================================================
1159!|| spmd_rgather9_1comm ../engine/source/mpi/interfaces/spmd_outp.F
1160!||--- called by ------------------------------------------------------
1161!|| outp_c_s ../engine/source/output/sty/outp_c_s.F
1162!|| outp_c_t ../engine/source/output/sty/outp_c_t.F
1163!|| outp_c_tf ../engine/source/output/sty/outp_c_t.F
1164!|| outp_r_s ../engine/source/output/sty/outp_r_s.F
1165!|| outp_r_t ../engine/source/output/sty/outp_r_t.F
1166!|| outp_s_s ../engine/source/output/sty/outp_s_s.F
1167!|| outp_s_t ../engine/source/output/sty/outp_s_t.F
1168!|| outp_s_tt ../engine/source/output/sty/outp_s_t.f
1169!|| outp_sp_s ../engine/source/output/sty/outp_sp_s.F
1170!|| outp_sp_t ../engine/source/output/sty/outp_sp_t.F
1171!|| outp_sp_tt ../engine/source/output/sty/outp_sp_t.F
1172!||--- calls -----------------------------------------------------
1173!||--- uses -----------------------------------------------------
1174!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.f90
1175!||====================================================================
1176 SUBROUTINE spmd_rgather9_1comm(V,SIZV,LEN,VP0,SIZV0,ADRESS)
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
1237 END
my_real
#define my_real
Definition cppsort.cpp:32
genoutp
subroutine genoutp(x, d, v, a, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, iparg, pm, igeo, ms, cont, itab, partsav, fint, fext, tani, eani, anin, ipart, vr, elbuf_tab, dd_iad, weight, ipm, kxsp, spbuf, nodglob, leng, fopt, nom_opt, npby, fncont, ftcont, geo, thke, stack, drape_sh4n, drape_sh3n, drapeg, output)
Definition genoutp.F:82
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:661
count_arsz_ct
subroutine count_arsz_ct(iparg, dd_iad, wasz, siz_write, elbuf_tab)
Definition outp_c_t.F:956
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:478
count_arsz_ss
subroutine count_arsz_ss(iparg, dd_iad, ipm, ixs, wasz, siz_write_loc)
Definition outp_s_s.F:397
outp_s_tt
subroutine outp_s_tt(nbx, key, text, elbuf_tab, iparg, dd_iad, ipm, ixs, sizloc, sizp0, siz_wr)
Definition outp_s_t.F:196
count_arsz_st
subroutine count_arsz_st(iparg, dd_iad, wasz, szp0)
Definition outp_s_t.F:1016
outp_s_t
subroutine outp_s_t(nbx, key, text, elbuf_tab, iparg, dd_iad, sizloc, sizp0, siz_wr)
Definition outp_s_t.F:36
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:269
outp_arsz_sps
subroutine outp_arsz_sps(iparg, dd_iad, wasz, waszp, wasz_wr)
Definition spmd_outp.F:518
outp_arsz_rs
subroutine outp_arsz_rs(iparg, dd_iad, wasz, waszp, wasz_wr)
Definition spmd_outp.F:386
outp_arsz_rt
subroutine outp_arsz_rt(iparg, igeo, geo, ixr, dd_iad, wasz, waszp, wasz_wr)
Definition spmd_outp.F:451
outp_arsz_spt
subroutine outp_arsz_spt(iparg, dd_iad, wasz, waszp, wasz_wr)
Definition spmd_outp.F:589
outp_arsz_cs
subroutine outp_arsz_cs(iparg, ixc, ixtg, igeo, ipm, dd_iad, p0ars, wasz, wasz_wr)
Definition spmd_outp.F:113
spmd_outpitab
subroutine spmd_outpitab(v, weight, nodglob, vglob)
Definition spmd_outp.F:1077
spmd_doutp_gath
subroutine spmd_doutp_gath(v, nodglob, weight, vgath)
Definition spmd_outp.F:828
outp_arsz_ss
subroutine outp_arsz_ss(iparg, dd_iad, ipm, ixs, p0ars, wasz, wasz_wr)
Definition spmd_outp.F:36
spmd_rgather9_1comm
subroutine spmd_rgather9_1comm(v, sizv, len, vp0, sizv0, adress)
Definition spmd_outp.F:1177
spmd_rgather9
subroutine spmd_rgather9(v, len, vp0, lenp0, iad)
Definition spmd_outp.F:933
spmd_doutp_vgath
subroutine spmd_doutp_vgath(v, nodglob, weight, vgath)
Definition spmd_outp.F:714
outp_arsz_st
subroutine outp_arsz_st(iparg, dd_iad, wasz, wasz_wr, p0ars)
Definition spmd_outp.F:197
spmd_rgather9_dp
subroutine spmd_rgather9_dp(v, len, vp0, lenp0, iad)
Definition spmd_outp.F:1015
outp_arsz_sptt
subroutine outp_arsz_sptt(iparg, dd_iad, wasz, waszp, wasz_wr)
Definition spmd_outp.F:652
spmd_vgath_err
subroutine spmd_vgath_err(x, ms, msini, nodglob, weight, num, iflag, itab, leng)
Definition spmd_vgath_err.F:34
stat_c_epspf
subroutine stat_c_epspf(elbuf_tab, iparg, ipm, igeo, ixc, ixtg, wa, wap0, ipartc, iparttg, ipart_state, stat_indxc, stat_indxtg, thke, sizp0)
Definition stat_c_epspf.F:40
stat_c_fail
subroutine stat_c_fail(elbuf_tab, iparg, ipm, igeo, ixc, ixtg, wa, wap0, ipartc, iparttg, ipart_state, stat_indxc, stat_indxtg, sizp0, nummat, mat_param)
Definition stat_c_fail.F:40
stat_p_aux
subroutine stat_p_aux(elbuf_tab, iparg, ipm, igeo, ixp, wa, wap0, ipartp, ipart_state, stat_indxp, sizp0)
Definition stat_p_aux.F:40
stat_s_auxf
subroutine stat_s_auxf(elbuf_tab, iparg, ipm, igeo, ixs, wa, wap0, iparts, ipart_state, stat_indxs, ipart, sizp0)
Definition stat_s_auxf.F:41
stat_s_straf
subroutine stat_s_straf(elbuf_tab, iparg, ipm, igeo, ixs, wa, wap0, iparts, ipart_state, stat_indxs, x, iglob, ipart, sizp0)
Definition stat_s_straf.F:42