OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
fail_tensstrain_ib.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine fail_tensstrain_ib (nel, ngl, nuparam, uparam, time, epsd, off, dfmax, tdel, iout, istdo, ifunc, epsxx, al, tstar, damscl, snpc, npf, stf, uvar, nvarf, tf, ipt, foff, ismstr, uelr, npg)

Function/Subroutine Documentation

◆ fail_tensstrain_ib()

subroutine fail_tensstrain_ib ( integer, intent(in) nel,
integer, dimension(nel), intent(in) ngl,
integer, intent(in) nuparam,
intent(in) uparam,
intent(in) time,
intent(in) epsd,
intent(inout) off,
intent(inout) dfmax,
intent(inout) tdel,
integer, intent(in) iout,
integer, intent(in) istdo,
integer, dimension(100), intent(in) ifunc,
intent(in) epsxx,
intent(in) al,
intent(in) tstar,
intent(inout) damscl,
integer, intent(in) snpc,
integer, dimension(snpc), intent(in) npf,
integer, intent(in) stf,
intent(inout) uvar,
integer, intent(in) nvarf,
intent(in) tf,
integer, intent(in) ipt,
integer, dimension(nel), intent(inout) foff,
integer, intent(in) ismstr,
intent(inout) uelr,
integer, intent(in) npg )

Definition at line 30 of file fail_tensstrain_ib.F.

