OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i2therm.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!|| i2therm ../engine/source/interfaces/interf/i2therm.F
25!||--- called by ------------------------------------------------------
26!|| intti2f ../engine/source/interfaces/interf/intti2f.F
27!||====================================================================
28 SUBROUTINE i2therm(X ,NSN ,NSV ,IRTL ,MS ,
29 . WEIGHT ,IRECT ,CRST ,IADI2 ,KTHE ,
30 . TEMP ,AREAS ,FTHE ,FTHESKYI,CONDN ,
31 . CONDNSKYI,I0 ,ITAB ,IDT_THERM ,THEACCFACT)
32C-----------------------------------------------
33C I m p l i c i t T y p e s
34C-----------------------------------------------
35#include "implicit_f.inc"
36C-----------------------------------------------
37C C o m m o n B l o c k s
38C-----------------------------------------------
39#include "com08_c.inc"
40#include "scr18_c.inc"
41#include "parit_c.inc"
42C-----------------------------------------------
43C D u m m y A r g u m e n t s
44C-----------------------------------------------
45 INTEGER NSN,I0
46 INTEGER IRECT(4,*),NSV(*),IRTL(*),WEIGHT(*), IADI2(4,*),ITAB(*)
47 INTEGER ,intent(in) :: IDT_THERM
48 my_real ,intent(in) :: theaccfact
49 my_real :: kthe
50 my_real :: x(3,*),temp(*),ms(*),crst(2,*),areas(*),fthe(*),ftheskyi(*),
51 . condn(*),condnskyi(*)
52C-----------------------------------------------
53C L o c a l V a r i a b l e s
54C-----------------------------------------------
55 INTEGER I, II,L,W,IX1,IX2,IX3,IX4,NN
56C REAL
57 my_real
58 . s, t, sp ,sm , tp, tm ,h1,h2,h3,h4,ax1,ay1,az1,ax2,ay2,az2,ax,ay,az,
59 . phi1,phi2,phi3,phi4,aream,areac,temps,tempm,phi,condint
60
61C-----------------------------------------------
62
63 DO ii=1,nsn
64 i=nsv(ii)
65C
66 IF(i>0)THEN
67 l=irtl(ii)
68C
69 w = weight(i)
70 s = crst(1,ii)
71 t = crst(2,ii)
72 sp=one + s
73 sm=one - s
74 tp=fourth*(one + t)
75 tm=fourth*(one - t)
76C
77 ix1 = irect(1,l)
78 ix2 = irect(2,l)
79 ix3 = irect(3,l)
80 ix4 = irect(4,l)
81 IF(ix3==ix4) THEN
82 h1=tm*sm
83 h2=tm*sp
84 h3=one-h1-h2
85 h4=zero
86 ELSE
87 h1=tm*sm
88 h2=tm*sp
89 h3=tp*sp
90 h4=tp*sm
91 ENDIF
92C
93 ax1 = x(1,ix3) - x(1,ix1)
94 ay1 = x(2,ix3) - x(2,ix1)
95 az1 = x(3,ix3) - x(3,ix1)
96 ax2 = x(1,ix4) - x(1,ix2)
97 ay2 = x(2,ix4) - x(2,ix2)
98 az2 = x(3,ix4) - x(3,ix2)
99C
100 ax = ay1*az2 - az1*ay2
101 ay = az1*ax2 - ax1*az2
102 az = ax1*ay2 - ay1*ax2
103C
104 aream = one_over_8*sqrt(ax*ax+ay*ay+az*az)
105 areac = min(areas(ii),aream)
106C
107 temps = temp(i)
108 tempm = h1*temp(ix1)+h2*temp(ix2)+h3*temp(ix3)+h4*temp(ix4)
109C
110 phi = areac*(tempm - temps)*dt1*kthe*theaccfact
111
112C
113 condint = areac*kthe*theaccfact
114
115 phi1 = -phi *h1
116 phi2 = -phi *h2
117 phi3 = -phi *h3
118 phi4 = -phi *h4
119c
120 fthe(i)=fthe(i)+phi
121
122 IF(idt_therm == 1) condn(i) = condn(i) + condint*w
123c
124 IF (iparit == 0.AND.w == 1) THEN
125 fthe(ix1)=fthe(ix1)+phi1
126 fthe(ix2)=fthe(ix2)+phi2
127 fthe(ix3)=fthe(ix3)+phi3
128 fthe(ix4)=fthe(ix4)+phi4
129 IF(idt_therm == 1) THEN
130 condn(ix1)=condn(ix1)+abs(h1)*condint
131 condn(ix2)=condn(ix2)+abs(h2)*condint
132 condn(ix3)=condn(ix3)+abs(h3)*condint
133 condn(ix4)=condn(ix4)+abs(h4)*condint
134 ENDIF
135 ELSEIF (iparit > 0.AND.w == 1) THEN
136 i0 = i0 + 1
137 nn = iadi2(1,i0)
138 ftheskyi(nn)=phi1
139 nn = iadi2(2,i0)
140 ftheskyi(nn)=phi2
141 nn = iadi2(3,i0)
142 ftheskyi(nn)=phi3
143 nn = iadi2(4,i0)
144 ftheskyi(nn)=phi4
145 IF(idt_therm == 1) THEN
146 nn = iadi2(1,i0)
147 condnskyi(nn)=abs(h1)*condint
148 nn = iadi2(2,i0)
149 condnskyi(nn)=abs(h2)*condint
150 nn = iadi2(3,i0)
151 condnskyi(nn)=abs(h3)*condint
152 nn = iadi2(4,i0)
153 condnskyi(nn)=abs(h4)*condint
154 ENDIF
155 ENDIF
156 ELSE
157 l = irtl(ii)
158C
159 ix1 = irect(1,l)
160 ix2 = irect(2,l)
161 ix3 = irect(3,l)
162 ix4 = irect(4,l)
163 fthe(i)= zero
164 fthe(ix1)=zero
165 fthe(ix2)=zero
166 fthe(ix3)=zero
167 fthe(ix4)=zero
168 condn(i)= zero
169 condn(ix1)=zero
170 condn(ix2)=zero
171 condn(ix3)=zero
172 condn(ix4)=zero
173 ENDIF
174 ENDDO
175C
176 RETURN
177 END
178
179
180
my_real
#define my_real
Definition cppsort.cpp:32
i2therm
subroutine i2therm(x, nsn, nsv, irtl, ms, weight, irect, crst, iadi2, kthe, temp, areas, fthe, ftheskyi, condn, condnskyi, i0, itab, idt_therm, theaccfact)
Definition i2therm.F:32
min
#define min(a, b)
Definition macros.h:20