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

Go to the source code of this file.

Functions/Subroutines

subroutine spmd_h3d_gather_r_node (weight, v, len, vp0, lenp0)
subroutine spmd_h3d_sum_r_nodal (nodglob, v, len, vp0, lenp0)
subroutine spmd_h3d_sum_r_nodal_21 (nodglob, v, len, vp0, lenp0, vg21)

Function/Subroutine Documentation

◆ spmd_h3d_gather_r_node()

subroutine spmd_h3d_gather_r_node ( integer, dimension(*) weight,
v,
integer len,
vp0,
integer lenp0 )

Definition at line 31 of file spmd_h3d_gather_r_node.F.

32C-----------------------------------------------
33C I m p l i c i t T y p e s
34C-----------------------------------------------
35 USE spmd_comm_world_mod, ONLY : spmd_comm_world
36#include "implicit_f.inc"
37#include "spmd.inc"
38C-----------------------------------------------
39C C o m m o n B l o c k s
40C-----------------------------------------------
41#include "task_c.inc"
42#include "com01_c.inc"
43C-----------------------------------------------
44C D u m m y A r g u m e n t s
45C-----------------------------------------------
46 INTEGER LEN,LENP0,WEIGHT(*)
47 my_real
48 . v(len),vp0(lenp0),v_tmp(len)
49
50C-----------------------------------------------
51C L O C A L V A R I A B L E S
52C-----------------------------------------------
53 INTEGER IAD,J,LEN_TMP
54#ifdef MPI
55 INTEGER STATUS(MPI_STATUS_SIZE),IERROR,
56 . MSGTYP,I,SIZ,LENP(NSPMD),DISP(NSPMD)
57
58
59
60 j = 0
61 DO i=1,len/3
62 IF(weight(i) == 1) THEN
63 v_tmp(j+1) = v(3*(i-1)+1)
64 v_tmp(j+2) = v(3*(i-1)+2)
65 v_tmp(j+3) = v(3*(i-1)+3)
66 j = j + 3
67 ENDIF
68 ENDDO
69 len_tmp = j
70
71 CALL mpi_gather(
72 s len_tmp ,1 ,mpi_integer,
73 r lenp ,1 ,mpi_integer,it_spmd(1),
74 g spmd_comm_world,ierror)
75C
76 iad=0
77 IF(ispmd == 0)THEN
78 DO i=1,nspmd
79 disp(i) = iad
80 iad = iad+lenp(i)
81 END DO
82 END IF
83C
84 CALL mpi_gatherv(
85 s v_tmp ,len_tmp ,real,
86 r vp0 ,lenp ,disp,real,it_spmd(1),
87 g spmd_comm_world,ierror)
88#endif
89 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
mpi_gather
subroutine mpi_gather(sendbuf, cnt, datatype, recvbuf, reccnt, rectype, root, comm, ierr)
Definition mpi.f:56
mpi_gatherv
subroutine mpi_gatherv(sendbuf, cnt, datatype, recvbuf, reccnt, displs, rectype, root, comm, ierr)
Definition mpi.f:76

◆ spmd_h3d_sum_r_nodal()

subroutine spmd_h3d_sum_r_nodal ( integer, dimension(*) nodglob,
v,
integer len,
vp0,
integer lenp0 )

Definition at line 100 of file spmd_h3d_gather_r_node.F.

