OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sortie_error.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!|| sortie_error ../engine/source/output/sortie_error.F
25!||--- called by ------------------------------------------------------
26!|| resol ../engine/source/engine/resol.F
27!||--- calls -----------------------------------------------------
28!|| spmd_glob_dsum9 ../engine/source/mpi/interfaces/spmd_th.f
29!|| spmd_vgath_err ../engine/source/mpi/anim/spmd_vgath_err.F
30!||====================================================================
31 SUBROUTINE sortie_error(V,NODGLOB,WEIGHT,ITAB,MS,
32 1 MS0,PARAM,PARTSAV,IPART,PM,
33 2 IGEO)
34C-----------------------------------------------
35C I m p l i c i t T y p e s
36C-----------------------------------------------
37#include "implicit_f.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"
43#include "com04_c.inc"
44#include "param_c.inc"
45#include "scr17_c.inc"
46#include "scr18_c.inc"
47#include "spmd_c.inc"
48#include "units_c.inc"
49C-----------------------------------------------
50C D u m m y A r g u m e n t s
51C-----------------------------------------------
52 my_real
53 . v(3,*),ms(*),ms0(*),pm(npropm,*),partsav(npsav,*)
54 INTEGER
55 . NODGLOB(*),WEIGHT(*),ITAB(*),PARAM,
56 . ipart(lipart1,*),igeo(npropgi,*)
57C-----------------------------------------------
58C L o c a l V a r i a b l e s
59C-----------------------------------------------
60 INTEGER
61 . I,J,K,LENG,FLAG,ISMASSCHANGE,PROPID,MATID
62 my_real
63 . maxvel(param),vel,
64 . maxencin(param),encin,vel2,
65 . maxmass(param),mass,
66 . maxdmass(param),dmass,
67 . maxenint(param),enint
68 INTEGER
69 . IDNOD(PARAM),IDPART(PARAM)
70C=======================================================================
71 IF(ispmd == 0) WRITE(iout,3000)
72 IF(ispmd == 0) WRITE(iout,3100)
73C
74 IF(nspmd>1) CALL spmd_glob_dsum9(partsav,npsav*(npart+nthpart))
75C
76 idpart = 0
77 maxencin = zero
78 DO i=1,npart
79 flag = 0
80 encin= partsav(2,i)
81 DO j=1,param
82 IF(encin > maxencin(j) .AND. flag == 0) THEN
83 DO k=1,param-j
84 idpart(param-k+1) = idpart(param-k)
85 maxencin(param-k+1) = maxencin(param-k)
86 ENDDO
87 idpart(j) = i
88 maxencin(j) = encin
89 flag = 1
90 ENDIF
91 ENDDO
92 ENDDO
93 IF(ispmd == 0) WRITE(iout,3000)
94 IF(ispmd == 0) WRITE(iout,1800)
95 IF(ispmd == 0) WRITE(iout,3000)
96 IF(ispmd == 0) WRITE(iout,1801)
97
98 DO i=1,param
99 IF(maxencin(i) /= zero) THEN
100 matid = nint(pm(19,ipart(1,idpart(i))))
101 propid = igeo(11,ipart(2,idpart(i)))
102 WRITE(iout,1900)ipart(4,idpart(i)),maxencin(i),
103 . ipart(6,idpart(i)),propid,
104 . ipart(5,idpart(i)),matid
105 ENDIF
106 ENDDO
107
108 1800 FORMAT('*** PARTS WITH HIGHEST KINETIC ENERGY')
109 1801 FORMAT(' PART_ID K-ENERGY PROP_ID PROP_TYPE MAT_ID
110 . MAT_TYPE')
111 1900 FORMAT(i10,g11.4,4i10)
112C
113 idpart = 0
114 maxenint = zero
115 DO i=1,npart
116 flag = 0
117 enint= partsav(1,i)+partsav(24,i)+partsav(26,i)
118 DO j=1,param
119 IF(enint > maxenint(j) .AND. flag == 0) THEN
120 DO k=1,param-j
121 idpart(param-k+1) = idpart(param-k)
122 maxenint(param-k+1) = maxenint(param-k)
123 ENDDO
124 idpart(j) = i
125 maxenint(j) = enint
126 flag = 1
127 ENDIF
128 ENDDO
129 ENDDO
130 IF(ispmd == 0) WRITE(iout,3000)
131 IF(ispmd == 0) WRITE(iout,2000)
132 IF(ispmd == 0) WRITE(iout,3000)
133 IF(ispmd == 0) WRITE(iout,2001)
134 DO i=1,param
135 IF(maxenint(i) /= zero) THEN
136 matid = nint(pm(19,ipart(1,idpart(i))))
137 propid = igeo(11,ipart(2,idpart(i)))
138 WRITE(iout,2100)ipart(4,idpart(i)),maxenint(i),
139 . ipart(6,idpart(i)),propid,
140 . ipart(5,idpart(i)),matid
141 ENDIF
142 ENDDO
143
144 2000 FORMAT('*** PARTS WITH HIGHEST INTERNAL ENERGY')
145 2001 FORMAT(' PART_ID I-ENERGY PROP_ID PROP_TYPE MAT_ID
146 . MAT_TYPE')
147 2100 FORMAT(i10,g11.4,4i10)
148C
149 idnod = 0
150 maxvel = zero
151 IF (nspmd == 1) THEN
152 DO i=1,numnod
153 flag = 0
154 vel=sqrt(v(1,i)**2+v(2,i)**2+v(3,i)**2)
155 DO j=1,param
156 IF(vel > maxvel(j) .AND. flag == 0) THEN
157 DO k=1,param-j
158 idnod(param-k+1) = idnod(param-k)
159 maxvel(param-k+1) = maxvel(param-k)
160 ENDDO
161 idnod(j) = i
162 maxvel(j) = vel
163 flag = 1
164 ENDIF
165 ENDDO
166 ENDDO
167 WRITE(iout,3000)
168 WRITE(iout,1000)
169 WRITE(iout,3000)
170 WRITE(iout,1001)
171 DO i=1,param
172 IF(maxvel(i) /= zero)THEN
173 encin = half * ms(idnod(i))*maxvel(i)**2
174 WRITE(iout,1100) itab(idnod(i)),maxvel(i),encin,
175 . ms(idnod(i)),ms0(idnod(i)),
176 . (ms(idnod(i))-ms0(idnod(i)))/max(em20,ms0(idnod(i)))
177 ENDIF
178 ENDDO
179 ELSE
180 IF (ispmd==0) THEN
181 leng = numnodg
182 ELSE
183 leng = 0
184 ENDIF
185 CALL spmd_vgath_err(v,ms,ms0,nodglob,weight,param,1,itab,leng)
186 ENDIF
187 1000 FORMAT('*** NODES WITH HIGHEST VELOCITY')
188 1001 FORMAT(' NODE VELOCITY K-ENER MASS MASS0
189 . DM/MASS0')
190 1100 FORMAT(i10,5g11.4)
191C
192c IDNOD = 0
193c MAXENCIN = ZERO
194c IF (NSPMD == 1) THEN
195c DO I=1,NUMNOD
196c FLAG = 0
197c ENCIN=HALF*MS(I)*(V(1,I)**2+V(2,I)**2+V(3,I)**2)
198c DO J=1,PARAM
199c IF(ENCIN > MAXENCIN(J) .AND. FLAG == 0) THEN
200c DO K=1,PARAM-J
201c IDNOD(PARAM-K+1) = IDNOD(PARAM-K)
202c MAXENCIN(PARAM-K+1) = MAXENCIN(PARAM-K)
203c ENDDO
204c IDNOD(J) = I
205c MAXENCIN(J) = ENCIN
206c FLAG = 1
207c ENDIF
208c ENDDO
209c ENDDO
210c WRITE(IOUT,3000)
211c WRITE(IOUT,1200)
212c WRITE(IOUT,3000)
213c WRITE(IOUT,1201)
214c DO I=1,PARAM
215c WRITE(IOUT,1300) ITAB(IDNOD(I)),MAXENCIN(I),MS(IDNOD(I)),
216c . MS0(IDNOD(I)),MS(IDNOD(I))/MS0(IDNOD(I))
217c ENDDO
218c ELSE
219c IF (ISPMD==0) THEN
220c LENG = NUMNODG
221c ELSE
222c LENG = 0
223c ENDIF
224c CALL SPMD_VGATH_ERR(V,MS,MS0,NODGLOB,WEIGHT,PARAM,2,ITAB,LENG)
225c ENDIF
226c
227c 1200 FORMAT('*** NODES WITH HIGHEST KINEMATIC ENERGY')
228c 1201 FORMAT(' NODE K-ENER MASS MASS0 MASS/MASS0')
229c 1300 FORMAT(I10,4G11.4)
230C
231c IDNOD = 0
232c MAXMASS = ZERO
233c IF (NSPMD == 1) THEN
234c DO I=1,NUMNOD
235c FLAG = 0
236c MASS=MS(I)
237c DO J=1,PARAM
238c IF(MASS > MAXMASS(J) .AND. FLAG == 0) THEN
239c DO K=1,PARAM-J
240c IDNOD(PARAM-K+1) = IDNOD(PARAM-K)
241c MAXMASS(PARAM-K+1) = MAXMASS(PARAM-K)
242c ENDDO
243c IDNOD(J) = I
244c MAXMASS(J) = MASS
245c FLAG = 1
246c ENDIF
247c ENDDO
248c ENDDO
249c WRITE(IOUT,3000)
250c WRITE(IOUT,1400)
251c WRITE(IOUT,3000)
252c WRITE(IOUT,1401)
253c DO I=1,PARAM
254c WRITE(IOUT,1500) ITAB(IDNOD(I)),MAXMASS(I),
255c . MS0(IDNOD(I)),MS(IDNOD(I))/MS0(IDNOD(I))
256c ENDDO
257c ELSE
258c IF (ISPMD==0) THEN
259c LENG = NUMNODG
260c ELSE
261c LENG = 0
262c ENDIF
263c CALL SPMD_VGATH_ERR(V,MS,MS0,NODGLOB,WEIGHT,PARAM,3,ITAB,LENG)
264c ENDIF
265c
266c 1400 FORMAT('*** NODES WITH HIGHEST MASS')
267c 1401 FORMAT(' NODE MASS MASS0 MASS/MASS0')
268c 1500 FORMAT(I10,3G11.4)
269C
270 idnod = 0
271 maxdmass = zero
272 IF(idtmin(11) == 3 .OR. idtmin(11) == 8) THEN
273 IF (nspmd == 1) THEN
274 DO i=1,numnod
275 flag = 0
276 dmass=(ms(i)-ms0(i))/max(ms0(i),em20)
277 DO j=1,param
278 IF(dmass > maxdmass(j) .AND. flag == 0) THEN
279 DO k=1,param-j
280 idnod(param-k+1) = idnod(param-k)
281 maxdmass(param-k+1) = maxdmass(param-k)
282 ENDDO
283 idnod(j) = i
284 maxdmass(j) = dmass
285 flag = 1
286 ENDIF
287 ENDDO
288 ENDDO
289 ismasschange = 0
290 DO i=1,param
291 IF(maxdmass(i) /=zero) ismasschange = 1
292 ENDDO
293 IF(ismasschange /= 0)THEN
294 WRITE(iout,3000)
295 WRITE(iout,1600)
296 WRITE(iout,3000)
297 WRITE(iout,1601)
298 DO i=1,param
299 IF(maxdmass(i) /= zero)
300 . WRITE(iout,1700) itab(idnod(i)),ms(idnod(i)),ms0(idnod(i)),
301 . maxdmass(i)
302 ENDDO
303 ENDIF
304 ELSE
305 IF (ispmd==0) THEN
306 leng = numnodg
307 ELSE
308 leng = 0
309 ENDIF
310 CALL spmd_vgath_err(v,ms,ms0,nodglob,weight,param,4,itab,leng)
311 ENDIF
312 ENDIF
313 IF(ispmd == 0) CALL flush(iout)
314
315 1600 FORMAT('*** NODES WITH HIGHEST MASS CHANGE')
316 1601 FORMAT(' NODE MASS MASS0 DM/MASS0')
317 1700 FORMAT(i10,3g11.4)
318C
319 3000 FORMAT(' ')
320 3100 FORMAT(' ** STATISTICS **')
321c-----------
322 RETURN
323 END
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21
sortie_error
subroutine sortie_error(v, nodglob, weight, itab, ms, ms0, param, partsav, ipart, pm, igeo)
Definition sortie_error.F:34
spmd_glob_dsum9
subroutine spmd_glob_dsum9(v, len)
Definition spmd_th.F:380
spmd_vgath_err
subroutine spmd_vgath_err(x, ms, msini, nodglob, weight, num, iflag, itab, leng)
Definition spmd_vgath_err.F:34