OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
fail_gene1_c.F File Reference
#include "implicit_f.inc"
#include "units_c.inc"
#include "comlock.inc"
#include "com04_c.inc"
#include "com01_c.inc"
#include "scr18_c.inc"
#include "tabsiz_c.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine fail_gene1_c (nel, nuparam, nuvar, nfunc, ifunc, npf, tf, time, timestep, uparam, ipg, ngl, gbuf_dt, epsp, uvar, off, epsxx, epsyy, epsxy, area, thkn, signxx, signyy, signxy, signyz, signzx, temp, dfmax, aldt, table, tdele, thk0, ipt, foff, thklyl, ntablf, itablf, lf_dammx, niparam, iparam, dt)

Function/Subroutine Documentation

◆ fail_gene1_c()

subroutine fail_gene1_c ( integer, intent(in) nel,
integer, intent(in) nuparam,
integer, intent(in) nuvar,
integer, intent(in) nfunc,
integer, dimension(nfunc), intent(in) ifunc,
integer, dimension(snpc), intent(in) npf,
dimension(stf), intent(in) tf,
intent(in) time,
intent(in) timestep,
intent(in) uparam,
integer, intent(in) ipg,
integer, dimension(nel), intent(in) ngl,
intent(in) gbuf_dt,
intent(in) epsp,
intent(inout) uvar,
intent(in) off,
intent(in) epsxx,
intent(in) epsyy,
intent(in) epsxy,
intent(in) area,
intent(in) thkn,
intent(inout) signxx,
intent(inout) signyy,
intent(inout) signxy,
intent(inout) signyz,
intent(inout) signzx,
intent(in) temp,
intent(inout) dfmax,
intent(in) aldt,
type (ttable), dimension(ntable), intent(in) table,
intent(inout) tdele,
intent(in) thk0,
integer, intent(in) ipt,
integer, dimension(nel), intent(inout) foff,
intent(in) thklyl,
integer, intent(in) ntablf,
integer, dimension(ntablf), intent(in) itablf,
integer, intent(in) lf_dammx,
integer, intent(in) niparam,
integer, dimension(niparam), intent(in) iparam,
type (dt_), intent(in) dt )

Definition at line 37 of file fail_gene1_c.F.

