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

Go to the source code of this file.

Functions/Subroutines

subroutine i21therm (jlt, xi, yi, zi, kthe, tempi, phi, areas, noint, asi, bsi, gapv, pene, ifunctk, xthe, fni, npc, tf, frad, drad, penrad, tempm, fheat, efrict, condint, iform, h1, h2, h3, h4, phi1, phi2, phi3, phi4, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4, itab, nsv, msr, ix1, ix2, ix3, ix4, temp, fcond, dcond, theaccfact)

Function/Subroutine Documentation

◆ i21therm()

subroutine i21therm ( integer jlt,
xi,
yi,
zi,
kthe,
tempi,
phi,
areas,
integer noint,
asi,
bsi,
gapv,
pene,
integer ifunctk,
xthe,
fni,
integer, dimension(*) npc,
tf,
frad,
drad,
penrad,
tempm,
fheat,
efrict,
condint,
integer iform,
h1,
h2,
h3,
h4,
phi1,
phi2,
phi3,
phi4,
x1,
y1,
z1,
x2,
y2,
z2,
x3,
y3,
z3,
x4,
y4,
z4,
integer, dimension(*) itab,
integer, dimension(*) nsv,
integer, dimension(*) msr,
integer, dimension(mvsiz) ix1,
integer, dimension(mvsiz) ix2,
integer, dimension(mvsiz) ix3,
integer, dimension(mvsiz) ix4,
temp,
integer fcond,
dcond,
intent(in) theaccfact )

