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 32 of file i7therm.F.

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