OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i7therm.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "com08_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i7therm (jlt, iparg, pm, ixs, iform, x, xi, yi, zi, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4, ix1, ix2, ix3, ix4, rstif, tempi, ieles, phi, tint, areas, ieleci, frad, drad, gapv, fni, ifunctk, xthe, npc, tf, condint, phi1, phi2, phi3, phi4, fheats, fheatm, efrict, temp, h1, h2, h3, h4, theaccfact)

Function/Subroutine Documentation

◆ i7therm()

subroutine i7therm ( integer jlt,
integer, dimension(nparg,*) iparg,
pm,
integer, dimension(nixs,*) ixs,
integer iform,
x,
xi,
yi,
zi,
x1,
y1,
z1,
x2,
y2,
z2,
x3,
y3,
z3,
x4,
y4,
z4,
integer, dimension(mvsiz) ix1,
integer, dimension(mvsiz) ix2,
integer, dimension(mvsiz) ix3,
integer, dimension(mvsiz) ix4,
rstif,
tempi,
integer, dimension(*) ieles,
phi,
tint,
areas,
integer, dimension(mvsiz) ieleci,
frad,
drad,
gapv,
fni,
integer ifunctk,
xthe,
integer, dimension(*) npc,
tf,
condint,
phi1,
phi2,
phi3,
phi4,
fheats,
fheatm,
efrict,
temp,
h1,
h2,
h3,
h4,
intent(in) theaccfact )

Definition at line 34 of file i7therm.F.

