OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_h3d_gather_r_node.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!|| spmd_h3d_gather_r_node ../engine/source/output/h3d/spmd/spmd_h3d_gather_r_node.F
25!||--- called by ------------------------------------------------------
26!|| genh3d ../engine/source/output/h3d/h3d_results/genh3d.F
27!||--- calls -----------------------------------------------------
28!||--- uses -----------------------------------------------------
29!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
30!||====================================================================
31 SUBROUTINE spmd_h3d_gather_r_node(WEIGHT,V,LEN,VP0,LENP0)
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
90 END
91
92!||====================================================================
93!|| spmd_h3d_sum_r_nodal ../engine/source/output/h3d/spmd/spmd_h3d_gather_r_node.F
94!||--- called by ------------------------------------------------------
95!|| genh3d ../engine/source/output/h3d/h3d_results/genh3d.F
96!||--- calls -----------------------------------------------------
97!||--- uses -----------------------------------------------------
98!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
99!||====================================================================
100 SUBROUTINE spmd_h3d_sum_r_nodal(NODGLOB,V,LEN,VP0,LENP0)
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
159 END
160
161!||====================================================================
162!|| spmd_h3d_sum_r_nodal_21 ../engine/source/output/h3d/spmd/spmd_h3d_gather_r_node.f
163!||--- called by ------------------------------------------------------
164!|| fcont_max_output ../engine/source/output/h3d/h3d_results/fcont_max_output.F
165!|| genh3d ../engine/source/output/h3d/h3d_results/genh3d.F
166!||--- calls -----------------------------------------------------
167!||--- uses -----------------------------------------------------
168!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
169!||====================================================================
170 SUBROUTINE spmd_h3d_sum_r_nodal_21(NODGLOB,V,LEN,VP0,LENP0,VG21)
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
229 END
my_real
#define my_real
Definition cppsort.cpp:32
mpi_reduce
subroutine mpi_reduce(sendbuf, recvbuf, cnt, datatype, op, root, comm, ierr)
Definition mpi.f:120
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_21
subroutine spmd_h3d_sum_r_nodal_21(nodglob, v, len, vp0, lenp0, vg21)
Definition spmd_h3d_gather_r_node.F:171
spmd_h3d_gather_r_node
subroutine spmd_h3d_gather_r_node(weight, v, len, vp0, lenp0)
Definition spmd_h3d_gather_r_node.F:32
spmd_h3d_sum_r_nodal
subroutine spmd_h3d_sum_r_nodal(nodglob, v, len, vp0, lenp0)
Definition spmd_h3d_gather_r_node.F:101