OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
szhour3.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "param_c.inc"
#include "com04_c.inc"
#include "com08_c.inc"
#include "scr14_c.inc"
#include "novectorize_gfortran.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine szhour3 (elbuf_str, pm, rho, off, vx1, vx2, vx3, vx4, vx5, vx6, vx7, vx8, vy1, vy2, vy3, vy4, vy5, vy6, vy7, vy8, vz1, vz2, vz3, vz4, vz5, vz6, vz7, vz8, f11, f21, f31, f12, f22, f32, f13, f23, f33, f14, f24, f34, f15, f25, f35, f16, f26, f36, f17, f27, f37, f18, f28, f38, px1h1, px1h2, px1h3, px1h4, px2h1, px2h2, px2h3, px2h4, px3h1, px3h2, px3h3, px3h4, px4h1, px4h2, px4h3, px4h4, vol, mat, cxx, vis, vd2, deltax, pid, geo, partsav, iparts, dxx, dyy, dzz, d4, d5, d6, fhour, jr0, js0, jt0, eint, vol0, sigy, sig0, sigold, icp, defp, matvis, et, d_max, nel, strhg, istrain, mtn, ismstr, jlag, iint)

Function/Subroutine Documentation

◆ szhour3()

subroutine szhour3 ( type (elbuf_struct_), target elbuf_str,
pm,
rho,
off,
vx1,
vx2,
vx3,
vx4,
vx5,
vx6,
vx7,
vx8,
vy1,
vy2,
vy3,
vy4,
vy5,
vy6,
vy7,
vy8,
vz1,
vz2,
vz3,
vz4,
vz5,
vz6,
vz7,
vz8,
f11,
f21,
f31,
f12,
f22,
f32,
f13,
f23,
f33,
f14,
f24,
f34,
f15,
f25,
f35,
f16,
f26,
f36,
f17,
f27,
f37,
f18,
f28,
f38,
px1h1,
px1h2,
px1h3,
px1h4,
px2h1,
px2h2,
px2h3,
px2h4,
px3h1,
px3h2,
px3h3,
px3h4,
px4h1,
px4h2,
px4h3,
px4h4,
vol,
integer, dimension(*) mat,
cxx,
vis,
vd2,
deltax,
integer, dimension(*) pid,
geo,
partsav,
integer, dimension(*) iparts,
dxx,
dyy,
dzz,
d4,
d5,
d6,
fhour,
jr0,
js0,
jt0,
eint,
vol0,
sigy,
sig0,
sigold,
integer icp,
defp,
integer matvis,
et,
d_max,
integer nel,
strhg,
integer istrain,
integer, intent(in) mtn,
integer, intent(in) ismstr,
integer, intent(in) jlag,
integer, intent(in) iint )

Definition at line 35 of file szhour3.F.

