OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i11therm.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/.
23C
24!||====================================================================
25!|| i11therm ../engine/source/interfaces/int11/i11therm.F
26!||--- called by ------------------------------------------------------
27!|| i11mainf ../engine/source/interfaces/int11/i11mainf.f
28!||--- calls -----------------------------------------------------
29!|| finter ../engine/source/tools/curve/finter.F
30!||====================================================================
31 SUBROUTINE i11therm(
32 1 JLT ,PM ,INTTH ,PENRAD , KTHE ,
33 2 TEMPI1 ,TEMPI2 ,TEMPM1 ,TEMPM2 ,PHIS1 ,
34 3 PHIS2 ,TINT , AREAC ,IELECI ,IELESI ,
35 4 FRAD ,GAPV , FNI ,IFUNCTK ,XTHE ,
36 5 NPC ,DRAD ,TF ,HS1 ,HS2 ,
37 6 HM1 ,HM2 ,CONDINTS1, CONDINTS2,PHIM1,
38 7 PHIM2 ,CONDINTM1,CONDINTM2,IFORM )
39C-----------------------------------------------
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42#include "implicit_f.inc"
43C-----------------------------------------------
44C G l o b a l P a r a m e t e r s
45C-----------------------------------------------
46#include "mvsiz_p.inc"
47C-----------------------------------------------
48C C o m m o n B l o c k s
49C-----------------------------------------------
50#include "com08_c.inc"
51#include "param_c.inc"
52C-----------------------------------------------
53C D u m m y A r g u m e n t s
54C-----------------------------------------------
55 INTEGER JLT, IELECI(MVSIZ),NPC(*),IELESI(MVSIZ),
56 . IFUNCTK,INTTH,IFORM
57C REAL
58 my_real
59 . TINT,FRAD,DRAD,DYDX,XTHE,
60 . PM(NPROPM,*),TF(*),TEMPI1(MVSIZ),TEMPI2(MVSIZ),TEMPM1(MVSIZ),
61 . TEMPM2(MVSIZ),PENRAD(MVSIZ),PHIS1(MVSIZ),PHIS2(MVSIZ),
62 . kthe,areas1(mvsiz),areas2(mvsiz),gapv(mvsiz),
63 . fni(mvsiz),hs1(mvsiz), hs2(mvsiz), hm1(mvsiz), hm2(mvsiz),
64 . condints1(mvsiz),condints2(mvsiz),phim1(mvsiz),phim2(mvsiz),
65 . condintm1(mvsiz),condintm2(mvsiz),areac(mvsiz),phi(mvsiz),
66 . condint
67C
68C-----------------------------------------------
69C L o c a l V a r i a b l e s
70C-----------------------------------------------
71 INTEGER I, II,L,NB3M, I3N,LS,J,IE,MAT
72C REAL
73 my_real
74 . TS1, TS2, TM1 ,TM2, DIST, CONDS1 ,CONDS2 ,TSTIFM1 ,
75 . TSTIFM ,TSTIFT,TM,P,RSTIFF,TS,CONDM1,CONDM2,CONDS,CONDM,
76 . COND,RSTIF
77 my_real
78 . finter
79 EXTERNAL finter
80
81C-----------------------------------------------
82
83 IF (iform == 0) THEN ! Heat exchange MAIN ->SECONDARY
84C
85 IF(ifunctk==0)THEN ! KTHE =/ F(PEN)
86 rstif = one/max(em30,kthe)
87C
88 DO i=1,jlt
89 phis1(i) = zero
90 phis2(i) = zero
91 phim1(i) = zero
92 phim2(i) = zero
93C
94 ts1 = tempi1(i)
95 ts2 = tempi2(i)
96 ts = hs1(i)*ts1+hs2(i)*ts2
97 condints1(i) = zero
98 condints2(i) = zero
99 condintm1(i) = zero
100 condintm2(i) = zero
101C
102CC---------------------------------
103C PENRAD : PENETRATION FOR RADIATION
104C---------------------------------
105C Radiation if Gap < Dist < Dradiation
106 IF(penrad(i) <= zero) THEN
107C---------------------------------
108C Conduction
109C---------------------------------
110 mat = ieleci(i)
111 conds1 = pm(75,mat) + pm(76,mat)*ts1
112 conds2 = pm(75,mat) + pm(76,mat)*ts2
113 cond = hs1(i)*conds1 + hs2(i)*conds2
114 dist = penrad(i) + gapv(i)
115 tstifm = max(dist,zero) /cond
116 tstift = tstifm + rstif
117C
118 phi(i) = areac(i) * (tint - ts)*dt1 / tstift
119C
120 condint = areac(i)/tstift
121 condints1(i) = hs1(i) *condint
122 condints2(i) = hs2(i) *condint
123 ELSEIF(penrad(i) <= drad) THEN
124C---------------------------------
125C Radiation
126C---------------------------------
127 phi(i) = frad * areac(i) * (tint*tint+ts*ts)
128 . * (tint + ts) * (tint - ts) * dt1
129 ENDIF
130C
131 phis1(i) = hs1(i) * phi(i)
132 phis2(i) = hs2(i) * phi(i)
133C
134 ENDDO
135C
136 ELSE ! IFUNC
137C--------------------------------------------------------
138C CAS DES PAQUETS MIXTES OU QUADRANGLE
139C--------------------------------------------------------
140C
141 DO i=1,jlt
142 phis1(i) = zero
143 phis2(i) = zero
144 phim1(i) = zero
145 phim2(i) = zero
146C
147 ts1 = tempi1(i)
148 ts2 = tempi2(i)
149 ts = hs1(i)*ts1+hs2(i)*ts2
150 condints1(i) = zero
151 condints2(i) = zero
152 condintm1(i) = zero
153 condintm2(i) = zero
154C---------------------------------
155C CONTACT
156C---------------------------------
157
158C---------------------------------
159C PENRAD : PENETRATION FOR RADIATION
160C---------------------------------
161C Radiation if Gap < Dist < Dradiation
162
163
164 IF(penrad(i) <= zero) THEN
165C---------------------------------
166C Conduction
167C---------------------------------
168 mat = ieleci(i)
169
170C---------------------------------
171C CALCUL DE LA CONDUCTIBILITE
172C---------------------------------
173 p = xthe * fni(i) / areac(i)
174 rstiff = one /max(em30,finter(ifunctk,p,npc,tf,dydx)*kthe)
175 cond = pm(75,mat)+pm(76,mat)*ts
176 dist = penrad(i) + gapv(i)
177 tstifm = max(dist,zero) / cond
178 tstift = tstifm + rstiff
179
180 condint = areac(i)/tstift
181 condints1(i) = hs1(i) *condint
182 condints2(i) = hs2(i) *condint
183C ---
184 phi(i) = areac(i) * (tint - ts)*dt1 / tstift
185
186 ELSEIF(penrad(i) <= drad)THEN
187C---------------------------------
188C Radiation
189C---------------------------------
190 phi(i) = frad * areac(i) * (tint*tint+ts*ts)
191 . * (tint + ts) * (tint - ts) * dt1
192 ENDIF
193C
194 phis1(i) = hs1(i) * phi(i)
195 phis2(i) = hs2(i) * phi(i)
196C
197 ENDDO
198C
199 ENDIF
200
201 ELSE !IFORM
202C
203 IF(ifunctk==0)THEN ! KTHE =/ F(PEN)
204C--------------------------------------------------------
205C CAS DES PAQUETS MIXTES OU QUADRANGLE
206C--------------------------------------------------------
207C
208 rstif = one/max(em30,kthe)
209 DO i=1,jlt
210 phis1(i) = zero
211 phis2(i) = zero
212 phim1(i) = zero
213 phim2(i) = zero
214C
215 ts1 = tempi1(i)
216 ts2 = tempi2(i)
217 tm1 = tempm1(i)
218 tm2 = tempm2(i)
219 ts = hs1(i)*ts1+hs2(i)*ts2
220 tm = hm1(i)*tm1+hm2(i)*tm2
221 condints1(i) = zero
222 condints2(i) = zero
223 condintm1(i) = zero
224 condintm2(i) = zero
225C
226CC---------------------------------
227C PENRAD : PENETRATION FOR RADIATION
228C---------------------------------
229C Radiation if Gap < Dist < Dradiation
230 IF(penrad(i) <= zero) THEN
231C---------------------------------
232C Conduction
233C---------------------------------
234
235 mat = ieleci(i)
236 conds1 = pm(75,mat)+pm(76,mat)*ts1
237 conds2 = pm(75,mat)+pm(76,mat)*ts2
238 mat = ielesi(i)
239 condm1 = pm(75,mat)+pm(76,mat)*tm1
240 condm2 = pm(75,mat)+pm(76,mat)*tm2
241 conds = hs1(i)*conds1+hs2(i)*conds2
242 condm = hm1(i)*condm1+hm2(i)*condm2
243 cond = (condm+conds)/2
244 dist = penrad(i) + gapv(i)
245 tstifm = max(dist,zero) /cond
246 tstift = tstifm + rstif
247C
248 phi(i) = areac(i) * (tm - ts)*dt1 / tstift
249C
250 condint = areac(i)/tstift
251 condints1(i) = hs1(i) *condint
252 condints2(i) = hs2(i) *condint
253 condintm1(i) = hm1(i) *condint
254 condintm2(i) = hm2(i) *condint
255C
256 ELSEIF(penrad(i) <= drad) THEN
257C---------------------------------
258C Radiation
259C---------------------------------
260 phi(i) = frad * areac(i) * (tm*tm+ts*ts)
261 . * (tm + ts) * (tm - ts) * dt1
262 ENDIF
263C
264 phis1(i) = hs1(i) * phi(i)
265 phis2(i) = hs2(i) * phi(i)
266 phim1(i) = -hm1(i) * phi(i)
267 phim2(i) = -hm2(i) * phi(i)
268 ENDDO
269C
270 ELSE !IFUNC
271C
272 DO i=1,jlt
273 phis1(i) = zero
274 phis2(i) = zero
275 phim1(i) = zero
276 phim2(i) = zero
277C
278 ts1 = tempi1(i)
279 ts2 = tempi2(i)
280 tm1 = tempm1(i)
281 tm2 = tempm2(i)
282 ts = hs1(i)*ts1+hs2(i)*ts2
283 tm = hm1(i)*tm1+hm2(i)*tm2
284 condints1(i) = zero
285 condints2(i) = zero
286 condintm1(i) = zero
287 condintm2(i) = zero
288
289 IF(penrad(i) <= zero) THEN
290C---------------------------------
291C Conduction
292C---------------------------------
293 p = xthe * fni(i) / areac(i)
294 rstiff = one /max(em30,finter(ifunctk,p,npc,tf,dydx)*kthe)
295 mat = ieleci(i)
296 conds1 = pm(75,mat)+pm(76,mat)*ts1
297 conds2 = pm(75,mat)+pm(76,mat)*ts2
298 mat = ielesi(i)
299 condm1 = pm(75,mat)+pm(76,mat)*tm1
300 condm2 = pm(75,mat)+pm(76,mat)*tm2
301 conds = hs1(i)*conds1+hs2(i)*conds2
302 condm = hm1(i)*condm1+hm2(i)*condm2
303 cond = (condm+conds)/2
304 dist = penrad(i) + gapv(i)
305 tstifm = max(dist,zero) /cond
306 tstift = tstifm + rstiff
307
308 condint = areac(i)/tstift
309 condints1(i) = hs1(i) *condint
310 condints2(i) = hs2(i) *condint
311 condintm1(i) = hm1(i) *condint
312 condintm2(i) = hm2(i) *condint
313C ---
314 phi(i) = areac(i) * (tm - ts)*dt1 / tstift
315
316 ELSEIF(penrad(i) <= drad)THEN
317C---------------------------------
318C Radiation
319C---------------------------------
320 phi(i) = frad * areac(i) * (tm*tm+ts*ts)
321 . * (tm + ts) * (tm - ts) * dt1
322 ENDIF
323C
324 phis1(i) = hs1(i) * phi(i)
325 phis2(i) = hs2(i) * phi(i)
326 phim1(i) = -hm1(i) * phi(i)
327 phim2(i) = -hm2(i) * phi(i)
328C
329
330 ENDDO
331 ENDIF
332 ENDIF
333C
334 RETURN
335 END
i11mainf
subroutine i11mainf(timers, ipari, x, a, icodt, fsav, v, ms, dt2t, neltst, ityptst, itab, stifn, fskyi, isky, fcont, nin, lindmax, jtask, nb_jlt, nb_jlt_new, nb_stok_n, niskyfi, newfront, nstrf, secfcum, viscn, num_imp, ns_imp, ne_imp, mskyi_sms, iskyi_sms, nodnx_sms, icontact, intbuf_tab, pm, temp, fthe, ftheskyi, npc, tf, condn, condnskyi, fbsav6, isensint, dimfb, fsavsub, h3d_data, intbuf_fric_tab, itask, tagncont, kloadpinter, loadpinter, loadp_hyd_inter, dgaploadint, s_loadpinter, nodadt_therm)
Definition i11mainf.F:61
i11therm
subroutine i11therm(jlt, pm, intth, penrad, kthe, tempi1, tempi2, tempm1, tempm2, phis1, phis2, tint, areac, ieleci, ielesi, frad, gapv, fni, ifunctk, xthe, npc, drad, tf, hs1, hs2, hm1, hm2, condints1, condints2, phim1, phim2, condintm1, condintm2, iform)
Definition i11therm.F:39
max
#define max(a, b)
Definition macros.h:21