OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
fail_tensstrain_b.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_b (nel, ngl, nuparam, uparam, time, epsd, off, dfmax, tdel, iout, istdo, ifunc, epsxx, al, tstar, snpc, npf, stf, tf, ismstr, nuvar, uvar, dmgscl)

Function/Subroutine Documentation

◆ fail_tensstrain_b()

subroutine fail_tensstrain_b ( 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,
integer, intent(in) snpc,
integer, dimension(snpc), intent(in) npf,
integer, intent(in) stf,
intent(in) tf,
integer, intent(in) ismstr,
integer, intent(in) nuvar,
intent(inout) uvar,
intent(inout) dmgscl )

Definition at line 30 of file fail_tensstrain_b.F.

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