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

Go to the source code of this file.

Functions/Subroutines

subroutine thermexpc (elbuf_str, jft, jlt, forth, for, eint, off, eth, thk0, exx, eyy, pm, npt, area, a1, a2, mat, mtn, eintth, dir, ir, is, nlay, thk, nel, igtyp, npf, tf, ipm, tempel, dtemp, thkly, posly, mom, matly)

Function/Subroutine Documentation

◆ thermexpc()

subroutine thermexpc ( type(elbuf_struct_), target elbuf_str,
integer jft,
integer jlt,
forth,
for,
eint,
off,
eth,
thk0,
exx,
eyy,
pm,
integer npt,
area,
a1,
a2,
integer, dimension(mvsiz) mat,
integer mtn,
eintth,
dir,
integer ir,
integer is,
integer nlay,
thk,
integer nel,
integer igtyp,
integer, dimension(*) npf,
tf,
integer, dimension(npropmi,*) ipm,
tempel,
dtemp,
thkly,
posly,
mom,
integer, dimension(*) matly )

Definition at line 32 of file thermexpc.F.

40C-----------------------------------------------
41C M o d u l e s
42C-----------------------------------------------
43 USE elbufdef_mod
44C-----------------------------------------------
45C I m p l i c i t T y p e s
46C-----------------------------------------------
47#include "implicit_f.inc"
48C-----------------------------------------------
49C G l o b a l P a r a m e t e r s
50C-----------------------------------------------
51#include "mvsiz_p.inc"
52C-----------------------------------------------
53C C o m m o n B l o c k s
54C-----------------------------------------------
55#include "param_c.inc"
56C-----------------------------------------------
57C D u m m y A r g u m e n t s
58C-----------------------------------------------
59 INTEGER JFT, JLT,NPT,MTN,NSG,IR,IS,NLAY,
60 . MAT(MVSIZ),NEL,MATLY(*),IPM(NPROPMI,*),IGTYP,
61 . NPF(*)
62C REAL
63 my_real
64 . for(nel,5), forth(nel,2), eint(jlt,2), eintth(*),
65 . off(*),eintt(mvsiz),dir(nel,2),thk(*), pm(npropm,*),
66 . thkly(*),dtemp(*),tempel(*),tf(*),posly(mvsiz,*),
67 . mom(nel,3)
68 my_real
69 . exx(mvsiz), eyy(mvsiz), eth(mvsiz),thk0(mvsiz) ,
70 . area(mvsiz),pla(mvsiz),a1(mvsiz), a2(mvsiz)
71 TYPE(ELBUF_STRUCT_), TARGET :: ELBUF_STR
72C-----------------------------------------------
73C L o c a l V a r i a b l e s
74C-----------------------------------------------
75 INTEGER I, MX, J,IORTH,IPT,ILAY,II(5),NPTT,IT,
76 . IORTH_LAY,IFUNC_ALPHA,J1,J2,J3,JJ,IPT_ALL
77C REAL
78 my_real
79 . dtinv, amu, fact, visc,m12,anu12,anu21,s1,s2,
80 . fscal_alpha,alpha,deintth,df,wmc,aa,thklay,kxx,kyy
81 my_real
82 . nu(mvsiz),e(mvsiz),a12(mvsiz),
83 . e11(mvsiz), e22(mvsiz),
84 . b3(mvsiz), degmb(mvsiz), degfx(mvsiz),degmbth(mvsiz),
85 . ezz(mvsiz),einf(mvsiz),p(mvsiz),degfxth(mvsiz),
86 . p1(mvsiz),p2(mvsiz),ethke(mvsiz),zi2(mvsiz),sumalz(mvsiz)
87 TYPE(BUF_LAY_) ,POINTER :: BUFLY
88 TYPE(L_BUFEL_) ,POINTER :: LBUF
89C-----------------------------------------------
90 my_real finter
91 EXTERNAL finter
92C-----------------------------------------------
93 DO i=1,5
94 ii(i) = nel*(i-1)
95 ENDDO
96C-------- 1st Step : Elasticity matrix-----------------------
97 iorth_lay = 0
98 iorth= -1! not activated
99 IF(igtyp == 11 .OR. igtyp == 17 .OR. igtyp == 51 .OR. igtyp == 52) THEN
100 iorth_lay = 1
101 ELSEIF (mtn==19.OR.mtn==15.OR.mtn==25) THEN
102 iorth=1
103 ELSE
104 iorth=0
105 ENDIF
106C
107 IF(iorth == 1) THEN
108 mx =mat(jft)
109 DO i=jft,jlt
110 e(i) = pm(20,mx)
111 nu(i) = pm(21,mx)
112 a1(i) = pm(24,mx)
113 a2(i) = pm(25,mx)
114C
115 e11(i) = pm(33,mx)
116 e22(i) = pm(34,mx)
117 anu12 = pm(35,mx)
118 anu21 = pm(36,mx)
119C
120 a12(i) = (1.-anu12*anu21)
121 a1(i) = e11(i)/a12(i)
122 a2(i) = e22(i)/a12(i)
123 a12(i) = anu21*a1(i)
124 ENDDO
125 ENDIF
126C-------- 2nd Step : Thermal stress computation -----------------------
127
128 IF(iorth ==0)THEN
129 mx =mat(jft)
130 DO i=jft,jlt
131 p(i) =(a1(i)+a2(i))*eth(i)
132 forth(i,1)=forth(i,1)+ p(i)
133 forth(i,2)=forth(i,2)+ p(i)
134 END DO
135 ELSEIF(iorth == 1) THEN
136 DO i=jft,jlt
137 p1(i) = a1(i)*eth(i)+a12(i)*eth(i)
138 p2(i) = a12(i)*eth(i)+a2(i)*eth(i)
139 s1 = dir(i,1)*dir(i,1)*p1(i)
140 . + dir(i,2)*dir(i,2)*p2(i)
141 s2 = dir(i,2)*dir(i,2)*p1(i)
142 . + dir(i,1)*dir(i,1)*p2(i)
143 forth(i,1)=forth(i,1)+ s1
144 forth(i,2)=forth(i,2)+ s2
145 END DO
146 ENDIF
147C
148C
149 IF(iorth_lay > 0 ) THEN
150 ethke(jft : jlt) = zero
151 IF(mtn == 15 .OR. mtn == 25) THEN
152 ipt_all = 0
153 DO ilay=1,nlay
154 nptt = elbuf_str%BUFLY(ilay)%NPTT
155 j1 = 1+(ilay-1)*jlt ! JMLY
156 j3 = 1+(ilay-1)*jlt*2 ! jdir
157 DO it=1,nptt
158 lbuf => elbuf_str%BUFLY(ilay)%LBUF(ir,is,it)
159 ipt = ipt_all + it ! count all NPTT through all layers
160 j2 = 1+(ipt-1)*jlt ! JPOS
161 DO i=jft,jlt
162 jj = j2 - 1 + i
163 mx = matly(j1+i-1)
164C
165 e11(i) = pm(33,mx)
166 e22(i) = pm(34,mx)
167 anu12 = pm(35,mx)
168 anu21 = pm(36,mx)
169C
170 ifunc_alpha = ipm(219, mx)
171 fscal_alpha = pm(191, mx)
172 alpha = finter(ifunc_alpha,tempel(i),npf,tf,df)
173 alpha = alpha * fscal_alpha
174 eth(i) = alpha*dtemp(i)
175C
176 a12(i) = (one - anu12*anu21)
177 a1(i) = e11(i)/a12(i)
178 a2(i) = e22(i)/a12(i)
179 a12(i) = anu21*a1(i)
180C
181 p1(i) = a1(i)*eth(i ) + a12(i)*eth(i)
182 p2(i) = a12(i)*eth(i) + a2(i)*eth(i)
183C
184 lbuf%SIG(ii(1)+i)=lbuf%SIG(ii(1)+i) - p1(i)
185 lbuf%SIG(ii(2)+i)=lbuf%SIG(ii(2)+i) - p2(i)
186C
187 for(i,1)=for(i,1) - thkly(jj)*p1(i)
188 for(i,2)=for(i,2) - thkly(jj)*p2(i)
189C
190 wmc = posly(i,ipt)*thkly(jj)
191 mom(i,1) = mom(i,1) - wmc*p1(i)
192 mom(i,2) = mom(i,2) - wmc*p2(i)
193C
194 thklay = thkly(jj)*thk0(i)
195 ethke(i) = ethke(i) + thklay*eth(i)
196 ENDDO
197 ENDDO !! DO IT=1,NPTT
198 ipt_all = ipt_all + nptt
199 ENDDO ! DO ILAY=1,NLAY
200 ELSEIF(mtn > 26) THEN
201 aa = zero
202 ipt_all = 0
203 zi2(jft:jlt) = zero
204 sumalz(jft:jlt) = zero
205 DO ilay=1,nlay
206 nptt = elbuf_str%BUFLY(ilay)%NPTT
207 j1 = 1+(ilay-1)*jlt ! JMLY
208 j3 = 1+(ilay-1)*jlt*2
209 DO it=1,nptt
210 lbuf => elbuf_str%BUFLY(ilay)%LBUF(ir,is,it)
211 ipt = ipt_all + it ! count all NPTT through all layers
212 j2 = 1+(ipt-1)*jlt ! JPOS
213 DO i=jft,jlt
214 jj = j2 - 1 + i
215 mx = matly(j1+i-1)
216 e(i) = pm(20,mx)
217 nu(i) = pm(21,mx)
218 a1(i) = pm(24,mx)
219 a2(i) = pm(25,mx)
220 a1(i) = e(i)/ (one - nu(i)*nu(i))
221 a2(i) = nu(i)*a1(i)
222C
223 ifunc_alpha = ipm(219, mx)
224 fscal_alpha = pm(191, mx)
225 alpha = finter(ifunc_alpha,tempel(i),npf,tf,df)
226 alpha = alpha * fscal_alpha
227 eth(i) = alpha*dtemp(i)
228C
229 p(i) = a1(i)*eth(i) + a2(i)*eth(i)
230C
231 lbuf%SIG(ii(1)+i)=lbuf%SIG(ii(1)+i) - p(i)
232 lbuf%SIG(ii(2)+i)=lbuf%SIG(ii(2)+i) - p(i)
233C forces
234 for(i,1)=for(i,1) - thkly(jj)*p(i)
235 for(i,2)=for(i,2) - thkly(jj)*p(i)
236C
237 wmc = posly(i,ipt)*thkly(jj)
238 mom(i,1) = mom(i,1) - wmc*p(i)
239 mom(i,2) = mom(i,2) - wmc*p(i)
240!! ZI2(I) = ZI2(I) + POSLY(I,IPT)**2
241!! SUMALZ(I) = SUMALZ(I) + POSLY(I,IPT)* ETH(I)
242C
243 thklay = thkly(jj)*thk0(i)
244 ethke(i) = ethke(i) + thklay*eth(i)
245 ENDDO ! I
246 ENDDO !! DO IT=1,NPTT
247 ipt_all = ipt_all + nptt
248 ENDDO ! DO ILAY=1,NLAY
249 ENDIF
250
251 DO i=jft,jlt
252C-------- 3rd Step : Energies computation -----------------------
253!! KXX = SUMALZ(I)/ ZI2(I)
254!! KYY = KXX
255!! DEGFXTH(I) = -( MOM(I,1)*KXX + MOM(I,2)*KYY)*HALF*THK0(I)*THK0(I)*AREA(I) ! depending to kxx et kyy
256 degmbth(i) = -(for(i,1)+for(i,2))*ethke(i)*half*area(i)
257 eintth(i) = eintth(i) + degmbth(i)
258 eint(i,1) = eint(i,1) + degmbth(i)
259!! EINT(I,2) = EINT(I,2) + DEGFXTH(I)
260C------Thickness change due to thermal expansion-------
261 thk(i) = (thk(i) + ethke(i))*off(i)
262 ENDDO
263 ELSE
264 IF(npt/=0) THEN
265 DO ilay=1,nlay
266 nptt = elbuf_str%BUFLY(ilay)%NPTT
267 DO it=1,nptt
268 lbuf => elbuf_str%BUFLY(ilay)%LBUF(ir,is,it)
269 IF(iorth ==0)THEN
270 DO i=jft,jlt
271 lbuf%SIG(ii(1)+i)=lbuf%SIG(ii(1)+i)-p(i)
272 lbuf%SIG(ii(2)+i)=lbuf%SIG(ii(2)+i)-p(i)
273 ENDDO
274 ELSE
275 DO i=jft,jlt
276 lbuf%SIG(ii(1)+i)=lbuf%SIG(ii(1)+i)-p1(i)
277 lbuf%SIG(ii(2)+i)=lbuf%SIG(ii(2)+i)-p2(i)
278 ENDDO
279 ENDIF
280 ENDDO
281 ENDDO
282 ENDIF
283 IF(iorth ==0)THEN
284 DO i=jft,jlt
285 for(i,1)=for(i,1) - p(i)
286 for(i,2)=for(i,2) - p(i)
287 ENDDO
288 ELSE
289 DO i=jft,jlt
290 for(i,1)=for(i,1) - p1(i)
291 for(i,2)=for(i,2) - p2(i)
292 ENDDO
293 ENDIF
294C
295C-------- 3rd Step : Energies computation -----------------------
296 DO i=jft,jlt
297 degmbth(i) = -(for(i,1)+for(i,2))*eth(i)*half*thk0(i)*area(i)
298 END DO
299
300 DO i=jft,jlt
301 eintth(i) = eintth(i) + degmbth(i)
302 eint(i,1) = eint(i,1) + degmbth(i)
303 ENDDO
304C------Thickness change due to thermal expansion-------
305 DO i=jft,jlt
306 thk(i) = thk(i) *(1 + eth(i))*off(i)
307 ENDDO
308 ENDIF ! IORTH_LAY > 0
309C
310 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
alpha
#define alpha
Definition eval.h:35
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91