OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
szhour3_or.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"

Go to the source code of this file.

Functions/Subroutines

subroutine szhour3_or (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, gama, uparam, strhg, strain, istrain, mtn, ismstr, jlag, iint, mat_param)

Function/Subroutine Documentation

◆ szhour3_or()

subroutine szhour3_or ( 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,
gama,
uparam,
strhg,
strain,
integer istrain,
integer, intent(in) mtn,
integer, intent(in) ismstr,
integer, intent(in) jlag,
integer, intent(in) iint,
type(matparam_struct_), intent(in) mat_param )

Definition at line 39 of file szhour3_or.F.

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