37C-----------------------------------------------
38c tens strain failure model for integrated beams (TYPE 18) !irup=10
39C-----------------------------------------------
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42#include "implicit_f.inc"
43C-----------------------------------------------
44C G l o b a l P a r a m e t e r s
45C-----------------------------------------------
46#include "comlock.inc"
47C-----------------------------------------------
48C D u m m y A r g u m e n t s
49C-----------------------------------------------
50 INTEGER ,INTENT(IN) :: NEL ! size of element group
51 INTEGER ,INTENT(IN) :: NUPARAM ! size of parameter array
52 INTEGER ,INTENT(IN) :: IPT ! current integration point
53 INTEGER ,INTENT(IN) :: IOUT ! output file unit
54 INTEGER ,INTENT(IN) :: ISTDO ! output file unit
55 INTEGER ,INTENT(IN) :: SNPC
56 INTEGER ,INTENT(IN) :: STF
57 INTEGER ,INTENT(IN) :: ISMSTR
58 INTEGER ,INTENT(IN) :: NVARF
59 INTEGER ,DIMENSION(NEL) ,INTENT(IN) :: NGL ! table of element identifiers
60 INTEGER ,DIMENSION(100) ,INTENT(IN) :: IFUNC ! table of functions identifiers
61 INTEGER ,DIMENSION(SNPC) ,INTENT(IN) :: NPF
62 INTEGER ,DIMENSION(NEL) ,INTENT(INOUT) :: FOFF
63 my_real ,INTENT(IN) :: time ! current time
64 my_real ,DIMENSION(NUPARAM) ,INTENT(IN) :: uparam ! failure model parameter array
65 my_real ,DIMENSION(NEL) ,INTENT(IN) :: epsd ! strain rate
66 my_real ,DIMENSION(NEL) ,INTENT(IN) :: tstar
67 my_real ,DIMENSION(NEL) ,INTENT(IN) :: al
68 my_real ,DIMENSION(NEL) ,INTENT(IN) :: epsxx
69 my_real ,DIMENSION(STF) ,INTENT(IN) :: tf
70 my_real ,DIMENSION(NEL) ,INTENT(INOUT) :: off ! element deactivation flag
71 my_real ,DIMENSION(NEL) ,INTENT(INOUT) :: dfmax ! maximum damage
72 my_real ,DIMENSION(NEL) ,INTENT(INOUT) :: damscl !1-damage
73 my_real ,DIMENSION(NEL,NVARF),INTENT(INOUT) :: uvar
74 my_real ,DIMENSION(NEL) ,INTENT(INOUT) :: tdel ! desactivation time
75 my_real ,DIMENSION(NEL) ,INTENT(INOUT) :: uelr
76 INTEGER ,INTENT(IN) :: NPG
77C-----------------------------------------------
78C L o c a l V a r i a b l e s
79C-----------------------------------------------
80 INTEGER I,J,NINDXD,NINDXF,NINDX1,NINDX2,S_FLAG,SCALE_FLAG,STRDEF,STRFLAG,FAILIP
81 INTEGER ,DIMENSION(NEL) :: INDXD,INDXF,INDX1,INDX2
82 my_real r1,r2,epsf1,epsf2,lambda,fac,df,
83 . el_ref,sc_el,scale_temp,rfac,rfac2,
84 . unit_t,epsp_unit,finter,dydx,epst1,epst2
85 EXTERNAL finter
86 my_real ,DIMENSION(NEL) :: eps_max,damage,epsrate,eps11,epsi,eps_eq
87C=======================================================================
88 epst1 = uparam(1)
89 epst2 = uparam(2)
90 epsf1 = uparam(3)
91 epsf2 = uparam(4)
92 sc_el = uparam(5)
93 el_ref = uparam(6)
94 scale_temp = uparam(7)
95 s_flag = int(uparam(8))
96 unit_t = uparam(9)
97 strdef = int(uparam(10))
98 failip = min(nint(uparam(11)),npg) ! number of failed integration point prior to solid element deletion. default = 1 (integer)
99
100c
101 damage(:nel) = zero
102 eps_max(:nel) = zero
103 nindxd = 0
104 nindxf = 0
105 strflag = 0
106C-----------------------------------------------
107c Initialization
108C-----------------------------------------------
109 IF (uvar(1,1) == zero) THEN
110 SELECT CASE (s_flag)
111 CASE (2)
112 IF (ifunc(2) > 0)THEN
113 DO i=1,nel
114 lambda = al(i) / el_ref
115 fac = sc_el * finter(ifunc(2),lambda,npf,tf,df)
116 uvar(i,1) = fac
117 ENDDO
118 ELSE
119 DO i=1,nel
120 uvar(i,1) = one
121 ENDDO
122 ENDIF
123 CASE (3)
124 IF (ifunc(2) > 0)THEN
125 DO i=1,nel
126 lambda = al(i) / el_ref
127 fac = sc_el * finter(ifunc(2),lambda,npf,tf,df)
128 uvar(i,1) = fac
129 ENDDO
130 ELSE
131 DO i=1,nel
132 uvar(i,1) = one
133 ENDDO
134 ENDIF
135 CASE DEFAULT ! default - old formulation
136 DO i=1,nel
137 uvar(i,1) = epsf1
138 ENDDO
139 END SELECT
140 ENDIF
141c----------------------------------------------
142c Max strain transformation following input definition
143c-------------------
144 IF (strdef == 2 .AND. (ismstr == 0 .OR. ismstr == 4) ) THEN ! failure defined as engineering strain
145c transform true strain to engineering
146 DO i=1,nel
147 eps11(i) = exp(epsxx(i)) - one
148 epsrate(i) = exp(epsd(i)) - one
149 ENDDO
150c
151 ELSE IF (strdef == 3 .AND. ismstr == 1) THEN ! failure defined as true strain
152c transform engineering to true strain
153 DO i=1,nel
154 eps11(i) = log(epsxx(i) + one)
155 epsrate(i) = log(epsd(i) + one)
156 ENDDO
157 ELSE
158 DO i=1,nel
159 eps11(i) = epsxx(i)
160 epsrate(i) = epsd(i)
161 ENDDO
162 END IF
163
164c-------------------------
165 SELECT CASE (s_flag)
166c-------------------------
167 CASE (1) ! Equivalent strain criterion AND PRINCIPAL
168 DO i=1,nel
169 IF (off(i) == one ) THEN
170 eps_eq(i) = abs(eps11(i))
171 epsi(i) = eps11(i)
172 END IF
173 ENDDO
174 CASE (2) ! Equivalent strain criterion
175 DO i=1,nel
176 IF (off(i) == one ) THEN
177 eps_eq(i) = abs(eps11(i))
178 END IF
179 ENDDO
180 CASE (3) ! Equivalent strain criterion AND PRINCIPAL
181 DO i=1,nel
182 IF (off(i) == one ) THEN
183 epsi(i) = eps11(i)
184 END IF
185 ENDDO
186 END SELECT
187
188
189c-------------------
190 nindxd = 0
191 nindxf = 0
192 nindx1 = 0
193 nindx2 = 0
194c
195 SELECT CASE (s_flag)
196 CASE (2)
197C-------------------
198c Equivalent strain. New format: Element length and temperature
199C-------------------
200 DO i=1,nel
201 IF (off(i) == one .and. foff(i) == 1) THEN
202 IF (ifunc(1) > 0) THEN ! strain rate
203 epsp_unit = epsrate(i) * unit_t
204 rfac = finter(ifunc(1),epsp_unit,npf,tf,dydx)
205 rfac = max(rfac,em20)
206 ELSE
207 rfac = one
208 ENDIF
209 IF (ifunc(3) > 0) THEN ! temperatuer
210 rfac2 = finter(ifunc(3),tstar(i),npf,tf,dydx)
211 rfac2 = max(rfac2,em20)
212 ELSE
213 rfac2 = one
214 ENDIF
215 r1 = epst1*rfac*rfac2*uvar(i,1)
216 r2 = epst2*rfac*rfac2*uvar(i,1)
217 IF (eps_eq(i) > r1) THEN
218 IF (dfmax(i) == zero) THEN
219 nindxd = nindxd + 1
220 indxd(nindxd) = i
221 ENDIF
222 damage(i) = min(one, (eps_eq(i)-r1)/(r2-r1))
223 dfmax(i) = max(dfmax(i) ,damage(i))
224 ENDIF
225 IF (eps_eq(i) >= r2) THEN
226 foff(i) = 0
227 tdel(i) = time
228 nindxf = nindxf + 1
229 indxf(nindxf) = i
230 dfmax(i) = one
231 uelr(i) = uelr(i) + one
232 IF (nint(uelr(i)) >= failip) THEN
233 off(i) = four_over_5
234 ENDIF
235 ENDIF
236 ENDIF
237 ENDDO
238C-------------------
239 CASE (3)
240C-------------------
241c principal strain. with Element length and temperature
242C-------------------
243 DO i=1,nel
244 IF (off(i) == one .and. foff(i) == 1) THEN
245 IF (ifunc(1) > 0) THEN ! strain rate
246 epsp_unit = epsrate(i) * unit_t
247 rfac = finter(ifunc(1),epsp_unit,npf,tf,dydx)
248 rfac = max(rfac,em20)
249 ELSE
250 rfac = one
251 ENDIF
252 IF (ifunc(3) > 0) THEN ! temperatuer
253 rfac2 = finter(ifunc(3),tstar(i),npf,tf,dydx)
254 rfac2 = max(rfac2,em20)
255 ELSE
256 rfac2 = one
257 ENDIF
258 r1 = epst1*rfac*rfac2*uvar(i,1)
259 r2 = epst2*rfac*rfac2*uvar(i,1)
260 IF (epsi(i) > r1) THEN
261 IF (dfmax(i) == zero) THEN
262 nindxd = nindxd + 1
263 indxd(nindxd) = i
264 ENDIF
265 damage(i) = min(one, (epsi(i)-r1)/(r2-r1))
266 dfmax(i) = max(dfmax(i) ,damage(i))
267 ENDIF
268 IF (epsi(i) >= r2) THEN
269 foff(i) = 0
270 tdel(i) = time
271 nindxf = nindxf + 1
272 indxf(nindxf) = i
273 dfmax(i) = one
274 uelr(i) = uelr(i) + one
275 IF (nint(uelr(i)) >= failip) THEN
276 off(i) = four_over_5
277 ENDIF
278 ENDIF
279 ENDIF
280 ENDDO
281
282C-------------------
283c Equivalent strain.
284C-------------------
285 CASE DEFAULT
286 DO i=1,nel
287 IF (off(i) == one .and. foff(i) == 1) THEN
288 IF (ifunc(1) > 0) THEN ! strain rate
289 epsp_unit = epsrate(i) * unit_t
290 rfac = finter(ifunc(1),epsp_unit,npf,tf,dydx)
291 rfac = max(rfac,em20)
292 ELSE
293 rfac = one
294 ENDIF
295 r1 = epst1*rfac
296 r2 = epst2*rfac
297 IF (eps_eq(i) > r1) THEN
298 IF (dfmax(i) == zero) THEN
299 nindxd = nindxd + 1
300 indxd(nindxd) = i
301 ENDIF
302 damage(i) = min(one, (eps_eq(i)-r1)/(r2-r1))
303 dfmax(i) = max(dfmax(i), damage(i))
304 ENDIF
305 IF (eps_eq(i) >= r2) THEN
306 foff(i) = 0
307 tdel(i) = time
308 nindxf = nindxf + 1
309 indxf(nindxf) = i
310 dfmax(i) = one
311 uelr(i) = uelr(i) + one
312 IF (nint(uelr(i)) >= failip) THEN
313 off(i) = four_over_5
314 ENDIF
315 ENDIF
316 IF (epsf1 > zero .OR. epsf2 > zero) THEN
317 IF ( eps_eq(i) > uvar(i,1) .AND. uvar(i,1) /= zero) THEN
318 foff(i) = 0
319 tdel(i) = time
320 nindx1 = nindx1 + 1
321 indx1(nindx1) = i
322 uelr(i) = uelr(i) + one
323 IF (nint(uelr(i)) >= failip) THEN
324 off(i) = four_over_5
325 ENDIF
326 ELSEIF (epsi(i) > epsf2 .AND. epsf2 > zero) THEN
327 foff(i) = 0
328 tdel(i) = time
329 nindx2 = nindx2 + 1
330 indx2(nindx2) = i
331 eps_eq(i) = epsi(i)
332 uelr(i) = uelr(i) + one
333 IF (nint(uelr(i)) >= failip) THEN
334 off(i) = four_over_5
335 ENDIF
336 ENDIF
337 dfmax(i) = max(dfmax(i),min( one, (eps_eq(i) / uvar(i,1))))
338 scale_flag = 0
339 ENDIF
340 ENDIF
341c
342 ENDDO
343 END SELECT
344
345C-------------------
346 DO i=1,nel
347 damscl(i) = one - dfmax(i)
348 END DO
349
350
351c------------------------
352c print
353c------------------------
354 IF (nindxd > 0) THEN ! start damage
355 DO j=1,nindxd
356 i = indxd(j)
357 IF (s_flag == 3) THEN
358#include "lockon.inc"
359 WRITE(iout, 2001) ngl(i),ipt,epsi(i)
360 WRITE(istdo,2001) ngl(i),ipt,epsi(i)
361 IF (off(i) == four_over_5) THEN
362 WRITE(iout, 1111) ngl(i),time
363 WRITE(istdo,1111) ngl(i),time
364 ENDIF
365#include "lockoff.inc"
366 ELSE
367#include "lockon.inc"
368 WRITE(iout, 2002) ngl(i),ipt,eps_eq(i)
369 WRITE(istdo,2002) ngl(i),ipt,eps_eq(i)
370 IF (off(i) == four_over_5) THEN
371 WRITE(iout, 1111) ngl(i),time
372 WRITE(istdo,1111) ngl(i),time
373 ENDIF
374#include "lockoff.inc"
375 ENDIF
376 END DO
377 END IF
378
379c
380 IF (nindxf > 0) THEN ! failure
381 DO j=1,nindxf
382 i = indxf(j)
383 IF (s_flag == 3) THEN
384#include "lockon.inc"
385 WRITE(iout, 3001) ngl(i),ipt,epsi(i)
386 WRITE(istdo,3001) ngl(i),ipt,epsi(i)
387 IF (off(i) == four_over_5) THEN
388 WRITE(iout, 1111) ngl(i),time
389 WRITE(istdo,1111) ngl(i),time
390 ENDIF
391#include "lockoff.inc"
392 ELSE
393 WRITE(iout, 3101) ngl(i),ipt,eps_eq(i)
394 WRITE(istdo,3101) ngl(i),ipt,eps_eq(i)
395 IF (off(i) == four_over_5) THEN
396 WRITE(iout, 1111) ngl(i),time
397 WRITE(istdo,1111) ngl(i),time
398 ENDIF
399 ENDIF
400 END DO
401 END IF
402c
403 IF (nindx1 > 0) THEN
404 DO j=1,nindx1
405 i = indx1(j)
406#include "lockon.inc"
407 WRITE(iout, 4000) ngl(i),ipt,eps_eq(i),time
408 WRITE(istdo,4100) ngl(i),ipt,eps_eq(i),time
409 IF (off(i) == four_over_5) THEN
410 WRITE(iout, 1111) ngl(i),time
411 WRITE(istdo,1111) ngl(i),time
412 ENDIF
413#include "lockoff.inc"
414 END DO
415 END IF
416c
417 IF (nindx2 > 0) THEN
418 DO j=1,nindx2
419 i = indx2(j)
420#include "lockon.inc"
421 WRITE(iout, 5000) ngl(i),ipt,eps_eq(i),time
422 WRITE(istdo,5100) ngl(i),ipt,eps_eq(i),time
423 IF (off(i) == four_over_5) THEN
424 WRITE(iout, 1111) ngl(i),time
425 WRITE(istdo,1111) ngl(i),time
426 ENDIF
427#include "lockoff.inc"
428 END DO
429 END IF
430c------------------------
431
432c------------------
433 1111 FORMAT(1x,'DELETED BEAM ELEMENT ',i10,1x,'AT TIME :',1pe12.4)
434 2001 FORMAT(1x,'START DAMAGE (TENSSTRAIN) OF BEAM ELEMENT ',i10,1x,',INTEGRATION PT',i2,
435 . 1x,'PRINCIPAL STRAIN=',g11.4)
436 2002 FORMAT(1x,'START DAMAGE (TENSSTRAIN) OF BEAM ELEMENT ',i10,1x,',INTEGRATION PT',i2,
437 . 1x,'EQUIVALENT STRAIN=',g11.4)
438C
439 3001 FORMAT(1x,'FAILURE (TENSSTRAIN) OF BEAM ELEMENT ',i10,1x,',INTEGRATION PT',i2,
440 . 1x,'PRINCIPAL STRAIN=',g11.4)
441 3101 FORMAT(1x,'FAILURE (TENSSTRAIN) OF BEAM ELEMENT ',i10,1x,',INTEGRATION PT',i2,
442 . 1x,'EQUIVALENT STRAIN=',g11.4)
443C
444 4000 FORMAT(1x,'FAILURE (TENSSTRAIN) OF BEAM ELEMENT ',i10,1x,',INTEGRATION PT',i2,
445 . 1x,'EQUIVALENT STRAIN=',g11.4,1x,'AT TIME :',1pe12.4)
446 4100 FORMAT(1x,'FAILURE (TENSSTRAIN) OF BEAM ELEMENT ',i10,1x,',INTEGRATION PT',i2,
447 . 1x,'EQUIVALENT STRAIN=',g11.4,1x,'AT TIME :',1pe12.4)
448C
449 5000 FORMAT(1x,'FAILURE (TENSSTRAIN) OF BEAM ELEMENT ',i10,1x,',INTEGRATION PT',i2,
450 . 1x,'PRINCIPAL STRAIN=',g11.4,1x,'AT TIME :',1pe12.4)
451 5100 FORMAT(1x,'FAILURE (TENSSTRAIN) OF BEAM ELEMENT ',i10,1x,',INTEGRATION PT',i2,
452 . 1x,'PRINCIPAL STRAIN=',g11.4,1x,'AT TIME :',1pe12.4)
453c------------------
454 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