44 use element_mod , only : nixs
45C-----------------------------------------------
46C I m p l i c i t T y p e s
47C-----------------------------------------------
48#include "implicit_f.inc"
49C-----------------------------------------------
50C G l o b a l P a r a m e t e r s
51C-----------------------------------------------
52#include "mvsiz_p.inc"
53C-----------------------------------------------
54C C o m m o n B l o c k s
55C-----------------------------------------------
56#include "com08_c.inc"
57#include "param_c.inc"
58C-----------------------------------------------
59C D u m m y A r g u m e n t s
60C-----------------------------------------------
61 INTEGER JLT, IXS(NIXS,*),IPARG(NPARG,*),IELES(*),
62 . IX1(MVSIZ),IX2(MVSIZ),IX3(MVSIZ),IX4(MVSIZ),
63 . IELECI(MVSIZ),NPC(*),
64 . IFORM,IFUNCTK
65 my_real, intent(in) :: theaccfact
66 my_real
67 . pm(npropm,*),temp(*),tempi(mvsiz),xi(mvsiz),yi(mvsiz),
68 . zi(mvsiz),x1(mvsiz),y1(mvsiz),z1(mvsiz),x2(mvsiz),y2(mvsiz),
69 . z2(mvsiz),x3(mvsiz),y3(mvsiz),z3(mvsiz),x4(mvsiz),y4(mvsiz),
70 . z4(mvsiz),rstif,phi(mvsiz),areas(mvsiz),gapv(mvsiz),
71 . penrad(mvsiz),fni(mvsiz),tf(*),condint(mvsiz),efrict(mvsiz),
72 . phi1(mvsiz),phi2(mvsiz),phi3(mvsiz),phi4(mvsiz),h1(mvsiz),
73 . h2(mvsiz),h3(mvsiz),h4(mvsiz),
74 . x(3,*),tint,frad,drad,dydx,xthe,fheatm,fheats
75C-----------------------------------------------
76C L o c a l V a r i a b l e s
77C-----------------------------------------------
78 INTEGER I,MAT
79C REAL
80 my_real
81 . sx1 , sy1 , sz1 , sx2 , sy2 , sz2,
82 . ts, tm,tstifm,
83 . tstift,dist, norm,cond,p,rstiff,
84 . areac,phim
85 my_real
86 . finter
87 EXTERNAL finter
88C-----------------------------------------------
89 IF(ifunctk==0)THEN ! KTHE =/ F(PEN)
90C--------------------------------------------------------
91C case of mixed packets or quadrangle
92C--------------------------------------------------------
93C
94 DO i=1,jlt
95 phi(i) = zero
96C
97 ts = tempi(i)
98 condint(i) = zero
99C
100C------------------------------------------
101C calculation of the vector surface (*2.)
102C------------------------------------------
103 sx1=(y1(i)-y3(i))*(z2(i)-z4(i)) - (z1(i)-z3(i))*(y2(i)-y4(i))
104 sy1=(z1(i)-z3(i))*(x2(i)-x4(i)) - (x1(i)-x3(i))*(z2(i)-z4(i))
105 sz1=(x1(i)-x3(i))*(y2(i)-y4(i)) - (y1(i)-y3(i))*(x2(i)-x4(i))
106C
107 norm = sqrt(sx1**2 + sy1**2 + sz1**2)
108C--------+---------+---------+---------+---------+---------+---------+--
109C calculation of the distance between center and surface
110C-------------------------------------------------------------
111 IF(ix3(i)/=ix4(i))THEN
112 sx2 = fourth*(x1(i) + x2(i) + x3(i) + x4(i)) - xi(i)
113 sy2 = fourth*(y1(i) + y2(i) + y3(i) + y4(i)) - yi(i)
114 sz2 = fourth*(z1(i) + z2(i) + z3(i) + z4(i)) - zi(i)
115 ELSE
116 sx2 = third*(x1(i) + x2(i) + x3(i)) - xi(i)
117 sy2 = third*(y1(i) + y2(i) + y3(i)) - yi(i)
118 sz2 = third*(z1(i) + z2(i) + z3(i)) - zi(i)
119 END IF
120C
121C-----------------------------------------------
122C CALCULATION DISTANCE ENTRE LE NODE SECOND.
123C and the surface (nodal surface)
124C-----------------------------------------------
125 dist = (sx2*sx1+sy2*sy1+sz2*sz1) / max(em15,norm)
126
127C-------------------------------------------
128C PENRAD : PENETRATION FOR RADIATION
129C RADIATION IF GAP < DIST < DRADIATION
130C-------------------------------------------
131 penrad(i)=abs(dist)
132C
133 IF(areas(i) == zero )THEN
134 areac =half*norm
135 ELSE
136 areac = areas(i)
137 ENDIF
138C
139 IF(iform == 0 )THEN
140 IF(penrad(i) <= drad.AND.penrad(i)>= gapv(i))THEN
141C---------------------------------
142C RADIATION
143C---------------------------------
144 phi(i) = frad * areac * (tint*tint+ts*ts)
145 . * (tint + ts) * (tint - ts) * dt1 * theaccfact
146 ELSE
147C---------------------------------
148C CONDUCTION
149C---------------------------------
150 mat = ieleci(i)
151 IF(mat > 0 ) THEN
152 cond=pm(75,mat)+pm(76,mat)*ts
153 tstifm = max(dist,zero) / cond
154 ELSE
155 cond = zero
156 tstifm = zero
157 ENDIF
158C ---
159 tstift = tstifm + rstif
160 condint(i) = areac * theaccfact / tstift
161 phi(i) = areac * (tint - ts) * dt1 * theaccfact / tstift
162
163 ENDIF
164 phi1(i) = zero
165 phi2(i) = zero
166 phi3(i) = zero
167 phi4(i) = zero
168C---------------------------------
169C HEAT GENERATION DUE TO FRICTION
170C---------------------------------
171 IF(fheats/=zero) phi(i) = phi(i) + fheats * efrict(i)
172 ELSE
173C-------------------------------------------------
174C EXCHANGE BETWEEN SECONDARY NODE AND MAIN SURFACE
175C IS NO MORE IN I7FOR3
176C-------------------------------------------------
177 tm = h1(i)*temp(ix1(i)) + h2(i)*temp(ix2(i))
178 . + h3(i)*temp(ix3(i)) + h4(i)*temp(ix4(i))
179 ts = tempi(i)
180C
181 IF(penrad(i) <= drad.AND.penrad(i)>= gapv(i))THEN
182C---------------------------------
183C RADIATION
184C---------------------------------
185 phi(i) = frad * areac * (tm*tm+ts*ts)
186 . * (tm + ts) * (tm - ts) * dt1 * theaccfact
187 ELSE
188C---------------------------------
189C CONDUCTION
190C---------------------------------
191 phi(i) = areac * (tm - ts) * dt1 * theaccfact / rstif
192 condint(i) = areac * theaccfact / rstif
193 ENDIF
194 phi1(i) = -phi(i) *h1(i)
195 phi2(i) = -phi(i) *h2(i)
196 phi3(i) = -phi(i) *h3(i)
197 phi4(i) = -phi(i) *h4(i)
198C---------------------------------
199C HEAT GENERATION DUE TO FRICTION
200C---------------------------------
201 phi(i) = phi(i) + fheats * efrict(i) !SECONDARY HEATING
202
203 phim = fheatm * efrict(i)
204 phi1(i) = phi1(i) + phim*h1(i) ! MAIN HEATING
205 phi2(i) = phi2(i) + phim*h2(i)
206 phi3(i) = phi3(i) + phim*h3(i)
207 phi4(i) = phi4(i) + phim*h4(i)
208 ENDIF
209 ENDDO
210 ELSE
211C--------------------------------------------------------
212C case of mixed packets or quadrangle
213C--------------------------------------------------------
214C
215 DO i=1,jlt
216 phi(i) = zero
217C
218 ts = tempi(i)
219C------------------------------------------
220C calculation of the vector surface (*2.)
221C------------------------------------------
222 sx1=(y1(i)-y3(i))*(z2(i)-z4(i)) - (z1(i)-z3(i))*(y2(i)-y4(i))
223 sy1=(z1(i)-z3(i))*(x2(i)-x4(i)) - (x1(i)-x3(i))*(z2(i)-z4(i))
224 sz1=(x1(i)-x3(i))*(y2(i)-y4(i)) - (y1(i)-y3(i))*(x2(i)-x4(i))
225C
226 norm = sqrt(sx1**2 + sy1**2 + sz1**2)
227C--------+---------+---------+---------+---------+---------+---------+--
228C calculation of the distance between center and surface
229C-------------------------------------------------------------
230 IF(ix3(i)/=ix4(i))THEN
231 sx2 = fourth*(x1(i) + x2(i) + x3(i) + x4(i)) - xi(i)
232 sy2 = fourth*(y1(i) + y2(i) + y3(i) + y4(i)) - yi(i)
233 sz2 = fourth*(z1(i) + z2(i) + z3(i) + z4(i)) - zi(i)
234 ELSE
235 sx2 = third*(x1(i) + x2(i) + x3(i)) - xi(i)
236 sy2 = third*(y1(i) + y2(i) + y3(i)) - yi(i)
237 sz2 = third*(z1(i) + z2(i) + z3(i)) - zi(i)
238 END IF
239C
240C-----------------------------------------------
241C CALCULATION DISTANCE ENTRE LE NODE SECOND.
242C and the surface (nodal surface)
243C-----------------------------------------------
244 dist = (sx2*sx1+sy2*sy1+sz2*sz1) / max(em15,norm)
245
246C-------------------------------------------
247C PENRAD : PENETRATION FOR RADIATION
248C RADIATION IF GAP < DIST < DRADIATION
249C-------------------------------------------
250 penrad(i)=abs(dist)
251C
252 IF(areas(i) == zero )THEN
253 areac =half*norm
254 ELSE
255 areac = areas(i)
256 ENDIF
257C
258 IF(iform == 0 )THEN
259 IF(penrad(i) <= drad.AND.penrad(i)>= gapv(i))THEN
260C---------------------------------
261C RADIATION
262C---------------------------------
263 phi(i) = frad * areac * (tint*tint+ts*ts)
264 . * (tint + ts) * (tint - ts) * dt1 * theaccfact
265 ELSE
266C---------------------------------
267C CONDUCTION
268C---------------------------------
269 mat = ieleci(i)
270
271C---------------------------------
272C calculation of the conductivity
273C---------------------------------
274 p = xthe * abs(fni(i)) / areac
275 rstiff = rstif / max(em30,finter(ifunctk,p,npc,tf,dydx))
276 IF(mat > 0 ) THEN
277 cond=pm(75,mat)+pm(76,mat)*ts
278 tstifm = max(dist,zero) / cond
279 ELSE
280 cond = zero
281 tstifm = zero
282 ENDIF
283
284 tstift = tstifm + rstiff
285 condint(i) = areac * theaccfact / tstift
286C ---
287 phi(i) = areac * (tint - ts) * dt1 * theaccfact / tstift
288 ENDIF
289 phi1(i) = zero
290 phi2(i) = zero
291 phi3(i) = zero
292 phi4(i) = zero
293 ELSE
294C-------------------------------------------------
295C EXCHANGE BETWEEN SECONDARY NODE AND MAIN SURFACE
296C IS NO MORE DONE IN I7FOR3
297C-------------------------------------------------
298 tm = h1(i)*temp(ix1(i)) + h2(i)*temp(ix2(i))
299 . + h3(i)*temp(ix3(i)) + h4(i)*temp(ix4(i))
300 ts = tempi(i)
301C
302 IF(penrad(i) <= drad.AND.penrad(i)>= gapv(i))THEN
303C---------------------------------
304C RADIATION
305C---------------------------------
306 phi(i) = frad * areac * (tm*tm+ts*ts)
307 . * (tm + ts) * (tm- ts) * dt1 * theaccfact
308 ELSE
309C---------------------------------
310C calculation of the conductivity
311C---------------------------------
312 p = xthe * abs(fni(i)) / areac
313 rstiff = rstif / max(em30,finter(ifunctk,p,npc,tf,dydx))
314C
315 phi(i) = areac * (tm - ts) * dt1 * theaccfact / rstiff
316 condint(i) = areac * theaccfact / rstiff
317 ENDIF
318C---------------------------------
319C HEAT GENERATION DUE TO FRICTION
320C---------------------------------
321 phi(i) = phi(i) + fheats * efrict(i) !SECONDARY HEATING
322
323 phim = fheatm * efrict(i)
324 phi1(i) = phi1(i) + phim*h1(i) ! MAIN HEATING
325 phi2(i) = phi2(i) + phim*h2(i)
326 phi3(i) = phi3(i) + phim*h3(i)
327 phi4(i) = phi4(i) + phim*h4(i)
328
329 ENDIF
330 ENDDO
331 ENDIF
332C
333 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
norm
norm(diag(diag(diag(inv(mat))) -id.SOL), 2) % destroy mumps instance id.JOB
max
#define max(a, b)
Definition macros.h:21