63C-----------------------------------------------
64C M o d u l e s
65C-----------------------------------------------
66 USE elbufdef_mod
67C-----------------------------------------------
68C I m p l i c i t T y p e s
69C-----------------------------------------------
70#include "implicit_f.inc"
71C-----------------------------------------------
72C G l o b a l P a r a m e t e r s
73C-----------------------------------------------
74#include "mvsiz_p.inc"
75C-----------------------------------------------
76C C o m m o n B l o c k s
77C-----------------------------------------------
78#include "param_c.inc"
79#include "com04_c.inc"
80#include "com08_c.inc"
81#include "scr14_c.inc"
82C-----------------------------------------------
83C D u m m y A r g u m e n t s
84C-----------------------------------------------
85 INTEGER, INTENT(IN) :: MTN
86 INTEGER, INTENT(IN) :: ISMSTR
87 INTEGER, INTENT(IN) :: JLAG
88 INTEGER, INTENT(IN) :: IINT
89 INTEGER NEL,ISTRAIN
90 my_real
91 . pm(npropm,*),geo(npropg,*), rho(*),off(*),
92 . vx1(*),vx2(*),vx3(*),vx4(*),vx5(*),vx6(*),vx7(*),vx8(*),
93 . vy1(*),vy2(*),vy3(*),vy4(*),vy5(*),vy6(*),vy7(*),vy8(*),
94 . vz1(*),vz2(*),vz3(*),vz4(*),vz5(*),vz6(*),vz7(*),vz8(*),
95 . f11(*),f21(*),f31(*),f12(*),f22(*),f32(*),
96 . f13(*),f23(*),f33(*),f14(*),f24(*),f34(*),
97 . f15(*),f25(*),f35(*),f16(*),f26(*),f36(*),
98 . f17(*),f27(*),f37(*),f18(*),f28(*),f38(*),
99 . px1h1(*), px1h2(*), px1h3(*), px1h4(*),
100 . px2h1(*), px2h2(*), px2h3(*), px2h4(*),
101 . px3h1(*), px3h2(*), px3h3(*), px3h4(*),
102 . px4h1(*), px4h2(*), px4h3(*), px4h4(*),
103 . partsav(npsav,*),
104 . vol(*),cxx(*),vis(*),vd2(*),deltax(*),
105 . fhour(nel,3,4),jr0(*),js0(*),jt0(*) ,eint(*),
106 . dxx(*), dyy(*), dzz(*), d4(*), d5(*), d6(*) ,
107 . sigy(*) ,sig0(nel,6),vol0(*),sigold(nel,6),defp(*),et(*),
108 . d_max(*),strhg(nel,18)
109 INTEGER MAT(*),PID(*),IPARTS(*),ICP,MATVIS
110 TYPE (ELBUF_STRUCT_), TARGET :: ELBUF_STR
111C-----------------------------------------------
112C L o c a l V a r i a b l e s
113C-----------------------------------------------
114 INTEGER I, MX, J,K,IET, MT,IPLAST
115 my_real
116 . caq(mvsiz), fcl(mvsiz), fcq(mvsiz),deint(mvsiz),
117 . h11(mvsiz), h22(mvsiz), h33(mvsiz),
118 . h12(mvsiz), h13(mvsiz), h23(mvsiz),
119 . hgx1(mvsiz), hgx2(mvsiz), hgx3(mvsiz), hgx4(mvsiz),
120 . hgy1(mvsiz), hgy2(mvsiz), hgy3(mvsiz), hgy4(mvsiz),
121 . hgz1(mvsiz), hgz2(mvsiz), hgz3(mvsiz), hgz4(mvsiz),
122 . vx3478, vx2358, vx1467, vx1256,
123 . vy3478, vy2358, vy1467, vy1256,
124 . vz3478, vz2358, vz1467, vz1256,
125 . vx17, vy17, vz17,
126 . vx28, vy28, vz28,
127 . vx35, vy35, vz35,
128 . vx46, vy46, vz46,
129 . g_3dt(mvsiz),nu,gg(mvsiz),de,ds,dsig(6),
130 . sm1(mvsiz),sm2(mvsiz),smo1(mvsiz),smo2(mvsiz),smo,
131 . jr_1(mvsiz),js_1(mvsiz),jt_1(mvsiz),nfhour(mvsiz,3,4),
132 . dfhour(mvsiz,3,4),fhourt(3,4),dt05,rho0,etmax,
133 . nu1(mvsiz),nu2(mvsiz),nu3(mvsiz),nu4(mvsiz),nep,e0(mvsiz),
134 . e_r,e_s,e_t,fac,fac1,fac2,coefh,hq13p,hq13n,hq24p,hq24n,ff,
135 . sig0v(mvsiz,6),dama_g(mvsiz,6),g0,c1
136C-----------------------------------------------
137 iet =iint
138 coefh = zep9999
139C---- attention : r->eta; s->zeta; t->ksi------------
140
141C +++ MAT Visco-----
142! DO I=1,NEL
143! SIG0V(I,1) = SIG0(I,1)
144! SIG0V(I,2) = SIG0(I,2)
145! SIG0V(I,3) = SIG0(I,3)
146! SIG0V(I,4) = SIG0(I,4)
147! SIG0V(I,5) = SIG0(I,5)
148! SIG0V(I,6) = SIG0(I,6)
149! ENDDO
150 mx = mat(1)
151 rho0=pm(1,mx)
152 nu=pm(21,mx)
153 g0=pm(22,mx)
154 c1=pm(32,mx)
155 iplast = elbuf_str%GBUF%G_PLA
156 SELECT CASE (mtn)
157C +++ MAT Hydro---
158 CASE (3,4,6,70)
159 DO i=1,nel
160 gg(i)=max(g0,vis(i))
161 ENDDO
162C +++ MAT Hyper-elas----Et=1
163 CASE (62,95)
164 DO i=1,nel
165 gg(i) = 0.75*(rho(i)*cxx(i)*cxx(i)-c1)
166 ENDDO
167C +++ MAT Hyper-elas----Et>1
168 CASE (42,69,82,92,94)
169 gg(1:nel)=g0
170 CASE DEFAULT
171 DO i=1,nel
172 gg(i)=half*rho0*cxx(i)*cxx(i)*(one -two*nu)/(one-nu)
173 ENDDO
174 END SELECT
175C
176C
177 IF (mtn==1.AND.ismstr>=10) THEN
178 DO i=1,nel
179 ff = -min(sig0(i,1),sig0(i,2),sig0(i,3))
180 fac1 = max(one,half*ff/g0)
181 fac = one
182 IF (fac1>one) fac = onep2*fac1
183 gg(i)=fac*gg(i)
184 ENDDO
185 END IF
186C----
187 IF (iet > 1 .AND. matvis>0 ) THEN
188 CALL szetfac(1,nel,iet,mtn,et,gg )
189 ELSEIF (matvis==1.AND.ismstr<10) THEN
190 DO i=1,nel
191 ff=third*(dxx(i)+dyy(i)+dzz(i))
192 de =(dxx(i)-ff)*(dxx(i)-ff)+(dyy(i)-ff)*(dyy(i)-ff)+
193 . (dzz(i)-ff)*(dzz(i)-ff) + fourth*(d4(i)*d4(i)+
194 . d5(i)*d5(i)+d6(i)*d6(i))
195 de = de*dt1
196 dsig(1)=sig0(i,1)-sigold(i,1)
197 dsig(2)=sig0(i,2)-sigold(i,2)
198 dsig(3)=sig0(i,3)-sigold(i,3)
199 dsig(4)=sig0(i,4)-sigold(i,4)
200 dsig(5)=sig0(i,5)-sigold(i,5)
201 dsig(6)=sig0(i,6)-sigold(i,6)
202 ff= third*(dsig(1)+dsig(2)+dsig(3))
203 dsig(1)=dsig(1)-ff
204 dsig(2)=dsig(2)-ff
205 dsig(3)=dsig(3)-ff
206 ds =dsig(1)*dsig(1)+dsig(2)*dsig(2)+dsig(3)*dsig(3)+
207 . dsig(4)*dsig(4)+dsig(5)*dsig(5)+dsig(6)*dsig(6)
208 gg(i)=max(fiveem2*gg(i),sqrt(ds/max(de,em30)))
209 ENDDO
210 ENDIF
211C
212 IF(invstr>=35)THEN
213 mt = pid(1)
214 DO i=1,nel
215 caq(i)=fourth*off(i)*geo(13,mt)
216 ENDDO
217 ELSE
218 mx = mat(1)
219 DO i=1,nel
220 caq(i)=fourth*off(i)*pm(4,mx)
221 ENDDO
222 ENDIF
223 DO i=1,nel
224 g_3dt(i)=third*off(i)*gg(i)*dt1
225 e0(i)=two*(one+nu)*gg(i)
226 ENDDO
227C
228C MATERIAUX NON FLUIDES CXX->SPP
229 IF (iet > 1 ) THEN
230C------now when IHKT=2, w.r.t. Isolid=1, fac=0.2*0.006666 ~0.001
231#include "novectorize_gfortran.inc"
232 DO i=1,nel
233 fcl(i)=onep1*caq(i)*rho(i)*vol(i)**third
234 fcl(i)=zep00666666667*fcl(i)*cxx(i)
235 ENDDO
236 ELSE
237#include "novectorize_gfortran.inc"
238 DO i=1,nel
239 fcl(i)=caq(i)*rho(i)*vol(i)**third
240 fcl(i)=zep00666666667*fcl(i)*cxx(i)
241 ENDDO
242 END IF
243C------ w/ Prony, use Icpre=0 anyway
244 IF (matvis>2) THEN
245 DO i=1,nel
246 nu1(i) =two/(one-nu)
247 nu2(i) =nu*nu1(i)
248 nu3(i) =two_third*(one + nu)
249 nu4(i) =nu
250 ENDDO
251 ELSEIF(mtn==1.AND.(ismstr>=10))THEN
252 DO i=1,nel
253 nu1(i) =two/(one-nu)
254 nu2(i) =nu*nu1(i)
255 nu3(i) =two_third*(one + nu)
256 nu4(i) =nu
257 ENDDO
258 ELSEIF(icp==1.AND.mtn/=92)THEN
259 DO i=1,nel
260 nu1(i) =four_over_3
261 nu2(i) =-two_third
262 nu3(i) =zep444
263 nu4(i) =zero
264 ENDDO
265 ELSEIF(icp==2.AND.iplast>0)THEN
266 DO i=1,nel
267 fac1 = sigy(i)/e0(i)+defp(i)
268 fac2=one-defp(i)/fac1
269 ff =(one +nu)/(one -two*nu)*fac2
270 nu1(i) =two_third*(two+ff)
271 nu2(i) =two_third*(ff-one)
272 nu3(i) =zep222*(two+ff)
273 nu4(i) =zero
274 ENDDO
275 ELSE
276 DO i=1,nel
277 nu1(i) =two/(one-nu)
278 nu2(i) =nu*nu1(i)
279 nu3(i) =two_third*(one + nu)
280 nu4(i) =nu
281 ENDDO
282 ENDIF
283 dt05 =half*dt1
284 DO i=1,nel
285 vx3478=vx3(i)-vx4(i)-vx7(i)+vx8(i)
286 vx2358=vx2(i)-vx3(i)-vx5(i)+vx8(i)
287 vx1467=vx1(i)-vx4(i)-vx6(i)+vx7(i)
288 vx1256=vx1(i)-vx2(i)-vx5(i)+vx6(i)
289C
290 vy3478=vy3(i)-vy4(i)-vy7(i)+vy8(i)
291 vy2358=vy2(i)-vy3(i)-vy5(i)+vy8(i)
292 vy1467=vy1(i)-vy4(i)-vy6(i)+vy7(i)
293 vy1256=vy1(i)-vy2(i)-vy5(i)+vy6(i)
294C
295 vz3478=vz3(i)-vz4(i)-vz7(i)+vz8(i)
296 vz2358=vz2(i)-vz3(i)-vz5(i)+vz8(i)
297 vz1467=vz1(i)-vz4(i)-vz6(i)+vz7(i)
298 vz1256=vz1(i)-vz2(i)-vz5(i)+vz6(i)
299!
300 hgx3(i)=(vx1467-vx2358)*one_over_8
301 hgx1(i)=(vx1467+vx2358)*one_over_8
302 hgx2(i)=(vx1256-vx3478)*one_over_8
303 hgx4(i)=-(vx1256+vx3478)*one_over_8
304C
305 hgy3(i)=(vy1467-vy2358)*one_over_8
306 hgy1(i)=(vy1467+vy2358)*one_over_8
307 hgy2(i)=(vy1256-vy3478)*one_over_8
308 hgy4(i)=-(vy1256+vy3478)*one_over_8
309C
310 hgz3(i)=(vz1467-vz2358)*one_over_8
311 hgz1(i)=(vz1467+vz2358)*one_over_8
312 hgz2(i)=(vz1256-vz3478)*one_over_8
313 hgz4(i)=-(vz1256+vz3478)*one_over_8
314 ENDDO
315 DO i=1,nel
316 vx17=vx1(i)-vx7(i)
317 vx28=vx2(i)-vx8(i)
318 vx35=vx3(i)-vx5(i)
319 vx46=vx4(i)-vx6(i)
320 vy17=vy1(i)-vy7(i)
321 vy28=vy2(i)-vy8(i)
322 vy35=vy3(i)-vy5(i)
323 vy46=vy4(i)-vy6(i)
324 vz17=vz1(i)-vz7(i)
325 vz28=vz2(i)-vz8(i)
326 vz35=vz3(i)-vz5(i)
327 vz46=vz4(i)-vz6(i)
328C alpha =1 ->eta zeta
329C 1 1 -1 -1 -1 -1 1 1
330 hgx1(i)= hgx1(i)
331 & -(px1h1(i)*vx17+px2h1(i)*vx28
332 & +px3h1(i)*vx35+px4h1(i)*vx46)
333 hgy1(i)= hgy1(i)
334 & -(px1h1(i)*vy17+px2h1(i)*vy28
335 & +px3h1(i)*vy35+px4h1(i)*vy46)
336 hgz1(i)= hgz1(i)
337 & -(px1h1(i)*vz17+px2h1(i)*vz28
338 & +px3h1(i)*vz35+px4h1(i)*vz46)
339C
340C alpha =2 ->zeta ksi
341C 1 -1 -1 1 -1 1 1 -1
342 hgx2(i)= hgx2(i)
343 & -(px1h2(i)*vx17+px2h2(i)*vx28
344 & +px3h2(i)*vx35+px4h2(i)*vx46)
345 hgy2(i)= hgy2(i)
346 & -(px1h2(i)*vy17+px2h2(i)*vy28
347 & +px3h2(i)*vy35+px4h2(i)*vy46)
348 hgz2(i)= hgz2(i)
349 & -(px1h2(i)*vz17+px2h2(i)*vz28
350 & +px3h2(i)*vz35+px4h2(i)*vz46)
351C alpha =3 ->ksi eta
352C 1 -1 1 -1 1 -1 1 -1
353 hgx3(i)= hgx3(i)
354 & -(px1h3(i)*vx17+px2h3(i)*vx28
355 & +px3h3(i)*vx35+px4h3(i)*vx46)
356 hgy3(i)= hgy3(i)
357 & -(px1h3(i)*vy17+px2h3(i)*vy28
358 & +px3h3(i)*vy35+px4h3(i)*vy46)
359 hgz3(i)= hgz3(i)
360 & -(px1h3(i)*vz17+px2h3(i)*vz28
361 & +px3h3(i)*vz35+px4h3(i)*vz46)
362C
363C alpha =4 ->ksi eta zeta
364C -1 1 -1 1 1 -1 1 -1
365 hgx4(i)= hgx4(i)
366 & -(px1h4(i)*vx17+px2h4(i)*vx28
367 & +px3h4(i)*vx35+px4h4(i)*vx46)
368 hgy4(i)= hgy4(i)
369 & -(px1h4(i)*vy17+px2h4(i)*vy28
370 & +px3h4(i)*vy35+px4h4(i)*vy46)
371 hgz4(i)= hgz4(i)
372 & -(px1h4(i)*vz17+px2h4(i)*vz28
373 & +px3h4(i)*vz35+px4h4(i)*vz46)
374 ENDDO
375!
376 DO i=1,nel
377 jr_1(i) = one/max(em20,jr0(i))
378 js_1(i) = one/max(em20,js0(i))
379 jt_1(i) = one/max(em20,jt0(i))
380 h11(i) = js0(i)*jt0(i)*jr_1(i)
381 h22(i) = jr0(i)*jt0(i)*js_1(i)
382 h33(i) = jr0(i)*js0(i)*jt_1(i)
383 h12(i) = jt0(i)
384 h13(i) = js0(i)
385 h23(i) = jr0(i)
386C SIGY(I) = 1.0E+30
387 ENDDO
388 DO i=1,nel
389 fhour(i,1,1) = fhour(i,1,1)*off(i)
390 fhour(i,1,2) = fhour(i,1,2)*off(i)
391 fhour(i,1,3) = fhour(i,1,3)*off(i)
392 fhour(i,1,4) = fhour(i,1,4)*off(i)
393 fhour(i,2,1) = fhour(i,2,1)*off(i)
394 fhour(i,2,2) = fhour(i,2,2)*off(i)
395 fhour(i,2,3) = fhour(i,2,3)*off(i)
396 fhour(i,2,4) = fhour(i,2,4)*off(i)
397 fhour(i,3,1) = fhour(i,3,1)*off(i)
398 fhour(i,3,2) = fhour(i,3,2)*off(i)
399 fhour(i,3,3) = fhour(i,3,3)*off(i)
400 fhour(i,3,4) = fhour(i,3,4)*off(i)
401 ENDDO
402 IF (iplast==1)
403 . CALL szsvm(
404 1 jr0, js0, jt0, fhour,
405 2 sigy, sigold, nu4, smo1,
406 3 smo2, nel, iint)
407 !-----------For energy calculation------------
408 IF(jlag==1)THEN
409 DO i=1,nel
410 fhourt(1,1) = fhour(i,1,1)*jr0(i)+fcl(i)*hgx1(i)
411 fhourt(1,2) = fhour(i,1,2)*jr0(i)+fcl(i)*hgx2(i)
412 fhourt(1,3) = fhour(i,1,3)*jr0(i)+fcl(i)*hgx3(i)
413 fhourt(1,4) = fhour(i,1,4)*jr0(i)+fcl(i)*hgx4(i)
414 fhourt(2,1) = fhour(i,2,1)*js0(i)+fcl(i)*hgy1(i)
415 fhourt(2,2) = fhour(i,2,2)*js0(i)+fcl(i)*hgy2(i)
416 fhourt(2,3) = fhour(i,2,3)*js0(i)+fcl(i)*hgy3(i)
417 fhourt(2,4) = fhour(i,2,4)*js0(i)+fcl(i)*hgy4(i)
418 fhourt(3,1) = fhour(i,3,1)*jt0(i)+fcl(i)*hgz1(i)
419 fhourt(3,2) = fhour(i,3,2)*jt0(i)+fcl(i)*hgz2(i)
420 fhourt(3,3) = fhour(i,3,3)*jt0(i)+fcl(i)*hgz3(i)
421 fhourt(3,4) = fhour(i,3,4)*jt0(i)+fcl(i)*hgz4(i)
422C
423 nfhour(i,1,1) = (h22(i)+h33(i))*fhourt(1,1)
424 . +h12(i)*fhourt(2,2)+h13(i)*fhourt(3,3)
425 nfhour(i,2,2) = (h11(i)+h33(i))*fhourt(2,2)
426 . +h23(i)*fhourt(3,3)+h12(i)*fhourt(1,1)
427 nfhour(i,3,3) = (h11(i)+h22(i))*fhourt(3,3)
428 . +h13(i)*fhourt(1,1)+h23(i)*fhourt(2,2)
429 nfhour(i,1,2) = nu1(i)*h11(i)*fhourt(1,2)
430 . +nu2(i)*h12(i)*fhourt(2,1)
431 nfhour(i,1,3) = nu1(i)*h11(i)*fhourt(1,3)
432 . +nu2(i)*h13(i)*fhourt(3,1)
433 nfhour(i,2,1) = nu1(i)*h22(i)*fhourt(2,1)
434 . +nu2(i)*h12(i)*fhourt(1,2)
435 nfhour(i,3,1) = nu1(i)*h33(i)*fhourt(3,1)
436 . +nu2(i)*h13(i)*fhourt(1,3)
437C
438 nfhour(i,2,3) = nu1(i)*h22(i)*fhourt(2,3)
439 . +nu2(i)*h23(i)*fhourt(3,2)
440 nfhour(i,3,2) = nu1(i)*h33(i)*fhourt(3,2)
441 . +nu2(i)*h23(i)*fhourt(2,3)
442 nfhour(i,1,4) = nu3(i)*h11(i)*fhourt(1,4)
443 nfhour(i,2,4) = nu3(i)*h22(i)*fhourt(2,4)
444 nfhour(i,3,4) = nu3(i)*h33(i)*fhourt(3,4)
445 ENDDO
446C
447 DO i=1,nel
448 deint(i)=
449 . nfhour(i,3,1)*hgz1(i) + nfhour(i,3,2)*hgz2(i) +
450 . nfhour(i,3,3)*hgz3(i) + nfhour(i,3,4)*hgz4(i) +
451 . nfhour(i,1,1)*hgx1(i) + nfhour(i,1,2)*hgx2(i) +
452 . nfhour(i,1,3)*hgx3(i) + nfhour(i,1,4)*hgx4(i) +
453 . nfhour(i,2,1)*hgy1(i) + nfhour(i,2,2)*hgy2(i) +
454 . nfhour(i,2,3)*hgy3(i) + nfhour(i,2,4)*hgy4(i)
455 eint(i)= eint(i)+dt05*deint(i)/max(em20,vol0(i))
456 ENDDO
457 ENDIF
458C
459 IF (iet > 1 .AND. mtn == 24 ) THEN
460 CALL mdama24(elbuf_str,1,nel ,pm ,mat ,dama_g )
461 DO j=1,3
462 DO i=1,nel
463 fac1=one- dama_g(i,j)
464c FAC1=ONE - MAX(ZERO,MIN(ONE,D_MAX(I))) !in [0 1]
465 fhour(i,j,1:4) = fhour(i,j,1:4)*fac1
466 ENDDO
467 ENDDO
468 END IF !(IET > 1) THEN
469C -------elstic increament----
470 DO i=1,nel
471 e_r =g_3dt(i)*jr_1(i)
472 e_s =g_3dt(i)*js_1(i)
473 e_t =g_3dt(i)*jt_1(i)
474 dfhour(i,1,1) = e_r*hgx1(i)
475 dfhour(i,1,2) = e_r*hgx2(i)
476 dfhour(i,1,3) = e_r*hgx3(i)
477 dfhour(i,1,4) = e_r*hgx4(i)
478 dfhour(i,2,1) = e_s*hgy1(i)
479 dfhour(i,2,2) = e_s*hgy2(i)
480 dfhour(i,2,3) = e_s*hgy3(i)
481 dfhour(i,2,4) = e_s*hgy4(i)
482 dfhour(i,3,1) = e_t*hgz1(i)
483 dfhour(i,3,2) = e_t*hgz2(i)
484 dfhour(i,3,3) = e_t*hgz3(i)
485 dfhour(i,3,4) = e_t*hgz4(i)
486C
487 fhour(i,1,1) = fhour(i,1,1) + dfhour(i,1,1)
488 fhour(i,1,2) = fhour(i,1,2) + dfhour(i,1,2)
489 fhour(i,1,3) = fhour(i,1,3) + dfhour(i,1,3)
490 fhour(i,1,4) = fhour(i,1,4) + dfhour(i,1,4)
491 fhour(i,2,1) = fhour(i,2,1) + dfhour(i,2,1)
492 fhour(i,2,2) = fhour(i,2,2) + dfhour(i,2,2)
493 fhour(i,2,3) = fhour(i,2,3) + dfhour(i,2,3)
494 fhour(i,2,4) = fhour(i,2,4) + dfhour(i,2,4)
495 fhour(i,3,1) = fhour(i,3,1) + dfhour(i,3,1)
496 fhour(i,3,2) = fhour(i,3,2) + dfhour(i,3,2)
497 fhour(i,3,3) = fhour(i,3,3) + dfhour(i,3,3)
498 fhour(i,3,4) = fhour(i,3,4) + dfhour(i,3,4)
499 ENDDO
500 IF (iplast==1)
501 . CALL szsvm(
502 1 jr0, js0, jt0, fhour,
503 2 sigy, sig0, nu4, sm1,
504 3 sm2, nel, iint)
505 !-----------ELASTIC-PLASTIC yield criterion------------
506 IF (iplast==1) THEN
507 DO i=1,nel
508 IF (sm1(i)>sigy(i).AND.deint(i)>0) THEN
509 smo = zep9*smo1(i)+em01*smo2(i)
510 fac1 = sigy(i)-smo
511 fac2 = sm1(i)-smo
512 IF (fac2<=em20) THEN
513 fac=zero
514 ELSE
515 fac = one - max(em20,fac1/fac2)
516 ENDIF
517 IF (sm2(i)<sigy(i)) THEN
518 fac1 =(sm1(i)-sigy(i))/max((sm1(i)-sm2(i)),em20)
519 fac1 =half + sqrt(fac1)
520 fac = min(fac1,one)*fac
521 ENDIF
522 fhour(i,1,1) = fhour(i,1,1) - fac*dfhour(i,1,1)
523 fhour(i,1,2) = fhour(i,1,2) - fac*dfhour(i,1,2)
524 fhour(i,1,3) = fhour(i,1,3) - fac*dfhour(i,1,3)
525 fhour(i,1,4) = fhour(i,1,4) - fac*dfhour(i,1,4)
526 fhour(i,2,1) = fhour(i,2,1) - fac*dfhour(i,2,1)
527 fhour(i,2,2) = fhour(i,2,2) - fac*dfhour(i,2,2)
528 fhour(i,2,3) = fhour(i,2,3) - fac*dfhour(i,2,3)
529 fhour(i,2,4) = fhour(i,2,4) - fac*dfhour(i,2,4)
530 fhour(i,3,1) = fhour(i,3,1) - fac*dfhour(i,3,1)
531 fhour(i,3,2) = fhour(i,3,2) - fac*dfhour(i,3,2)
532 fhour(i,3,3) = fhour(i,3,3) - fac*dfhour(i,3,3)
533 fhour(i,3,4) = fhour(i,3,4) - fac*dfhour(i,3,4)
534 ENDIF
535 ENDDO
536 ENDIF
537 DO i=1,nel
538 fhourt(1,1) = fhour(i,1,1)*jr0(i)+fcl(i)*hgx1(i)
539 fhourt(1,2) = fhour(i,1,2)*jr0(i)+fcl(i)*hgx2(i)
540 fhourt(1,3) = fhour(i,1,3)*jr0(i)+fcl(i)*hgx3(i)
541 fhourt(1,4) = fhour(i,1,4)*jr0(i)+fcl(i)*hgx4(i)
542 fhourt(2,1) = fhour(i,2,1)*js0(i)+fcl(i)*hgy1(i)
543 fhourt(2,2) = fhour(i,2,2)*js0(i)+fcl(i)*hgy2(i)
544 fhourt(2,3) = fhour(i,2,3)*js0(i)+fcl(i)*hgy3(i)
545 fhourt(2,4) = fhour(i,2,4)*js0(i)+fcl(i)*hgy4(i)
546 fhourt(3,1) = fhour(i,3,1)*jt0(i)+fcl(i)*hgz1(i)
547 fhourt(3,2) = fhour(i,3,2)*jt0(i)+fcl(i)*hgz2(i)
548 fhourt(3,3) = fhour(i,3,3)*jt0(i)+fcl(i)*hgz3(i)
549 fhourt(3,4) = fhour(i,3,4)*jt0(i)+fcl(i)*hgz4(i)
550C
551 nfhour(i,1,1) = (h22(i)+h33(i))*fhourt(1,1)
552 . +h12(i)*fhourt(2,2)+h13(i)*fhourt(3,3)
553 nfhour(i,2,2) = (h11(i)+h33(i))*fhourt(2,2)
554 . +h23(i)*fhourt(3,3)+h12(i)*fhourt(1,1)
555 nfhour(i,3,3) = (h11(i)+h22(i))*fhourt(3,3)
556 . +h13(i)*fhourt(1,1)+h23(i)*fhourt(2,2)
557 nfhour(i,1,2) = nu1(i)*h11(i)*fhourt(1,2)
558 . +nu2(i)*h12(i)*fhourt(2,1)
559 nfhour(i,1,3) = nu1(i)*h11(i)*fhourt(1,3)
560 . +nu2(i)*h13(i)*fhourt(3,1)
561 nfhour(i,2,1) = nu1(i)*h22(i)*fhourt(2,1)
562 . +nu2(i)*h12(i)*fhourt(1,2)
563 nfhour(i,3,1) = nu1(i)*h33(i)*fhourt(3,1)
564 . +nu2(i)*h13(i)*fhourt(1,3)
565 nfhour(i,2,3) = nu1(i)*h22(i)*fhourt(2,3)
566 . +nu2(i)*h23(i)*fhourt(3,2)
567 nfhour(i,3,2) = nu1(i)*h33(i)*fhourt(3,2)
568 . +nu2(i)*h23(i)*fhourt(2,3)
569 nfhour(i,1,4) = nu3(i)*h11(i)*fhourt(1,4)
570 nfhour(i,2,4) = nu3(i)*h22(i)*fhourt(2,4)
571 nfhour(i,3,4) = nu3(i)*h33(i)*fhourt(3,4)
572 ENDDO
573 DO i=1,nel
574 hq13p = (nfhour(i,1,1)+nfhour(i,1,3))*one_over_8
575 hq13n = (nfhour(i,1,1)-nfhour(i,1,3))*one_over_8
576 hq24p = (nfhour(i,1,2)+nfhour(i,1,4))*one_over_8
577 hq24n = (nfhour(i,1,2)-nfhour(i,1,4))*one_over_8
578 ff =-px1h1(i)*nfhour(i,1,1)-px1h2(i)*nfhour(i,1,2)
579 . -px1h3(i)*nfhour(i,1,3)-px1h4(i)*nfhour(i,1,4)
580 f11(i) =-(hq13p+hq24n+ff)
581 f17(i) =-(hq13p+hq24p-ff)
582 ff =-px2h1(i)*nfhour(i,1,1)-px2h2(i)*nfhour(i,1,2)
583 . -px2h3(i)*nfhour(i,1,3)-px2h4(i)*nfhour(i,1,4)
584 f12(i) =-(hq13n-hq24n+ff)
585 f18(i) =-(hq13n-hq24p-ff)
586 ff =-px3h1(i)*nfhour(i,1,1)-px3h2(i)*nfhour(i,1,2)
587 . -px3h3(i)*nfhour(i,1,3)-px3h4(i)*nfhour(i,1,4)
588 f13(i) =-(-hq13n-hq24p+ff)
589 f15(i) =-(-hq13n-hq24n-ff)
590 ff =-px4h1(i)*nfhour(i,1,1)-px4h2(i)*nfhour(i,1,2)
591 . -px4h3(i)*nfhour(i,1,3)-px4h4(i)*nfhour(i,1,4)
592 f14(i) =-(-hq13p+hq24p+ff)
593 f16(i) =-(-hq13p+hq24n-ff)
594 ENDDO
595 DO i=1,nel
596 hq13p = (nfhour(i,2,1)+nfhour(i,2,3))*one_over_8
597 hq13n = (nfhour(i,2,1)-nfhour(i,2,3))*one_over_8
598 hq24p = (nfhour(i,2,2)+nfhour(i,2,4))*one_over_8
599 hq24n = (nfhour(i,2,2)-nfhour(i,2,4))*one_over_8
600 ff =-px1h1(i)*nfhour(i,2,1)-px1h2(i)*nfhour(i,2,2)
601 . -px1h3(i)*nfhour(i,2,3)-px1h4(i)*nfhour(i,2,4)
602 f21(i) =-(hq13p+hq24n+ff)
603 f27(i) =-(hq13p+hq24p-ff)
604 ff =-px2h1(i)*nfhour(i,2,1)-px2h2(i)*nfhour(i,2,2)
605 . -px2h3(i)*nfhour(i,2,3)-px2h4(i)*nfhour(i,2,4)
606 f22(i) =-(hq13n-hq24n+ff)
607 f28(i) =-(hq13n-hq24p-ff)
608 ff =-px3h1(i)*nfhour(i,2,1)-px3h2(i)*nfhour(i,2,2)
609 . -px3h3(i)*nfhour(i,2,3)-px3h4(i)*nfhour(i,2,4)
610 f23(i) =-(-hq13n-hq24p+ff)
611 f25(i) =-(-hq13n-hq24n-ff)
612 ff =-px4h1(i)*nfhour(i,2,1)-px4h2(i)*nfhour(i,2,2)
613 . -px4h3(i)*nfhour(i,2,3)-px4h4(i)*nfhour(i,2,4)
614 f24(i) =-(-hq13p+hq24p+ff)
615 f26(i) =-(-hq13p+hq24n-ff)
616 ENDDO
617 DO i=1,nel
618 hq13p = (nfhour(i,3,1)+nfhour(i,3,3))*one_over_8
619 hq13n = (nfhour(i,3,1)-nfhour(i,3,3))*one_over_8
620 hq24p = (nfhour(i,3,2)+nfhour(i,3,4))*one_over_8
621 hq24n = (nfhour(i,3,2)-nfhour(i,3,4))*one_over_8
622 ff =-px1h1(i)*nfhour(i,3,1)-px1h2(i)*nfhour(i,3,2)
623 . -px1h3(i)*nfhour(i,3,3)-px1h4(i)*nfhour(i,3,4)
624 f31(i) =-(hq13p+hq24n+ff)
625 f37(i) =-(hq13p+hq24p-ff)
626 ff =-px2h1(i)*nfhour(i,3,1)-px2h2(i)*nfhour(i,3,2)
627 . -px2h3(i)*nfhour(i,3,3)-px2h4(i)*nfhour(i,3,4)
628 f32(i) =-(hq13n-hq24n+ff)
629 f38(i) =-(hq13n-hq24p-ff)
630 ff =-px3h1(i)*nfhour(i,3,1)-px3h2(i)*nfhour(i,3,2)
631 . -px3h3(i)*nfhour(i,3,3)-px3h4(i)*nfhour(i,3,4)
632 f33(i) =-(-hq13n-hq24p+ff)
633 f35(i) =-(-hq13n-hq24n-ff)
634 ff =-px4h1(i)*nfhour(i,3,1)-px4h2(i)*nfhour(i,3,2)
635 . -px4h3(i)*nfhour(i,3,3)-px4h4(i)*nfhour(i,3,4)
636 f34(i) =-(-hq13p+hq24p+ff)
637 f36(i) =-(-hq13p+hq24n-ff)
638 ENDDO
639 !----hourglass energy is included in internal energy------
640 IF(jlag==1)THEN
641 DO i=1,nel
642 eint(i)= eint(i)+dt05*(
643 . nfhour(i,3,1)*hgz1(i) + nfhour(i,3,2)*hgz2(i) +
644 . nfhour(i,3,3)*hgz3(i) + nfhour(i,3,4)*hgz4(i) +
645 . nfhour(i,1,1)*hgx1(i) + nfhour(i,1,2)*hgx2(i) +
646 . nfhour(i,1,3)*hgx3(i) + nfhour(i,1,4)*hgx4(i) +
647 . nfhour(i,2,1)*hgy1(i) + nfhour(i,2,2)*hgy2(i) +
648 . nfhour(i,2,3)*hgy3(i) + nfhour(i,2,4)*hgy4(i) )
649 . /max(em20,vol0(i))
650 ENDDO
651 ENDIF
652 IF(istrain>0 .AND.
653 . ((anim_n(iad_gps+400+1) == 1) .OR. (anim_n(iad_gps+400+2) == 1) .OR.
654 . (anim_n(iad_gps+400+3) == 1) .OR. (anim_n(iad_gps+400+4) == 1) .OR.
655 . (anim_n(iad_gps+400+5) == 1) .OR. (anim_n(iad_gps+400+6) == 1)) )THEN
656 DO i=1,nel
657 nu2(i) =half*nu2(i)
658 ENDDO
659 CALL szstrainhg(
660 1 jr_1, js_1, jt_1, strhg,
661 2 nel, hgx1, hgx2, hgx3,
662 3 hgx4, hgy1, hgy2, hgy3,
663 4 hgy4, hgz1, hgz2, hgz3,
664 5 hgz4, nu4, nu2)
665 ENDIF
666
667 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
mdama24
subroutine mdama24(elbuf_str, jft, jlt, pm, mat, dama_g)
Definition mdama24.F:37
szetfac
subroutine szetfac(lft, llt, ikt, mtn, et, g)
Definition szetfac.F:31
szstrainhg
subroutine szstrainhg(jr_1, js_1, jt_1, strhg, nel, hgx1, hgx2, hgx3, hgx4, hgy1, hgy2, hgy3, hgy4, hgz1, hgz2, hgz3, hgz4, nu, nu1)
Definition szstrainhg.F:37
szsvm
subroutine szsvm(jr0, js0, jt0, fhour, sigy, sig0, nu, svm1, svm2, nel, iint)
Definition szsvm.F:33