OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_vgath_err.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_vgath_err ../engine/source/mpi/anim/spmd_vgath_err.F
25!||--- called by ------------------------------------------------------
26!|| sortie_error ../engine/source/output/sortie_error.F
27!||--- calls -----------------------------------------------------
28!|| spmd_outpitab ../engine/source/mpi/interfaces/spmd_outp.F
29!||--- uses -----------------------------------------------------
30!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
31!||====================================================================
32 SUBROUTINE spmd_vgath_err(X,MS,MSINI,NODGLOB,WEIGHT,NUM,IFLAG,
33 . ITAB,LENG)
34C-----------------------------------------------
35C I m p l i c i t T y p e s
36C-----------------------------------------------
37 USE spmd_comm_world_mod, ONLY : spmd_comm_world
38#include "implicit_f.inc"
39#include "spmd.inc"
40C-----------------------------------------------
41C C o m m o n B l o c k s
42C-----------------------------------------------
43#include "com01_c.inc"
44#include "com04_c.inc"
45#include "scr18_c.inc"
46#include "task_c.inc"
47#include "units_c.inc"
48C-----------------------------------------------
49C D u m m y A r g u m e n t s
50C-----------------------------------------------
51 my_real
52 . x(3,*),ms(*),msini(*)
53 INTEGER WEIGHT(*),NODGLOB(*),NUM,IFLAG,ITAB(*),LENG
54C-----------------------------------------------
55C L O C A L V A R I A B L E S
56C-----------------------------------------------
57#ifdef MPI
58 REAL, DIMENSION(:) , ALLOCATABLE :: MAXV0, MAXV1, MAXV2
59
60 my_real
61 . , DIMENSION(:), ALLOCATABLE :: v, maxv, maxv_1, maxv_2, maxv_res0,
62 . maxv_res1, maxv_res2
63
64 INTEGER STATUS(MPI_STATUS_SIZE),IERROR,MSGOFF,FLAG,ITABG(LENG)
65 INTEGER SIZ,MSGTYP,I,J,K,NG,NREC,MSGOFF2,
66 . l,ismasschange,msgoff3,msgoff4
67 INTEGER, DIMENSION(:) , ALLOCATABLE :: IDNOD0, IDNOD, IDNOD_RES
68
69 DATA msgoff/7007/
70 DATA msgoff2/7008/
71 DATA msgoff3/7009/
72 DATA msgoff4/7010/
73C=======================================================================
74 IF (nspmd > 1)
75 . CALL spmd_outpitab(itab,weight,nodglob,itabg)
76c
77 ALLOCATE(maxv0(num),maxv1(num),maxv2(num))
78
79 ALLOCATE(v(numnod),maxv(num),maxv_1(num),maxv_2(num),maxv_res0(num),
80 . maxv_res1(num),maxv_res2(num))
81
82 ALLOCATE(idnod0(num),idnod(num),idnod_res(num))
83
84 idnod(1:num) = 0
85 idnod0(1:num) = 0
86 maxv(1:num) = zero
87 maxv_1(1:num) = zero
88 maxv_2(1:num) = zero
89 maxv0(1:num) = zero
90 siz = num
91 IF(iflag==1)THEN
92 DO i=1,numnod
93 v(i)=sqrt(x(1,i)**2+x(2,i)**2+x(3,i)**2)
94 ENDDO
95 ELSEIF(iflag==2)THEN
96 DO i=1,numnod
97 v(i)=half*ms(i)*(x(1,i)**2+x(2,i)**2+x(3,i)**2)
98 ENDDO
99 ELSEIF(iflag==3)THEN
100 DO i=1,numnod
101 v(i)=ms(i)
102 ENDDO
103 ELSEIF(iflag==4)THEN
104 DO i=1,numnod
105 v(i)=(ms(i)-msini(i))/max(em20,msini(i))
106 ENDDO
107 ENDIF
108 IF (ispmd/=0) THEN
109
110 DO i=1,numnod
111 IF (weight(i)==1) THEN
112 flag = 0
113 DO j=1,num
114 IF(v(i) > maxv0(j) .AND. flag == 0) THEN
115 DO k=1,num-j
116 idnod0(num-k+1) = idnod0(num-k)
117 maxv0(num-k+1) = maxv0(num-k)
118 maxv1(num-k+1) = maxv1(num-k)
119 maxv2(num-k+1) = maxv2(num-k)
120 ENDDO
121 idnod0(j) = nodglob(i)
122 maxv0(j) = v(i)
123 maxv1(j) = ms(i)
124 maxv2(j) = msini(i)
125 flag = 1
126 ENDIF
127 ENDDO
128 END IF
129 END DO
130
131C a cause de la version simple precision, on ne peux pas metre l'entier
132C dans le buffer flottant car on n a que 2puiss 24 bits dispo ~ 16 Million
133C de noeuds au max
134
135 msgtyp = msgoff
136 CALL mpi_send(idnod0,siz,mpi_integer,it_spmd(1),msgtyp,
137 . spmd_comm_world,ierror)
138
139 msgtyp = msgoff2
140 CALL mpi_send(maxv0,siz,mpi_real,it_spmd(1),msgtyp,
141 . spmd_comm_world,ierror)
142
143 msgtyp = msgoff3
144 CALL mpi_send(maxv1,siz,mpi_real,it_spmd(1),msgtyp,
145 . spmd_comm_world,ierror)
146
147 msgtyp = msgoff4
148 CALL mpi_send(maxv2,siz,mpi_real,it_spmd(1),msgtyp,
149 . spmd_comm_world,ierror)
150
151 ELSE ! ISPMD == 0
152 DO i=1,numnod
153 IF (weight(i)==1) THEN
154 flag = 0
155 DO j=1,num
156 IF(v(i) > maxv(j) .AND. flag == 0) THEN
157 DO k=1,num-j
158 idnod(num-k+1) = idnod(num-k)
159 maxv(num-k+1) = maxv(num-k)
160 maxv_1(num-k+1) = maxv_1(num-k)
161 maxv_2(num-k+1) = maxv_2(num-k)
162 ENDDO
163 idnod(j) = nodglob(i)
164 maxv(j) = v(i)
165 maxv_1(j) = ms(i)
166 maxv_2(j) = msini(i)
167 flag = 1
168 ENDIF
169 ENDDO
170
171 ENDIF
172 ENDDO
173
174 DO i=2,nspmd
175
176C Reception
177 msgtyp = msgoff
178
179 CALL mpi_probe(it_spmd(i),msgtyp,
180 . spmd_comm_world,status,ierror)
181 CALL mpi_get_count(status,mpi_integer,siz,ierror)
182
183 CALL mpi_recv(idnod0,siz,mpi_integer,it_spmd(i),msgtyp,
184 . spmd_comm_world,status,ierror)
185
186C Reception
187
188 msgtyp = msgoff2
189 CALL mpi_recv(maxv0,siz,mpi_real,it_spmd(i),msgtyp,
190 . spmd_comm_world,status,ierror)
191
192 msgtyp = msgoff3
193 CALL mpi_recv(maxv1,siz,mpi_real,it_spmd(i),msgtyp,
194 . spmd_comm_world,status,ierror)
195
196 msgtyp = msgoff4
197 CALL mpi_recv(maxv2,siz,mpi_real,it_spmd(i),msgtyp,
198 . spmd_comm_world,status,ierror)
199
200
201 j = 1
202 k = 1
203 l = 1
204 DO WHILE( j <= siz .AND. k <= siz .AND. l <= siz)
205 IF(maxv(j) > maxv0(k))THEN
206 maxv_res0(l) = maxv(j)
207 idnod_res(l) = idnod(j)
208 maxv_res1(l) = maxv_1(j)
209 maxv_res2(l) = maxv_2(j)
210 j = j + 1
211 l = l + 1
212 ELSEIF(maxv0(k) > maxv(j))THEN
213 maxv_res0(l) = maxv0(k)
214 idnod_res(l) = idnod0(k)
215 maxv_res1(l) = maxv1(k)
216 maxv_res2(l) = maxv2(k)
217 k = k + 1
218 l = l + 1
219 ELSE
220 maxv_res0(l) = maxv0(k)
221 idnod_res(l) = idnod0(k)
222 maxv_res1(l) = maxv1(k)
223 maxv_res2(l) = maxv2(k)
224 j = j + 1
225 k = k + 1
226 l = l + 1
227 ENDIF
228 ENDDO
229 DO j=1,siz
230 maxv(j) = maxv_res0(j)
231 idnod(j) = idnod_res(j)
232 maxv_1(j) = maxv_res1(j)
233 maxv_2(j) = maxv_res2(j)
234 ENDDO
235
236 ENDDO
237 IF(iflag == 1)THEN
238 WRITE(iout,2000)
239 WRITE(iout,1000)
240 WRITE(iout,2000)
241 WRITE(iout,1001)
242 DO i=1,num
243 IF(maxv_res0(i) /= zero)THEN
244 WRITE(iout,1100) itabg(idnod_res(i)),maxv_res0(i),
245 . half*(maxv_res1(i))*maxv_res0(i)**2,
246 . maxv_res1(i),maxv_res2(i),
247 . (maxv_res1(i)-maxv_res2(i))/max(em20,maxv_res2(i))
248 ENDIF
249 ENDDO
250 ELSEIF(iflag == 2)THEN
251 WRITE(iout,2000)
252 WRITE(iout,1200)
253 WRITE(iout,2000)
254 WRITE(iout,1201)
255 DO i=1,num
256 WRITE(iout,1300) itabg(idnod_res(i)),maxv_res0(i)
257 ENDDO
258 ELSEIF(iflag == 3)THEN
259 WRITE(iout,2000)
260 WRITE(iout,1400)
261 WRITE(iout,2000)
262 WRITE(iout,1401)
263 DO i=1,num
264 WRITE(iout,1500) itabg(idnod_res(i)),maxv_res0(i)
265 ENDDO
266 ELSEIF(iflag == 4 .AND. (idtmin(11) == 3 .OR.idtmin(11)==8))THEN
267 ismasschange = 0
268 DO i=1,num
269 IF(maxv_res0(i) /=zero) ismasschange = 1
270 ENDDO
271 IF(ismasschange /= 0)THEN
272 WRITE(iout,2000)
273 WRITE(iout,1600)
274 WRITE(iout,2000)
275 WRITE(iout,1601)
276 DO i=1,num
277 IF(maxv_res0(i) /= zero)
278 . WRITE(iout,1700) itabg(idnod_res(i)),maxv_res1(i),
279 . maxv_res2(i),maxv_res0(i)
280 ENDDO
281 ENDIF
282 ENDIF
283 ENDIF
284C
285 1000 FORMAT('*** NODES WITH HIGHEST VELOCITY')
286 1001 FORMAT(' NODE VELOCITY K-ENER MASS MASS0
287 . DM/MASS0')
288 1100 FORMAT(i10,5g11.4)
289c
290 1200 FORMAT('*** NODES WITH HIGHEST KINEMATIC ENERGY')
291 1201 FORMAT(' NODE K-ENER MASS MASS0 MASS/MASS0')
292 1300 FORMAT(i10,g11.4)
293c
294 1400 FORMAT('*** NODES WITH HIGHEST MASS')
295 1401 FORMAT(' NODE MASS MASS0 MASS/MASS0')
296 1500 FORMAT(i10,g11.4)
297c
298 1600 FORMAT('*** NODES WITH HIGHEST MASS CHANGE')
299 1601 FORMAT(' NODE MASS MASS0 DM/MASS0')
300 1700 FORMAT(i10,3g11.4)
301c
302 2000 FORMAT(' ')
303 2100 FORMAT(' ** STATISTICS **')
304c
305 DEALLOCATE(maxv0,maxv1,maxv2)
306 DEALLOCATE(v,maxv,maxv_res0,maxv_res1,maxv_res2)
307 DEALLOCATE(idnod0,idnod,idnod_res)
308
309#endif
310 RETURN
311 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_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
spmd_outpitab
subroutine spmd_outpitab(v, weight, nodglob, vglob)
Definition spmd_outp.F:1077
spmd_vgath_err
subroutine spmd_vgath_err(x, ms, msini, nodglob, weight, num, iflag, itab, leng)
Definition spmd_vgath_err.F:34