101C-----------------------------------------------
102C I m p l i c i t T y p e s
103C-----------------------------------------------
104 USE spmd_comm_world_mod, ONLY : spmd_comm_world
105#include "implicit_f.inc"
106#include "spmd.inc"
107C-----------------------------------------------
108C C o m m o n B l o c k s
109C-----------------------------------------------
110#include "task_c.inc"
111C-----------------------------------------------
112C D u m m y A r g u m e n t s
113C-----------------------------------------------
114 INTEGER LEN,LENP0, NODGLOB(*)
115 my_real
116 . v(len),vp0(lenp0)
117 real
118 . , DIMENSION(:), ALLOCATABLE :: v_tmp,vp0_tmp
119C-----------------------------------------------
120C L O C A L V A R I A B L E S
121C-----------------------------------------------
122 INTEGER J,K
123#ifdef MPI
124 INTEGER STATUS(MPI_STATUS_SIZE),IERROR,I
125
126
127 ALLOCATE(v_tmp(lenp0))
128 ALLOCATE(vp0_tmp(lenp0))
129
130 DO i=1,lenp0
131 vp0_tmp(i)=zero
132 v_tmp(i) = zero
133 ENDDO
134
135 DO k=1,len/3
136 i=nodglob(k)
137 vp0_tmp(3*(i-1)+1)=v(3*(k-1)+1)
138 vp0_tmp(3*(i-1)+2)=v(3*(k-1)+2)
139 vp0_tmp(3*(i-1)+3)=v(3*(k-1)+3)
140 ENDDO
141
142 IF (lenp0 > 0) THEN
143 CALL mpi_reduce(vp0_tmp,v_tmp,lenp0,
144 . mpi_real,mpi_sum,it_spmd(1),
145 . spmd_comm_world,ierror)
146
147 ENDIF
148 IF (ispmd==0) THEN
149 DO i=1,lenp0
150 vp0(i) = v_tmp(i)
151 END DO
152 ENDIF
153
154 DEALLOCATE(v_tmp,vp0_tmp)
155
156
157#endif
158 RETURN
mpi_reduce
subroutine mpi_reduce(sendbuf, recvbuf, cnt, datatype, op, root, comm, ierr)
Definition mpi.f:120

◆ spmd_h3d_sum_r_nodal_21()

subroutine spmd_h3d_sum_r_nodal_21 ( integer, dimension(*) nodglob,
v,
integer len,
vp0,
integer lenp0,
vg21 )

Definition at line 170 of file spmd_h3d_gather_r_node.F.

171C-----------------------------------------------
172C I m p l i c i t T y p e s
173C-----------------------------------------------
174 USE spmd_comm_world_mod, ONLY : spmd_comm_world
175#include "implicit_f.inc"
176#include "spmd.inc"
177C-----------------------------------------------
178C C o m m o n B l o c k s
179C-----------------------------------------------
180#include "task_c.inc"
181C-----------------------------------------------
182C D u m m y A r g u m e n t s
183C-----------------------------------------------
184 INTEGER LEN,LENP0, NODGLOB(*)
185 my_real
186 . v(len),vp0(lenp0),vg21(lenp0)
187 my_real
188 . , DIMENSION(:), ALLOCATABLE :: v_tmp,vp0_tmp
189C-----------------------------------------------
190C L O C A L V A R I A B L E S
191C-----------------------------------------------
192 INTEGER J,K
193#ifdef MPI
194 INTEGER STATUS(MPI_STATUS_SIZE),IERROR,I
195
196
197 ALLOCATE(v_tmp(lenp0))
198 ALLOCATE(vp0_tmp(lenp0))
199
200 DO i=1,lenp0
201 vp0_tmp(i)=vg21(i)
202 v_tmp(i) = zero
203 ENDDO
204
205 DO k=1,len/3
206 i=nodglob(k)
207 vp0_tmp(3*(i-1)+1)=v(3*(k-1)+1)
208 vp0_tmp(3*(i-1)+2)=v(3*(k-1)+2)
209 vp0_tmp(3*(i-1)+3)=v(3*(k-1)+3)
210 ENDDO
211
212 IF (lenp0 > 0) THEN
213 CALL mpi_reduce(vp0_tmp,v_tmp,lenp0,
214 . real,mpi_sum,it_spmd(1),
215 . spmd_comm_world,ierror)
216
217 ENDIF
218 IF (ispmd==0) THEN
219 DO i=1,lenp0
220 vp0(i) = v_tmp(i)
221 END DO
222 ENDIF
223
224 DEALLOCATE(v_tmp,vp0_tmp)
225
226
227#endif
228 RETURN