OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_h3d_gather_r_nodal_value.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_nodal_value ../engine/source/output/h3d/spmd/spmd_h3d_gather_r_nodal_value.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_nodal_value(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
62 IF(weight(i) == 1) THEN
63 j = j + 1
64 v_tmp(j) = v(i)
65 ENDIF
66 ENDDO
67 len_tmp = j
68
69 CALL mpi_gather(
70 s len_tmp ,1 ,mpi_integer,
71 r lenp ,1 ,mpi_integer,it_spmd(1),
72 g spmd_comm_world,ierror)
73C
74 iad=0
75 IF(ispmd == 0)THEN
76 DO i=1,nspmd
77 disp(i) = iad
78 iad = iad+lenp(i)
79 END DO
80 END IF
81C
82 CALL mpi_gatherv(
83 s v_tmp ,len_tmp ,real,
84 r vp0 ,lenp ,disp,real,it_spmd(1),
85 g spmd_comm_world,ierror)
86#endif
87 RETURN
88 END
89!||====================================================================
90!|| spmd_h3d_max_r_nodal_value ../engine/source/output/h3d/spmd/spmd_h3d_gather_r_nodal_value.F
91!||--- called by ------------------------------------------------------
92!|| genh3d ../engine/source/output/h3d/h3d_results/genh3d.F
93!||--- calls -----------------------------------------------------
94!||--- uses -----------------------------------------------------
95!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
96!||====================================================================
97 SUBROUTINE spmd_h3d_max_r_nodal_value(NODGLOB,V,LEN,VP0,LENP0)
98C-----------------------------------------------
99C I m p l i c i t T y p e s
100C-----------------------------------------------
101 USE spmd_comm_world_mod, ONLY : spmd_comm_world
102#include "implicit_f.inc"
103#include "spmd.inc"
104C-----------------------------------------------
105C C o m m o n B l o c k s
106C-----------------------------------------------
107#include "task_c.inc"
108C-----------------------------------------------
109C D u m m y A r g u m e n t s
110C-----------------------------------------------
111 INTEGER LEN,LENP0, NODGLOB(*)
112 my_real
113 . v(len),vp0(lenp0)
114 real
115 . , DIMENSION(:), ALLOCATABLE :: v_tmp,vp0_tmp
116C-----------------------------------------------
117C L O C A L V A R I A B L E S
118C-----------------------------------------------
119 INTEGER J,K
120#ifdef MPI
121 INTEGER STATUS(MPI_STATUS_SIZE),IERROR,I
122
123 ALLOCATE(v_tmp(lenp0))
124 ALLOCATE(vp0_tmp(lenp0))
125
126 DO i=1,lenp0
127 vp0_tmp(i)=zero
128 v_tmp(i) = zero
129 ENDDO
130 DO k=1,len
131 i=nodglob(k)
132 vp0_tmp(i)=v(k)
133 ENDDO
134
135 IF (lenp0 > 0) THEN
136 CALL mpi_reduce(vp0_tmp,v_tmp,lenp0,
137 . mpi_real,mpi_max,it_spmd(1),
138 . spmd_comm_world,ierror)
139 ENDIF
140 IF (ispmd==0) THEN
141 DO i=1,lenp0
142 vp0(i) = v_tmp(i)
143 END DO
144 ENDIF
145
146 DEALLOCATE(v_tmp,vp0_tmp)
147#endif
148 RETURN
149 END
150
151!||====================================================================
152!|| spmd_h3d_max_r_nodal_value_21 ../engine/source/output/h3d/spmd/spmd_h3d_gather_r_nodal_value.F
153!||--- called by ------------------------------------------------------
154!|| genh3d ../engine/source/output/h3d/h3d_results/genh3d.F
155!||--- calls -----------------------------------------------------
156!||--- uses -----------------------------------------------------
157!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
158!||====================================================================
159 SUBROUTINE spmd_h3d_max_r_nodal_value_21(NODGLOB,VP0,LENP0,VG21,NI,NIG)
160C-----------------------------------------------
161C I m p l i c i t T y p e s
162C-----------------------------------------------
163 USE spmd_comm_world_mod, ONLY : spmd_comm_world
164#include "implicit_f.inc"
165#include "spmd.inc"
166C-----------------------------------------------
167C C o m m o n B l o c k s
168C-----------------------------------------------
169#include "task_c.inc"
170C-----------------------------------------------
171C D u m m y A r g u m e n t s
172C-----------------------------------------------
173 INTEGER LENP0, NODGLOB(*),NI , NIG
174 my_real
175 . vp0(lenp0),vg21(nig,*)
176 real
177 . , DIMENSION(:), ALLOCATABLE :: v_tmp,vp0_tmp
178C-----------------------------------------------
179C L O C A L V A R I A B L E S
180C-----------------------------------------------
181 INTEGER J,K
182#ifdef MPI
183 INTEGER STATUS(MPI_STATUS_SIZE),IERROR,I
184
185 ALLOCATE(v_tmp(lenp0))
186 ALLOCATE(vp0_tmp(lenp0))
187
188 DO i=1,lenp0
189 v_tmp(i) = zero
190 ENDDO
191
192 DO i=1,lenp0
193 vp0_tmp(i)=vg21(ni,i)
194 ENDDO
195
196 IF (lenp0 > 0) THEN
197 CALL mpi_reduce(vp0_tmp,v_tmp,lenp0,
198 . mpi_real,mpi_max,it_spmd(1),
199 . spmd_comm_world,ierror)
200 ENDIF
201 IF (ispmd==0) THEN
202 DO i=1,lenp0
203 vp0(i) = v_tmp(i)
204 END DO
205 ENDIF
206
207 DEALLOCATE(v_tmp,vp0_tmp)
208#endif
209 RETURN
210 END
211
212
213
214
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_gather_r_nodal_value
subroutine spmd_h3d_gather_r_nodal_value(weight, v, len, vp0, lenp0)
Definition spmd_h3d_gather_r_nodal_value.F:32
spmd_h3d_max_r_nodal_value
subroutine spmd_h3d_max_r_nodal_value(nodglob, v, len, vp0, lenp0)
Definition spmd_h3d_gather_r_nodal_value.F:98
spmd_h3d_max_r_nodal_value_21
subroutine spmd_h3d_max_r_nodal_value_21(nodglob, vp0, lenp0, vg21, ni, nig)
Definition spmd_h3d_gather_r_nodal_value.F:160