46C-----------------------------------------------
47C M o d u l e s
48C-----------------------------------------------
49 USE table_mod
51 USE dt_mod
52C!-----------------------------------------------
53C! I m p l i c i t T y p e s
54C!-----------------------------------------------
55#include "implicit_f.inc"
56C-----------------------------------------------
57C C o m m o n B l o c k s
58C-----------------------------------------------
59#include "units_c.inc"
60#include "comlock.inc"
61#include "com04_c.inc"
62#include "com01_c.inc"
63#include "scr18_c.inc"
64#include "tabsiz_c.inc"
65C!-----------------------------------------------
66 INTEGER, INTENT(IN) :: NEL,NUPARAM,NUVAR,IPG,IPT,NFUNC,NTABLF,
67 . NIPARAM,LF_DAMMX
68 INTEGER, DIMENSION(NFUNC) ,INTENT(IN) :: IFUNC
69 INTEGER, DIMENSION(NTABLF) ,INTENT(IN) :: ITABLF
70 INTEGER, DIMENSION(NEL) ,INTENT(IN) :: NGL
71 INTEGER, DIMENSION(NIPARAM),INTENT(IN) :: IPARAM
72 my_real, INTENT(IN) :: time,timestep
73 my_real, DIMENSION(NUPARAM), INTENT(IN) :: uparam
74 my_real, DIMENSION(NEL), INTENT(IN) :: epsxx,epsyy,epsxy,
75 . gbuf_dt,epsp,off,aldt,temp,area,thkn,thk0,thklyl
76 INTEGER, DIMENSION(NEL), INTENT(INOUT) :: FOFF
77 my_real, DIMENSION(NEL), INTENT(INOUT) :: signxx,signyy,signxy,
78 . signyz,signzx,tdele
79 my_real, DIMENSION(NEL,LF_DAMMX), INTENT(INOUT) :: dfmax
80 my_real, DIMENSION(NEL,NUVAR), INTENT(INOUT) :: uvar
81 TYPE (TTABLE), DIMENSION(NTABLE), INTENT(IN) :: TABLE
82 TYPE (DT_), INTENT(IN) :: DT
83C!-----------------------------------------------
84C! VARIABLES FOR FUNCTION INTERPOLATION
85C!-----------------------------------------------
86 INTEGER, INTENT(IN) :: NPF(SNPC)
87 my_real, INTENT(IN) :: tf(stf)
88 my_real finter
89 EXTERNAL finter
90C!-----------------------------------------------
91C! L o c a l V a r i a b l e s
92C!-----------------------------------------------
93 INTEGER I,K,J,INDX1(NEL),NINDX1,NSTEP,CRIT,NMOD,
94 . fct_ISM,fct_IPS,fct_IDg12,fct_IDe1c,fct_IDel,
95 . NCRIT(NEL),IPOS(NEL,2),Ismooth,Istrain,IR,IS,IT,
96 . tab_IDfld,Itab,NCS,IPMAX(NEL),IPMIN(NEL),IS1MAX(NEL),ILAY,
97 . ITMAX(NEL),IMINDT(NEL),ISIGMAX(NEL),ISIGTH(NEL),IEPSMAX(NEL),
98 . IEFFEPS(NEL),IVOLEPS(NEL),IMINEPS(NEL),ISHEAR(NEL),IMIX12(NEL),
99 . IMXE1C(NEL),IFLD(NEL),ITHIN(NEL),IMAXTEMP(NEL)
100 my_real
101 . minpres,maxpres,sigp1,tmax,dtmin,epsdot_sm,sigvm,sigth,
102 . kf,epsdot_ps,maxeps,effeps,voleps,mineps,epssh,epsdot_fld,
103 . thin,maxtemp,fscale_el,el_ref,lambda,fac,df
104 my_real
105 . e12,p(nel),sxx,syy,szz,svm(nel),sh12(nel),sh13(nel),e1c(nel),
106 . xvec(nel,2),q,r,r_inter,e11(nel),e22(nel),vol_strain(nel),dav,
107 . e1d,e2d,e3d,e4d,s11(nel),s22(nel),eff_strain(nel),s1,s2,
108 . epsmax(nel),sigmax(nel),facl(nel),e1fld(nel),
109 . dfld(nel),hardr(nel),denom,triax(nel)
110C!--------------------------------------------------------------
111 !=======================================================================
112 ! - INITIALISATION OF COMPUTATION ON TIME STEP
113 !=======================================================================
114 ! Recovering failure criterion parameters
115 ! -> Integer parameter, activated criteria
116 crit = iparam(1)
117 itab = iparam(2)
118 nstep = iparam(3)
119 ncs = iparam(4)
120 ismooth = iparam(5)
121 istrain = iparam(6)
122 ! -> Real parameters
123 minpres = uparam(1)
124 maxpres = uparam(2)
125 sigp1 = uparam(3)
126 tmax = uparam(4)
127 dtmin = uparam(5)
128 epsdot_sm = uparam(6)
129 sigvm = uparam(7)
130 sigth = uparam(8)
131 kf = uparam(9)
132 epsdot_ps = uparam(10)
133 maxeps = uparam(11)
134 effeps = uparam(12)
135 voleps = uparam(13)
136 mineps = uparam(14)
137 epssh = uparam(15)
138 epsdot_fld = uparam(16)
139 thin = uparam(17)
140 maxtemp = uparam(20)
141 fscale_el = uparam(21)
142 el_ref = uparam(22)
143c
144 ! Initialization of variable
145 nindx1 = 0
146 indx1(1:nel) = 0
147 ipmax(1:nel) = 0
148 ipmin(1:nel) = 0
149 is1max(1:nel) = 0
150 itmax(1:nel) = 0
151 imindt(1:nel) = 0
152 isigmax(1:nel) = 0
153 isigth(1:nel) = 0
154 iepsmax(1:nel) = 0
155 ieffeps(1:nel) = 0
156 ivoleps(1:nel) = 0
157 imineps(1:nel) = 0
158 ishear(1:nel) = 0
159 imix12(1:nel) = 0
160 imxe1c(1:nel) = 0
161 ifld(1:nel) = 0
162 ithin(1:nel) = 0
163 imaxtemp(1:nel) = 0
164 ncrit(1:nel) = 0
165c function & tables
166 fct_ism = ifunc(1)
167 fct_ips = ifunc(2) ! -> maximum principal strain VS strain-rate
168 fct_idg12 = ifunc(3) ! -> in-plane shear strain VS element size
169 fct_ide1c = ifunc(5) ! -> major in plane-strain VS element size
170 fct_idel = ifunc(6) ! -> element size regularization
171 IF (ntablf > 0) THEN
172 tab_idfld = itablf(1)
173 ELSE
174 tab_idfld = 0
175 END IF
176c
177 ! At initial time, compute the element size regularization factor
178 IF (uvar(1,1)==zero) THEN
179 IF (fct_idel > 0) THEN
180 DO i=1,nel
181 lambda = aldt(i)/el_ref
182 fac = finter(fct_idel,lambda,npf,tf,df)
183 uvar(i,1) = fac*fscale_el
184 ENDDO
185 ELSE
186 uvar(1:nel,1) = one
187 ENDIF
188 ENDIF
189 IF ((uvar(1,5) == zero).AND.(foff(1) /= 0)) uvar(1:nel,5) = one
190 IF (uvar(1,6) == zero) uvar(1:nel,6) = thk0(1:nel)
191 IF (uvar(1,7) == zero) uvar(1:nel,7) = thklyl(1:nel)
192 IF (uvar(1,8) == zero) uvar(1:nel,8) = aldt(1:nel)
193c
194 ! Checking element failure and recovering user variable
195 DO i=1,nel
196 ! Integration point failure
197 IF (uvar(i,5) < one .AND. uvar(i,5) >= em08) THEN
198 uvar(i,5) = uvar(i,5) - one/nstep
199 ENDIF
200 IF (uvar(i,5) <= em08) uvar(i,5) = zero
201 signxx(i) = signxx(i)*uvar(i,5)
202 signyy(i) = signyy(i)*uvar(i,5)
203 signxy(i) = signxy(i)*uvar(i,5)
204 signyz(i) = signyz(i)*uvar(i,5)
205 signzx(i) = signzx(i)*uvar(i,5)
206 ! Regularization factors for length, surface and volume
207 facl(i) = uvar(i,1)
208 ENDDO
209c
210 !====================================================================
211 ! - LOOP OVER THE ELEMENT TO COMPUTE THE STRESSES AND STRAINS
212 !====================================================================
213 DO i=1,nel
214c
215 ! For active element or Gauss point
216 IF ((uvar(i,5) == one).AND.(off(i)==one)) THEN
217 ! ----------------------------------------------------------------------------------------
218 ! Computation of volumetric strain, effective strain, shear strain and principal strains
219 ! ----------------------------------------------------------------------------------------
220 ! -> computation of principal strains
221 e12 = half*epsxy(i)
222 s1 = half*(epsxx(i) + epsyy(i))
223 s2 = half*(epsxx(i) - epsyy(i))
224 q = sqrt(s2**2 + e12**2)
225 e11(i) = s1 + q
226 e22(i) = s1 - q
227 IF (e22(i) >= e11(i)) THEN
228 r_inter = e22(i)
229 e22(i) = e11(i)
230 e11(i) = r_inter
231 ENDIF
232 ! -> computation of volumetric strain
233 vol_strain(i) = e11(i) + e22(i)
234 ! -> computation of effective strain
235 dav = (epsxx(i)+epsyy(i))*third
236 e1d = epsxx(i) - dav
237 e2d = epsyy(i) - dav
238 e3d = - dav
239 e4d = half*epsxy(i)
240 eff_strain(i) = e1d**2 + e2d**2 + e3d**3 + two*(e4d**2)
241 eff_strain(i) = sqrt(two_third*eff_strain(i))
242c
243 ! --------------------------------------------------------------------------
244 ! Computation of hydrostatic stress, Von Mises stress and principal stresses
245 ! --------------------------------------------------------------------------
246 ! -> pressure stress (positive in compression)
247 p(i) = -third*(signxx(i) + signyy(i))
248 ! -> equivalent stress of Von Mises
249 sxx = signxx(i) + p(i)
250 syy = signyy(i) + p(i)
251 szz = p(i)
252 svm(i) = sqrt(signxx(i)*signxx(i) + signyy(i)*signyy(i)
253 . - signxx(i)*signyy(i) + three*signxy(i)*signxy(i))
254 triax(i) = -p(i)/max(svm(i),em20)
255 ! -> computing the principal stresses
256 s1 = half*(signxx(i) + signyy(i))
257 s2 = half*(signxx(i) - signyy(i))
258 q = sqrt(s2**2 + signxy(i)**2)
259 s11(i) = s1 + q
260 s22(i) = s1 - q
261 IF (s22(i) >= s11(i)) THEN
262 r_inter = s22(i)
263 s22(i) = s11(i)
264 s11(i) = r_inter
265 ENDIF
266c
267 ! For broken element or Gauss point
268 ELSE
269 e11(i) = zero
270 e22(i) = zero
271 vol_strain(i) = zero
272 eff_strain(i) = zero
273 p(i) = zero
274 svm(i) = zero
275 triax(i) = zero
276 s11(i) = zero
277 s22(i) = zero
278 ENDIF
279c
280 ENDDO
281c
282 ! -> Forming limit diagram
283 IF (ntablf > 0) THEN
284 IF (itab == 1) THEN
285 ! Diagram using true strains
286 IF (istrain == 0) THEN
287 ! In-plane tabulation with strain-rate
288 xvec(1:nel,1) = e22(1:nel)
289 xvec(1:nel,2) = epsp(1:nel)/epsdot_fld
290 ! -> Tensile yield stress in direction 1 (MD)
291 ipos(1:nel,1:2) = 1
292 CALL table2d_vinterp_log(table(tab_idfld),ismooth,nel,nel,ipos,xvec,e1fld,dfld,hardr)
293 ! Diagram using engineering strain
294 ELSE
295 ! In-plane tabulation with strain-rate
296 xvec(1:nel,1) = exp(e22(1:nel))-one
297 xvec(1:nel,2) = epsp(1:nel)/epsdot_fld
298 ! -> Tensile yield stress in direction 1 (MD)
299 ipos(1:nel,1:2) = 1
300 CALL table2d_vinterp_log(table(tab_idfld),ismooth,nel,nel,ipos,xvec,e1fld,dfld,hardr)
301 e1fld = log(one + e1fld)
302 ENDIF
303 ELSE
304 ! Diagram using true strains
305 IF (istrain == 0) THEN
306 ! In-plane tabulation with strain-rate
307 xvec(1:nel,1) = e22(1:nel)
308 xvec(1:nel,2) = aldt(1:nel)/el_ref
309 ! -> Tensile yield stress in direction 1 (MD)
310 ipos(1:nel,1:2) = 1
311 CALL table_vinterp(table(tab_idfld),nel,nel,ipos,xvec,e1fld,dfld)
312 ! Diagram using engineering strains
313 ELSE
314 ! In-plane tabulation with strain-rate
315 xvec(1:nel,1) = exp(e22(1:nel))-one
316 xvec(1:nel,2) = aldt(1:nel)/el_ref
317 ! -> Tensile yield stress in direction 1 (MD)
318 ipos(1:nel,1:2) = 1
319 CALL table_vinterp(table(tab_idfld),nel,nel,ipos,xvec,e1fld,dfld)
320 e1fld = log(one + e1fld)
321 ENDIF
322 ENDIF
323 ENDIF
324c
325 !====================================================================
326 ! - LOOP OVER THE ELEMENT TO CHECK THE EROSION CRITERIA
327 !====================================================================
328 DO i = 1,nel
329 nmod = 0
330 IF ((uvar(i,5) == one).AND.(off(i)==one)) THEN
331 ! -> minimum pressure
332 IF (btest(crit,1)) THEN
333 nmod = nmod + 1
334 dfmax(i,1+nmod) = max(p(i)/(minpres*facl(i)),dfmax(i,1+nmod))
335 dfmax(i,1+nmod) = min(dfmax(i,1+nmod),one)
336 IF (p(i) <= minpres*facl(i)) THEN
337 ncrit(i) = ncrit(i) + 1
338 ipmin(i) = 1
339 ENDIF
340 ENDIF
341 ! -> maximum pressure
342 IF (btest(crit,2)) THEN
343 nmod = nmod + 1
344 dfmax(i,1+nmod) = max(p(i)/(maxpres*facl(i)),dfmax(i,1+nmod))
345 dfmax(i,1+nmod) = min(dfmax(i,1+nmod),one)
346 IF (p(i) >= maxpres*facl(i)) THEN
347 ncrit(i) = ncrit(i) + 1
348 ipmax(i) = 1
349 ENDIF
350 ENDIF
351 ! -> maximal principal stress
352 IF (btest(crit,3)) THEN
353 nmod = nmod + 1
354 ! (unrestricted)
355 IF (sigp1 > zero) THEN
356 dfmax(i,1+nmod) = max(s11(i)/(sigp1*facl(i)),dfmax(i,1+nmod))
357 dfmax(i,1+nmod) = min(dfmax(i,1+nmod),one)
358 IF (s11(i) >= sigp1*facl(i)) THEN
359 ncrit(i) = ncrit(i) + 1
360 is1max(i) = 1
361 ENDIF
362 ! (restricted to positive stress triaxialities)
363 ELSE
364 IF (triax(i)>em10) THEN
365 dfmax(i,1+nmod) = max(s11(i)/(abs(sigp1)*facl(i)),dfmax(i,1+nmod))
366 dfmax(i,1+nmod) = min(dfmax(i,1+nmod),one)
367 IF (s11(i) >= abs(sigp1)*facl(i)) THEN
368 ncrit(i) = ncrit(i) + 1
369 is1max(i) = 1
370 ENDIF
371 ENDIF
372 ENDIF
373 ENDIF
374 ! -> maximum time
375 IF (btest(crit,4)) THEN
376 nmod = nmod + 1
377 dfmax(i,1+nmod) = max(time/tmax,dfmax(i,1+nmod))
378 dfmax(i,1+nmod) = min(dfmax(i,1+nmod),one)
379 IF (time >= tmax) THEN
380 ncrit(i) = ncrit(i) + 1
381 itmax(i) = 1
382 ENDIF
383 ENDIF
384 ! -> minimum timestep
385 IF (btest(crit,5)) THEN
386 nmod = nmod + 1
387 IF (time > zero) THEN
388 dfmax(i,1+nmod) = max(dtmin/(gbuf_dt(i)*dtfac1(1)),dfmax(i,1+nmod))
389 dfmax(i,1+nmod) = min(dfmax(i,1+nmod),one)
390 IF (gbuf_dt(i)*dtfac1(1) <= dtmin) THEN
391 ncrit(i) = ncrit(i) + 1
392 imindt(i) = 1
393 ENDIF
394 ENDIF
395 ENDIF
396 ! -> equivalent stress
397 IF (btest(crit,6)) THEN
398 nmod = nmod + 1
399 IF (epsdot_sm /= zero) THEN
400 lambda = epsp(i)/epsdot_sm
401 sigmax(i) = finter(fct_ism,lambda,npf,tf,df)
402 sigmax(i) = sigmax(i)*sigvm
403 ELSE
404 sigmax(i) = sigvm
405 ENDIF
406 dfmax(i,1+nmod) = max(svm(i)/(sigmax(i)*facl(i)),dfmax(i,1+nmod))
407 dfmax(i,1+nmod) = min(dfmax(i,1+nmod),one)
408 IF (svm(i) >= sigmax(i)*facl(i)) THEN
409 ncrit(i) = ncrit(i) + 1
410 isigmax(i) = 1
411 ENDIF
412 ENDIF
413 ! -> Tuler-Butcher
414 IF (btest(crit,7)) THEN
415 nmod = nmod + 1
416 dfmax(i,1+nmod) = max(uvar(i,2)/(kf*facl(i)),dfmax(i,1+nmod))
417 dfmax(i,1+nmod) = min(dfmax(i,1+nmod),one)
418 IF (s11(i) > sigth) THEN
419 uvar(i,2) = uvar(i,2) + timestep*(s11(i) - sigth)**2
420 IF (uvar(i,2) >= kf*facl(i)) THEN
421 ncrit(i) = ncrit(i) + 1
422 isigth(i) = 1
423 ENDIF
424 ENDIF
425 ENDIF
426 ! -> maximal principal strain
427 IF (btest(crit,8)) THEN
428 nmod = nmod + 1
429 IF (epsdot_ps /= zero) THEN
430 lambda = epsp(i)/epsdot_ps
431 epsmax(i) = finter(fct_ips,lambda,npf,tf,df)
432 epsmax(i) = epsmax(i)*maxeps
433 ELSE
434 epsmax(i) = maxeps
435 ENDIF
436 dfmax(i,1+nmod) = max(e11(i)/(epsmax(i)*facl(i)),dfmax(i,1+nmod))
437 dfmax(i,1+nmod) = min(dfmax(i,1+nmod),one)
438 IF (e11(i) >= epsmax(i)*facl(i)) THEN
439 ncrit(i) = ncrit(i) + 1
440 iepsmax(i) = 1
441 ENDIF
442 ENDIF
443 ! -> maximum effective strain
444 IF (btest(crit,9)) THEN
445 nmod = nmod + 1
446 dfmax(i,1+nmod) = max(eff_strain(i)/(effeps*facl(i)),dfmax(i,1+nmod))
447 dfmax(i,1+nmod) = min(dfmax(i,1+nmod),one)
448 IF (eff_strain(i) >= effeps*facl(i)) THEN
449 ncrit(i) = ncrit(i) + 1
450 ieffeps(i) = 1
451 ENDIF
452 ENDIF
453 ! -> maximum volumetric strain
454 IF (btest(crit,10)) THEN
455 nmod = nmod + 1
456 IF (voleps > zero) THEN
457 dfmax(i,1+nmod) = max(vol_strain(i)/(voleps*facl(i)),dfmax(i,1+nmod))
458 dfmax(i,1+nmod) = min(dfmax(i,1+nmod),one)
459 IF (vol_strain(i) >= voleps*facl(i)) THEN
460 ncrit(i) = ncrit(i) + 1
461 ivoleps(i) = 1
462 ENDIF
463 ELSE
464 dfmax(i,1+nmod) = max(vol_strain(i)/(voleps*facl(i)),dfmax(i,1+nmod))
465 dfmax(i,1+nmod) = min(dfmax(i,1+nmod),one)
466 IF (vol_strain(i) <= voleps*facl(i)) THEN
467 ncrit(i) = ncrit(i) + 1
468 ivoleps(i) = 1
469 ENDIF
470 ENDIF
471 ENDIF
472 ! -> minimum principal strain
473 IF (btest(crit,11)) THEN
474 nmod = nmod + 1
475 IF (e22(i) /= zero) THEN
476 dfmax(i,1+nmod) = max(mineps*facl(i)/(e22(i)),dfmax(i,1+nmod))
477 ENDIF
478 dfmax(i,1+nmod) = min(dfmax(i,1+nmod),one)
479 IF (e22(i) <= mineps*facl(i)) THEN
480 ncrit(i) = ncrit(i) + 1
481 imineps(i) = 1
482 ENDIF
483 ENDIF
484 ! -> maximum tensorial shear strain
485 IF (btest(crit,12)) THEN
486 nmod = nmod + 1
487 dfmax(i,1+nmod) = max(((e11(i) - e22(i))/two)/(epssh*facl(i)),dfmax(i,1+nmod))
488 dfmax(i,1+nmod) = min(dfmax(i,1+nmod),one)
489 IF ((e11(i) - e22(i))/two >= epssh*facl(i)) THEN
490 ncrit(i) = ncrit(i) + 1
491 ishear(i) = 1
492 ENDIF
493 ENDIF
494 ! -> mixed mode
495 IF (btest(crit,13)) THEN
496 lambda = uvar(i,8)/el_ref
497 sh12(i) = finter(fct_idel,lambda,npf,tf,df)
498 denom = sign(max(abs(e11(i)),em20),e11(i))
499 nmod = nmod + 1
500 IF (((e22(i)/denom)<=-half).AND.((e22(i)/denom)>=-two)) THEN
501 dfmax(i,1+nmod) = max(((e11(i) - e22(i))/two)/(sh12(i)),dfmax(i,1+nmod))
502 dfmax(i,1+nmod) = min(dfmax(i,1+nmod),one)
503 IF ((e11(i) - e22(i))/two >= sh12(i)) THEN
504 ncrit(i) = ncrit(i) + 1
505 imix12(i) = 1
506 ENDIF
507 ENDIF
508 ENDIF
509 IF (btest(crit,15)) THEN
510 lambda = uvar(i,8)/el_ref
511 e1c(i) = finter(fct_ide1c,lambda,npf,tf,df)
512 denom = sign(max(abs(e11(i)),em20),e11(i))
513 nmod = nmod + 1
514 IF (((e22(i)/denom)<=one).AND.((e22(i)/denom)>=-half)) THEN
515 dfmax(i,1+nmod) = max(e11(i)/e1c(i),dfmax(i,1+nmod))
516 dfmax(i,1+nmod) = min(dfmax(i,1+nmod),one)
517 IF (e11(i) >= e1c(i)) THEN
518 ncrit(i) = ncrit(i) + 1
519 imxe1c(i) = 1
520 ENDIF
521 ENDIF
522 ENDIF
523 ! -> Forming limit diagram
524 IF (btest(crit,16)) THEN
525 nmod = nmod + 1
526 IF (ntablf > 0) THEN
527 IF (itab == 1) THEN
528 dfmax(i,1+nmod) = max(e11(i)/(e1fld(i)*facl(i)),dfmax(i,1+nmod))
529 dfmax(i,1+nmod) = min(dfmax(i,1+nmod),one)
530 IF (e11(i) >= e1fld(i)*facl(i)) THEN
531 ncrit(i) = ncrit(i) + 1
532 ifld(i) = 1
533 ENDIF
534 ELSE
535 dfmax(i,1+nmod) = max(e11(i)/(e1fld(i)),dfmax(i,1+nmod))
536 dfmax(i,1+nmod) = min(dfmax(i,1+nmod),one)
537 IF (e11(i) >= e1fld(i)) THEN
538 ncrit(i) = ncrit(i) + 1
539 ifld(i) = 1
540 ENDIF
541 ENDIF
542 ENDIF
543 ENDIF
544 ! -> maximum shell thinning
545 IF (btest(crit,17)) THEN
546 nmod = nmod + 1
547 IF (thin < zero) THEN
548 dfmax(i,1+nmod) = max(((thkn(i)-uvar(i,6))/uvar(i,6))/
549 . (-abs(thin)*facl(i)),dfmax(i,1+nmod))
550 dfmax(i,1+nmod) = min(dfmax(i,1+nmod),one)
551 IF (((thkn(i)-uvar(i,6))/uvar(i,6)) <= -abs(thin)*facl(i)) THEN
552 ncrit(i) = ncrit(i) + 1
553 ithin(i) = 1
554 ENDIF
555 ELSE
556 dfmax(i,1+nmod) = max(((thklyl(i)-uvar(i,7))/uvar(i,7))/
557 . (-abs(thin)*facl(i)),dfmax(i,1+nmod))
558 dfmax(i,1+nmod) = min(dfmax(i,1+nmod),one)
559 IF (((thklyl(i)-uvar(i,7))/uvar(i,7)) <= -abs(thin)*facl(i)) THEN
560 ncrit(i) = ncrit(i) + 1
561 ithin(i) = 1
562 ENDIF
563 ENDIF
564 ENDIF
565 ! -> maximum temperature
566 IF (btest(crit,18)) THEN
567 nmod = nmod + 1
568 dfmax(i,1+nmod) = max(temp(i)/maxtemp,dfmax(i,1+nmod))
569 dfmax(i,1+nmod) = min(dfmax(i,1+nmod),one)
570 IF (temp(i) >= maxtemp) THEN
571 ncrit(i) = ncrit(i) + 1
572 imaxtemp(i) = 1
573 ENDIF
574 ENDIF
575c
576 ! -> Checking failure
577 DO j = 1,nmod
578 dfmax(i,1) = max(dfmax(i,1),dfmax(i,1+j))
579 ENDDO
580 dfmax(i,1) = min(dfmax(i,1),one)
581 IF (ncrit(i) >= ncs) THEN
582 uvar(i,5) = uvar(i,5) - one/nstep
583 signxx(i) = signxx(i)*uvar(i,5)
584 signyy(i) = signyy(i)*uvar(i,5)
585 signxy(i) = signxy(i)*uvar(i,5)
586 signyz(i) = signyz(i)*uvar(i,5)
587 signzx(i) = signzx(i)*uvar(i,5)
588 dfmax(i,1) = one
589 nindx1 = nindx1 + 1
590 indx1(nindx1) = i
591 ENDIF
592 ENDIF
593c
594 ENDDO
595c
596 !====================================================================
597 ! - LOOKING FOR ELEMENT DELETION
598 !====================================================================
599 ! Checking element failure using global damage
600 DO i = 1,nel
601 IF ((uvar(i,5) == zero).AND.(foff(i) /= 0)) THEN
602 foff(i) = 0
603 dfmax(i,1) = one
604 tdele(i) = time
605 ENDIF
606 ENDDO
607c
608c------------------------
609c------------------------
610 IF (nindx1 > 0) THEN
611 DO j = 1,nindx1
612 i = indx1(j)
613#include "lockon.inc"
614 IF (ncrit(i) == 1) THEN
615 WRITE(iout, 1000) ngl(i),ipg,ipt,time,ncrit(i)
616 WRITE(istdo,1000) ngl(i),ipg,ipt,time,ncrit(i)
617 ELSE
618 WRITE(iout, 1001) ngl(i),ipg,ipt,time,ncrit(i)
619 WRITE(istdo,1001) ngl(i),ipg,ipt,time,ncrit(i)
620 ENDIF
621 IF (ipmax(i) == 1) THEN
622 WRITE(iout, 1002) p(i),maxpres*facl(i)
623 WRITE(istdo,1002) p(i),maxpres*facl(i)
624 ENDIF
625 IF (ipmin(i) == 1) THEN
626 WRITE(iout, 1003) p(i),minpres*facl(i)
627 WRITE(istdo,1003) p(i),minpres*facl(i)
628 ENDIF
629 IF (is1max(i) == 1) THEN
630 WRITE(iout, 1004) s11(i),abs(sigp1)*facl(i)
631 WRITE(istdo,1004) s11(i),abs(sigp1)*facl(i)
632 ENDIF
633 IF (itmax(i) == 1) THEN
634 WRITE(iout, 1005) time,tmax
635 WRITE(istdo,1005) time,tmax
636 ENDIF
637 IF (imindt(i) == 1) THEN
638 WRITE(iout, 1006) gbuf_dt(i)*dtfac1(1),dtmin
639 WRITE(istdo,1006) gbuf_dt(i)*dtfac1(1),dtmin
640 ENDIF
641 IF (isigmax(i) == 1) THEN
642 WRITE(iout, 1007) svm(i),sigmax(i)*facl(i)
643 WRITE(istdo,1007) svm(i),sigmax(i)*facl(i)
644 ENDIF
645 IF (isigth(i) == 1) THEN
646 WRITE(iout, 1008) uvar(i,2),kf*facl(i)
647 WRITE(istdo,1008) uvar(i,2),kf*facl(i)
648 ENDIF
649 IF (iepsmax(i) == 1) THEN
650 WRITE(iout, 1009) e11(i),epsmax(i)*facl(i)
651 WRITE(istdo,1009) e11(i),epsmax(i)*facl(i)
652 ENDIF
653 IF (ieffeps(i) == 1) THEN
654 WRITE(iout, 1010) eff_strain(i),effeps*facl(i)
655 WRITE(istdo,1010) eff_strain(i),effeps*facl(i)
656 ENDIF
657 IF (ivoleps(i) == 1) THEN
658 IF (voleps >= zero) THEN
659 WRITE(iout, 1011) vol_strain(i),voleps*facl(i)
660 WRITE(istdo,1011) vol_strain(i),voleps*facl(i)
661 ELSE
662 WRITE(iout, 1012) vol_strain(i),voleps*facl(i)
663 WRITE(istdo,1012) vol_strain(i),voleps*facl(i)
664 ENDIF
665 ENDIF
666 IF (imineps(i) == 1) THEN
667 WRITE(iout, 1013) e22(i),mineps*facl(i)
668 WRITE(istdo,1013) e22(i),mineps*facl(i)
669 ENDIF
670 IF (ishear(i) == 1) THEN
671 WRITE(iout, 1014) (e11(i) - e22(i))/two,epssh*facl(i)
672 WRITE(istdo,1014) (e11(i) - e22(i))/two,epssh*facl(i)
673 ENDIF
674 IF (imix12(i) == 1) THEN
675 WRITE(iout, 1015) (e11(i) - e22(i))/two,sh12(i)
676 WRITE(istdo,1015) (e11(i) - e22(i))/two,sh12(i)
677 ENDIF
678 IF (imxe1c(i) == 1) THEN
679 WRITE(iout, 1017) e11(i),e1c(i)
680 WRITE(istdo,1017) e11(i),e1c(i)
681 ENDIF
682 IF (ifld(i) == 1) THEN
683 IF (itab == 1) THEN
684 WRITE(iout, 1018) e11(i),e1fld(i)*facl(i)
685 WRITE(istdo,1018) e11(i),e1fld(i)*facl(i)
686 ELSE
687 WRITE(iout, 1018) e11(i),e1fld(i)
688 WRITE(istdo,1018) e11(i),e1fld(i)
689 ENDIF
690 ENDIF
691 IF (ithin(i) == 1) THEN
692 IF (thin < zero) THEN
693 WRITE(iout, 1019) (thkn(i)-uvar(i,6))/uvar(i,6),-abs(thin)*facl(i)
694 WRITE(istdo,1019) (thkn(i)-uvar(i,6))/uvar(i,6),-abs(thin)*facl(i)
695 ELSE
696 WRITE(iout, 1021) (thklyl(i)-uvar(i,7))/uvar(i,7),-abs(thin)*facl(i)
697 WRITE(istdo,1021) (thklyl(i)-uvar(i,7))/uvar(i,7),-abs(thin)*facl(i)
698 ENDIF
699 ENDIF
700 IF (imaxtemp(i) == 1) THEN
701 WRITE(iout, 1020) temp(i),maxtemp
702 WRITE(istdo,1020) temp(i),maxtemp
703 ENDIF
704#include "lockoff.inc"
705 END DO
706 END IF
707c------------------------
708 1000 FORMAT(1x,'>> FOR SHELL ELEMENT NUMBER (GENE1) el#',i10,', GAUSS POINT #',i3,
709 . ', LAYER #',i3,', FAILURE START AT TIME: ',1pe12.4,', ',i3,' CRITERION HAS BEEN REACHED:')
710 1001 FORMAT(1x,'>> FOR SHELL ELEMENT NUMBER (GENE1) el#',i10,', GAUSS POINT #',i3,
711 . ', LAYER #',i3,', FAILURE START AT TIME: ',1pe12.4,', ',i3,' CRITERIA HAVE BEEN REACHED:')
712 1002 FORMAT(1x,'HYDROSTATIC PRESSURE VALUE: ',1pe12.4,' > CRITICAL VALUE: ',1pe12.4)
713 1003 FORMAT(1x,'HYDROSTATIC PRESSURE VALUE: ',1pe12.4,' < CRITICAL VALUE: ',1pe12.4)
714 1004 FORMAT(1x,'1ST PRINCIPAL STRESS VALUE: ',1pe12.4,' > CRITICAL VALUE: ',1pe12.4)
715 1005 FORMAT(1x,'TIME VALUE: ',1pe12.4,' > CRITICAL VALUE: ',1pe12.4)
716 1006 FORMAT(1x,'ELEMENT TIMESTEP VALUE: ',1pe12.4,' < CRITICAL VALUE: ',1pe12.4)
717 1007 FORMAT(1x,'EQUIVALENT STRESS VALUE: ',1pe12.4,' > CRITICAL VALUE: ',1pe12.4)
718 1008 FORMAT(1x,'T-BUTCHER INTG. VALUE: ',1pe12.4,' > CRITICAL VALUE: ',1pe12.4)
719 1009 FORMAT(1x,'1ST PRINCIPAL STRAIN VALUE: ',1pe12.4,' > CRITICAL VALUE: ',1pe12.4)
720 1010 FORMAT(1x,'EFFECTIVE STRAIN VALUE: ',1pe12.4,' > CRITICAL VALUE: ',1pe12.4)
721 1011 FORMAT(1x,'VOLUMETRIC STRAIN VALUE: ',1pe12.4,' > CRITICAL VALUE: ',1pe12.4)
722 1012 FORMAT(1x,'VOLUMETRIC STRAIN VALUE: ',1pe12.4,' < CRITICAL VALUE: ',1pe12.4)
723 1013 FORMAT(1x,'3RD PRINCIPAL STRAIN VALUE: ',1pe12.4,' < CRITICAL VALUE: ',1pe12.4)
724 1014 FORMAT(1x,'MAX. SHEAR STRAIN VALUE: ',1pe12.4,' > CRITICAL VALUE: ',1pe12.4)
725 1015 FORMAT(1x,'IN-PLANE SH.STRAIN 12 VALUE: ',1pe12.4,' > CRITICAL VALUE: ',1pe12.4)
726 1016 FORMAT(1x,'TRANSV. SH.STRAIN 13 VALUE: ',1pe12.4,' > CRITICAL VALUE: ',1pe12.4)
727 1017 FORMAT(1x,'IN-PLANE PRINC.STRAIN VALUE: ',1pe12.4,' > CRITICAL VALUE: ',1pe12.4)
728 1018 FORMAT(1x,'1ST PRINCIPAL STRESS VALUE: ',1pe12.4,' > FORMING LIMIT VALUE : ',1pe12.4)
729 1019 FORMAT(1x,'AVERAGE THINNING VALUE: ',1pe12.4,' < CRITICAL VALUE: ',1pe12.4)
730 1021 FORMAT(1x,'LAYER THINNING VALUE: ',1pe12.4,' < CRITICAL VALUE: ',1pe12.4)
731 1020 FORMAT(1x,'TEMPERATURE VALUE: ',1pe12.4,' > CRITICAL VALUE: ',1pe12.4)
#define my_real
Definition cppsort.cpp:32
subroutine area(d1, x, x2, y, y2, eint, stif0)
#define min(a, b)
Definition macros.h:20
#define max(a, b)
Definition macros.h:21