Definition at line 30 of file i21therm.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"
54C-----------------------------------------------
55C D u m m y A r g u m e n t s
56C-----------------------------------------------
57 INTEGER JLT, NOINT, IFUNCTK, FCOND,
58 . NPC(*),IFORM,ITAB(*),
59 . NSV(*),MSR(*),IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ)
60 my_real, intent(in) :: theaccfact
61 my_real dcond
62 my_real
63 . tempi(mvsiz), xi(mvsiz), yi(mvsiz),temp(*),
64 . zi(mvsiz), phi(mvsiz), areas(mvsiz),
65 . asi(mvsiz), bsi(mvsiz), gapv(mvsiz), pene(mvsiz),
66 . kthe, xthe, fni(mvsiz), tf(*), frad, drad,
67 . penrad(mvsiz), tempm(mvsiz),fheat,efrict(mvsiz),
68 . condint(mvsiz),
69 . h1(mvsiz), h2(mvsiz), h3(mvsiz), h4(mvsiz),
70 . phi1(mvsiz),phi2(mvsiz),phi3(mvsiz),phi4(mvsiz),
71 . ax1,ay1,az1,ax2,ay2,az2,ax,ay,az,areac,phim,area,
72 . x1(mvsiz), x2(mvsiz), x3(mvsiz), x4(mvsiz),
73 . y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
74 . z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz)
75 my_real
76 . finter
77 EXTERNAL finter
78C-----------------------------------------------
79C L o c a l V a r i a b l e s
80C-----------------------------------------------
81 INTEGER I
82C REAL
83 my_real
84 . ts, rstif, tstifm, tstift, dist, cond, p, dydx,
85 . tm, ddcond, dd, hcond
86C-----------------------------------------------
87 IF(ifunctk==0)THEN
88 rstif = one/max(em30,kthe)
89 DO i=1,jlt
90 ts = tempi(i)
91 tm = tempm(i)
92 condint(i) = zero
93 ddcond = max(dcond-gapv(i),em20)
94C
95 IF(areas(i) == zero )THEN
96C
97 ax1 = x3(i) - x1(i)
98 ay1 = y3(i) - y1(i)
99 az1 = z3(i) - z1(i)
100 ax2 = x4(i) - x2(i)
101 ay2 = y4(i) - y2(i)
102 az2 = z4(i) - z2(i)
103
104 ax = ay1*az2 - az1*ay2
105 ay = az1*ax2 - ax1*az2
106 az = ax1*ay2 - ay1*ax2
107C
108 area = half*sqrt(ax*ax+ay*ay+az*az)
109C
110 areac =area
111C
112 ELSE
113C
114 areac = areas(i)
115C
116 ENDIF
117C---------------------------------
118C DISTANCE ENTRE LE NOEUD SECOND.
119C ET LA SURFACE(SURFFACE NODALE)
120C---------------------------------
121C-------------------------------------
122C Conduction : close distance
123C-------------------------------------
124 IF(penrad(i) <= zero)THEN
125C Dist = Gapv - Penetration wrt Gapv
126 dist = penrad(i)+ gapv(i)
127C---------------------------------
128C CALCUL DE LA CONDUCTIBILITE
129C---------------------------------
130 cond = asi(i)+bsi(i)*ts
131 tstifm = max(dist,zero) / cond
132 tstift = tstifm + rstif
133 condint(i) = areac * theaccfact /tstift
134C---------------------------------
135 phi(i) = areac*(tm - ts)*dt1*theaccfact / tstift
136C----------------------------------------------------------------------
137C Conduction + Radiation : Heat exchange depending on distance
138C----------------------------------------------------------------------
139 ELSEIF(penrad(i) <= ddcond)THEN
140C---------------------------------
141 dist = gapv(i)
142 cond = asi(i)+bsi(i)*ts
143 tstifm = max(dist,zero) / cond
144 tstift = tstifm + rstif
145 dd = penrad(i) /ddcond
146 hcond = finter(fcond,dd,npc,tf,dydx) / tstift
147 condint(i) = areac*hcond * theaccfact
148
149 phi(i) = areac * (tm - ts)*dt1* hcond * theaccfact
150
151 phi(i) = phi(i) + frad * areac * (tm*tm+ts*ts)
152 . * (tm + ts) * (tm - ts) * dt1 * theaccfact
153C-------------------------------------
154C Radiation :
155C-------------------------------------
156 ELSEIF(penrad(i) <= drad)THEN
157C---------------------------------
158 phi(i) = frad * areac * (tm*tm+ts*ts)
159 . * (tm + ts) * (tm - ts) * dt1 * theaccfact
160
161 END IF
162C
163 IF(iform == 1 )THEN
164C
165 phi1(i) = -phi(i) *h1(i)
166 phi2(i) = -phi(i) *h2(i)
167 phi3(i) = -phi(i) *h3(i)
168 phi4(i) = -phi(i) *h4(i)
169C---------------------------------
170C HEAT GENERATION DUE TO FRICTION
171C---------------------------------
172 phim = fheat * efrict(i)
173 phi1(i) = phi1(i) + phim*h1(i) ! main heating
174 phi2(i) = phi2(i) + phim*h2(i)
175 phi3(i) = phi3(i) + phim*h3(i)
176 phi4(i) = phi4(i) + phim*h4(i)
177 ENDIF
178C---------------------------------
179C HEAT GENERATION DUE TO FRICTION
180C---------------------------------
181 phi(i) = phi(i) + fheat * efrict(i) * theaccfact
182 ENDDO
183C
184 ELSE
185 DO i=1,jlt
186 ts = tempi(i)
187 tm = tempm(i)
188 condint(i) = zero
189 ddcond = max(dcond-gapv(i),em20)
190C
191 IF(areas(i) == zero )THEN
192C
193 ax1 = x3(i) - x1(i)
194 ay1 = y3(i) - y1(i)
195 az1 = z3(i) - z1(i)
196 ax2 = x4(i) - x2(i)
197 ay2 = y4(i) - y2(i)
198 az2 = z4(i) - z2(i)
199
200 ax = ay1*az2 - az1*ay2
201 ay = az1*ax2 - ax1*az2
202 az = ax1*ay2 - ay1*ax2
203C
204 area = half*sqrt(ax*ax+ay*ay+az*az)
205C
206 areac =area
207C
208 ELSE
209C
210 areac = areas(i)
211C
212 ENDIF
213C---------------------------------
214C DISTANCE ENTRE LE NOEUD SECOND.
215C ET LA SURFACE(SURFFACE NODALE)
216C---------------------------------
217C-------------------------------------
218C Conduction : close distance
219C-------------------------------------
220 IF(penrad(i) <= zero)THEN
221C Dist = Gapv - Penetration wrt Gapv
222 dist = penrad(i) +gapv(i)
223C---------------------------------
224C CALCUL DE LA CONDUCTIBILITE
225C---------------------------------
226 p = xthe * abs(fni(i)) / areas(i)
227 rstif = one / max(em30,kthe * finter(ifunctk,p,npc,tf,dydx))
228 cond = asi(i)+bsi(i)*ts
229 tstifm = max(dist,zero) / cond
230 tstift = tstifm + rstif
231 condint(i) = areac * theaccfact/tstift
232C---------------------------------
233 phi(i) = areac * (tm- ts)*dt1*theaccfact / tstift
234C---------------------------------
235C----------------------------------------------------------------------
236C Conduction + Radiation : Heat exchange depending on distance
237C----------------------------------------------------------------------
238 ELSEIF(penrad(i) <= ddcond)THEN
239C---------------------------------
240 dist = gapv(i)
241 cond = asi(i)+bsi(i)*ts
242 p = zero
243 rstif = one / max(em30,kthe * finter(ifunctk,p,npc,tf,dydx))
244 tstifm = max(dist,zero) / cond
245 tstift = tstifm + rstif
246 dd = penrad(i) /ddcond
247 hcond = finter(fcond,dd,npc,tf,dydx) / tstift
248 condint(i) = areac*hcond*theaccfact
249
250 phi(i) = areac * (tm - ts)*dt1 * hcond *theaccfact
251
252 phi(i) = phi(i) + frad * areac * (tm*tm+ts*ts)
253 . * (tm + ts) * (tm - ts) * dt1 *theaccfact
254C-------------------------------------
255C Radiation :
256C-------------------------------------
257C---------------------------------
258 ELSEIF(penrad(i) <= drad)THEN
259C---------------------------------
260 phi(i) = frad * areac * (tm*tm+ts*ts)
261 . * (tm + ts) * (tm - ts) * dt1 *theaccfact
262 END IF
263C
264 IF(iform == 1 )THEN
265C
266 phi1(i) = -phi(i) *h1(i)
267 phi2(i) = -phi(i) *h2(i)
268 phi3(i) = -phi(i) *h3(i)
269 phi4(i) = -phi(i) *h4(i)
270C---------------------------------
271C HEAT GENERATION DUE TO FRICTION
272C---------------------------------
273 phim = fheat * efrict(i)
274 phi1(i) = phi1(i) + phim*h1(i) ! main HEATING
275 phi2(i) = phi2(i) + phim*h2(i)
276 phi3(i) = phi3(i) + phim*h3(i)
277 phi4(i) = phi4(i) + phim*h4(i)
278 ENDIF
279C---------------------------------
280C HEAT GENERATION DUE TO FRICTION
281C---------------------------------
282 phi(i) = phi(i) + fheat * efrict(i)*theaccfact
283 ENDDO
284 END IF
285C
286 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
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
main
int main(int argc, char *argv[])
Definition CMakeCCompilerId.c:841