OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
fail_tab_c.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| fail_tab_c ../engine/source/materials/fail/tabulated/fail_tab_c.F
25!||--- called by ------------------------------------------------------
26!|| mulawc ../engine/source/materials/mat_share/mulawc.F90
27!|| usermat_shell ../engine/source/materials/mat_share/usermat_shell.F
28!||--- calls -----------------------------------------------------
29!|| finter ../engine/source/tools/curve/finter.F
30!|| table_interp ../engine/source/tools/curve/table_tools.F
31!|| table_vinterp ../engine/source/tools/curve/table_tools.F
32!|| vinter2 ../engine/source/tools/curve/vinter.F
33!||--- uses -----------------------------------------------------
34!|| interface_table_mod ../engine/share/modules/table_mod.F
35!|| message_mod ../engine/share/message_module/message_mod.F
36!|| table_mod ../engine/share/modules/table_mod.F
37!||====================================================================
38 SUBROUTINE fail_tab_c(
39 1 NEL ,NUPARAM ,NUVAR ,UPARAM ,UVAR ,
40 2 NFUNC ,IFUNC ,TABLE ,NPF ,TF ,
41 3 TIME ,NGL ,IPG ,ILAY ,IPT ,
42 4 SIGNXX ,SIGNYY ,SIGNXY ,NTABLF ,ITABLF ,
43 5 DPLA ,EPSP ,THK ,ALDT ,TEMP ,
44 6 DMG_FLAG ,DMG_SCALE,OFF ,FOFF ,
45 7 DFMAX ,TDEL ,INLOC )
46C-----------------------------------------------
47C tabulated failure model
48C-----------------------------------------------
49 USE table_mod
50 USE interface_table_mod
51 USE message_mod
52C-----------------------------------------------
53C I m p l i c i t T y p e s
54C-----------------------------------------------
55#include "implicit_f.inc"
56C-----------------------------------------------
57C G l o b a l P a r a m e t e r s
58C-----------------------------------------------
59#include "mvsiz_p.inc"
60#include "units_c.inc"
61#include "comlock.inc"
62C---------+---------+---+---+--------------------------------------------
63C VAR | SIZE |TYP| RW| DEFINITION
64C---------+---------+---+---+--------------------------------------------
65C NEL | 1 | I | R | SIZE OF THE ELEMENT GROUP NEL
66C NUPARAM | 1 | I | R | SIZE OF THE USER PARAMETER ARRAY
67C UPARAM | NUPARAM | F | R | USER MATERIAL PARAMETER ARRAY
68C NUVAR | 1 | I | R | NUMBER OF USER ELEMENT VARIABLES
69C UVAR |NEL*NUVAR| F |R/W| USER ELEMENT VARIABLE ARRAY
70C---------+---------+---+---+--------------------------------------------
71C TIME | 1 | F | R | CURRENT TIME
72C---------+---------+---+---+--------------------------------------------
73C SIGNXX | NEL | F | W | NEW ELASTO PLASTIC STRESS XX
74C SIGNYY | NEL | F | W | NEW ELASTO PLASTIC STRESS YY
75C ... | | | |
76C DPLA | NEL | F | R | PLASTIC STRAIN
77C EPSP | NEL | F | R | STRAIN RATE
78C THK | NEL | F | R | ELEMENT THICKNESS
79C TEMP | NEL | F | R | ELEMENT TEMPERATURE
80C---------+---------+---+---+--------------------------------------------
81C OFF | NEL | F | R | DELETED ELEMENT FLAG (=1. ON, =0. OFF)
82C FOFF | NEL | I |R/W| DELETED INTEGRATION POINT FLAG (=1 ON, =0 OFF)
83C DFMAX | NEL | F |R/W| MAX DAMAGE FACTOR
84C TDEL | NEL | F | W | FAILURE TIME
85C DMG_FLAG| 1 | I | W | STRESS REDUCTION FLAG DUE TO DAMAGE
86C DMG_SCALE| NEL | F | W | STRESS REDUCTION FACTOR
87C---------+---------+---+---+--------------------------------------------
88C NGL ELEMENT ID
89C IPG CURRENT GAUSS POINT (in plane)
90C ILAY CURRENT LAYER
91C IPT CURRENT INTEGRATION POINT IN THE LAYER
92C-----------------------------------------------
93C I N P U T A r g u m e n t s
94C-----------------------------------------------
95 INTEGER ,INTENT(IN) :: NEL,NUPARAM,NUVAR,IPG,ILAY,IPT,INLOC,NTABLF
96 INTEGER ,DIMENSION(NEL) ,INTENT(IN) :: NGL
97 INTEGER, DIMENSION(NTABLF) ,INTENT(IN) :: ITABLF
98 my_real ,INTENT(IN) :: TIME
99 my_real ,DIMENSION(NEL) ,INTENT(IN) :: OFF,THK,ALDT,DPLA,EPSP,
100 . TEMP,SIGNXX,SIGNYY,SIGNXY
101 my_real,DIMENSION(NUPARAM) ,INTENT(IN) :: UPARAM
102C-----------------------------------------------
103C I N P U T O U T P U T A r g u m e n t s
104C-----------------------------------------------
105 INTEGER ,INTENT(OUT) ::DMG_FLAG
106 INTEGER ,DIMENSION(NEL) ,INTENT(INOUT) :: FOFF
107 my_real ,DIMENSION(NEL) ,INTENT(INOUT) :: DFMAX
108 my_real ,DIMENSION(NEL) ,INTENT(OUT) :: tdel,dmg_scale
109 my_real ,DIMENSION(NEL,NUVAR) ,INTENT(INOUT) :: uvar
110C-----------------------------------------------
111C VARIABLES FOR FUNCTION INTERPOLATION
112C-----------------------------------------------
113 INTEGER NPF(*), NFUNC, IFUNC(NFUNC)
114 my_real finter ,tf(*)
115 EXTERNAL finter
116 TYPE(ttable) TABLE(*)
117C Y = FINTER(IFUNC(J),X,NPF,TF,DYDX)
118C Y : y = f(x)
119C X : x
120C DYDX : f'(x) = dy/dx
121C IFUNC(J): FUNCTION INDEX
122C J : FIRST(J=1), SECOND(J=2) .. FUNCTION USED FOR THIS LAW
123C NPF,TF : FUNCTION PARAMETER
124C-----------------------------------------------
125C L o c a l V a r i a b l e s
126C-----------------------------------------------
127 INTEGER :: I,J,NINDX,NINDXF,NINSTAB,IFAIL_SH,NDIM,INST_FLAG,SIZE_FLAG,
128 . ITAB_EPSF,ITAB_INST,IFUN_EL,IFUN_TEMP,IFUN_DMG,IFUN_FAD
129 INTEGER, DIMENSION(MVSIZ) :: INDX,INDXF,INDSTAB,IPOSV,IADP,ILENP
130 INTEGER IPOST1(NEL,1),IPOST2(NEL,2),IPOST3(NEL,3)
131C
132 my_real :: SHRF,BIAXF
133 my_real, DIMENSION(MVSIZ) :: EPSF,EPSF_N,SIGM,YYV,DXDYV,LAMBDAV
134 my_real, DIMENSION(2) :: xx2
135 my_real, DIMENSION(NEL,1) :: xxv1
136 my_real, DIMENSION(NEL,2) :: xxv2
137 my_real, DIMENSION(NEL,3) :: xxv3
138 my_real :: p,svm,df,fac,lambda,
139 . y1scale,x1scale,y2scale,x2scale,p_thinn,ecrit,fade_expo,
140 . dcrit,el_ref,sc_el,sc_temp,p_thick,dd,dn,yy_n
141 my_real, DIMENSION(MVSIZ) :: dp
142 INTEGER :: NINDX_2
143 INTEGER, DIMENSION(MVSIZ) :: INDX_2
144C-----------------------------------------------
145C Storage of initial thickness in UVAR(x,2) at time = 0.0
146C 1 = DAMAGE
147C 2 = initial shell thickness
148C 3 = DCrit_NS --> instability starts
149C 4 = percent from instability to failure
150C 5 = initial characteristic el. length
151C 6 = IPOS1 for TABLE_VINTERP
152C 7 = IPOS2 for TABLE_VINTERP
153C 8 = IPOS1 for VINTER
154C=======================================================================
155 ifail_sh = int(uparam(2))
156 p_thick = uparam(3)
157 dcrit = uparam(4)
158 dd = uparam(5)
159 dn = uparam(6)
160 sc_temp = uparam(7)
161 sc_el = uparam(8)
162 el_ref = uparam(9)
163 y1scale = uparam(12)
164 x1scale = uparam(13)
165 y2scale = uparam(14)
166 x2scale = uparam(15)
167 p_thinn = uparam(16)
168 ecrit = uparam(17)
169 fade_expo = uparam(18)
170 dmg_flag = int(uparam(19))
171 inst_flag = int(uparam(20))
172 shrf = uparam(21)
173 biaxf = uparam(22)
174 IF (shrf == -one .and. biaxf == one) THEN
175 size_flag = 0
176 ELSE
177 size_flag = 1
178 END IF
179C-------------------------------------------------------------------
180c---- Failure strain
181 itab_epsf = itablf(1)
182c---- Instability
183 itab_inst = itablf(2)
184c---- Scale functions
185 ifun_el = ifunc(1) ! element size
186 ifun_temp = ifunc(2) ! temperature
187 ifun_dmg = ifunc(3) ! damage
188 ifun_fad = ifunc(4) ! fading exponent
189C---------
190 nindxf = 0
191 nindx = 0
192 ninstab = 0
193 DO i=1,nel
194 IF (inloc > 0) uvar(i,5) = aldt(i)
195 IF (off(i) == one .and. foff(i) == 1) THEN
196 nindx = nindx+1
197 indx(nindx) = i
198 ENDIF
199 ENDDO
200C-------------------------------------------------------------------
201c Failure strain value - function interpolation
202C-------------------------------------------------------------------
203c
204c--- failure strain interpolation
205 ndim = table(itab_epsf)%NDIM
206#include "vectorize.inc"
207 DO j=1,nindx
208 i = indx(j)
209 p = third*(signxx(i) + signyy(i))
210 svm = sqrt(signxx(i)*signxx(i) + signyy(i)*signyy(i)
211 . - signxx(i)*signyy(i) + three*signxy(i)*signxy(i))
212 sigm(i) = p / max(em20,svm)
213 ENDDO
214C----
215 IF (ndim == 3) THEN
216#include "vectorize.inc"
217 DO j=1,nindx
218 i = indx(j)
219 xxv3(j,1) = sigm(i)
220 xxv3(j,2) = epsp(i)*x1scale
221 xxv3(j,3) = zero
222 ipost3(j,1)= nint(uvar(i,6))
223 ipost3(j,2)= nint(uvar(i,7))
224 ipost3(j,3)= 0
225 ENDDO
226 ELSE IF (ndim == 2) THEN
227#include "vectorize.inc"
228 DO j=1,nindx
229 i = indx(j)
230 xxv2(j,1) = sigm(i)
231 xxv2(j,2) = epsp(i)*x1scale
232 ipost2(j,1)= nint(uvar(i,6))
233 ipost2(j,2)= nint(uvar(i,7))
234 ENDDO
235 ELSE IF (ndim == 1) THEN
236#include "vectorize.inc"
237 DO j=1,nindx
238 i = indx(j)
239 xxv1(j,1) = sigm(i)
240 ipost1(j,1) = nint(uvar(i,6))
241 ENDDO
242 END IF
243c
244c check elements with triaxiality between SHRF and BIAXF) in case of SIZE_FLAG=1
245 IF (size_flag == 1) THEN
246#include "vectorize.inc"
247 DO j=1,nindx
248 i = indx(j)
249 IF (sigm(i) > shrf .and. sigm(i) < biaxf) THEN
250 ninstab = ninstab + 1
251 indstab(ninstab) = i
252 END IF
253 ENDDO
254 END IF
255c
256 IF (ndim == 3) THEN
257c
258 CALL table_vinterp (table(itab_epsf),nel,nindx,ipost3,xxv3,yyv,dxdyv)
259c
260#include "vectorize.inc"
261 DO j=1,nindx
262 i = indx(j)
263 epsf(i) = yyv(j) * y1scale
264 uvar(i,6)= ipost3(j,1)
265 uvar(i,7)= ipost3(j,2)
266 ENDDO
267c
268 ELSE IF (ndim == 2) THEN
269c
270 CALL table_vinterp (table(itab_epsf),nel,nindx,ipost2,xxv2,yyv,dxdyv)
271c
272#include "vectorize.inc"
273 DO j=1,nindx
274 i = indx(j)
275 epsf(i) = yyv(j) * y1scale
276 uvar(i,6)=ipost2(j,1)
277 uvar(i,7)=ipost2(j,2)
278 ENDDO
279c
280 ELSE IF (ndim == 1) THEN
281c
282 CALL table_vinterp (table(itab_epsf),nel,nindx,ipost1,xxv1,yyv,dxdyv)
283c
284#include "vectorize.inc"
285 DO j=1,nindx
286 i = indx(j)
287 epsf(i) = yyv(j) * y1scale
288 uvar(i,6) = ipost1(j,1)
289 ENDDO
290
291 END IF
292c
293 IF (ifun_el > 0 .AND. inst_flag /= 2) THEN
294 IF (size_flag == 0) THEN
295#include "vectorize.inc"
296 DO j=1,nindx
297 i = indx(j)
298c---- element length scale function
299 lambdav(j) = uvar(i,5) / el_ref
300 iposv(j) = nint(uvar(i,8))
301 iadp(j) = npf(ifun_el) / 2 + 1
302 ilenp(j) = npf(ifun_el + 1) / 2 -iadp(j) - iposv(j)
303 ENDDO
304c
305 CALL vinter2(tf,iadp,iposv,ilenp,nindx,lambdav,dxdyv,yyv)
306c
307#include "vectorize.inc"
308 DO j=1,nindx
309 i = indx(j)
310 fac = sc_el*yyv(j)
311 epsf(i) = epsf(i)* fac
312 uvar(i,8) = iposv(j)
313 ENDDO
314c
315 ELSE ! SIZE_FLAG = 1
316#include "vectorize.inc"
317 DO j=1,ninstab
318 i = indstab(j)
319c---- element length scale function
320 lambdav(j) = uvar(i,5) / el_ref
321 iposv(j) = nint(uvar(i,8))
322 iadp(j) = npf(ifun_el) / 2 + 1
323 ilenp(j) = npf(ifun_el + 1) / 2 -iadp(j) - iposv(j)
324 ENDDO
325c
326 CALL vinter2(tf,iadp,iposv,ilenp,ninstab,lambdav,dxdyv,yyv)
327c
328#include "vectorize.inc"
329 DO j=1,ninstab
330 i = indstab(j)
331 fac = sc_el*yyv(j)
332 epsf(i) = epsf(i)* fac
333 uvar(i,8) = iposv(j)
334 ENDDO
335 END IF
336 ENDIF
337
338c---- instability function
339c
340 IF (itab_inst > 0) THEN
341c
342#include "vectorize.inc"
343 DO j=1,nindx
344 i = indx(j)
345 xx2(1) = sigm(i)
346 xx2(2) = epsp(i) *x2scale
347 CALL table_interp (table(itab_inst),xx2,yy_n)
348 epsf_n(i) = yy_n * y2scale
349 ENDDO
350c apply element scale factor
351 IF (ifun_el > 0 .AND. inst_flag /= 1) THEN
352 IF (size_flag == 0) THEN
353#include "vectorize.inc"
354 DO j=1,nindx
355 i = indx(j)
356 lambda = uvar(i,5) / el_ref
357 fac = sc_el*finter(ifun_el,lambda,npf,tf,df)
358 epsf_n(i) = epsf_n(i)* fac
359 ENDDO
360 ELSE
361#include "vectorize.inc"
362 DO j=1,ninstab
363 i = indstab(j)
364 lambda = uvar(i,5) / el_ref
365 fac = sc_el*finter(ifun_el,lambda,npf,tf,df)
366 epsf_n(i) = epsf_n(i)* fac
367 ENDDO
368 END IF
369 ENDIF
370c
371 ELSEIF (ecrit > zero) THEN
372c
373#include "vectorize.inc"
374 DO j=1,nindx
375 i = indx(j)
376 epsf_n(i) = ecrit
377 ENDDO
378 ELSE
379#include "vectorize.inc"
380 DO j=1,nindx
381 i = indx(j)
382 epsf_n(i) = zero
383 ENDDO
384 ENDIF
385c---- temperature scale function
386 IF (ifun_temp > 0) THEN
387#include "vectorize.inc"
388 DO j=1,nindx
389 i = indx(j)
390 fac = sc_temp*finter(ifun_temp,temp(i),npf,tf,df)
391 epsf(i) = epsf(i)* fac
392 ENDDO
393 ENDIF
394
395c---- Fading exponent
396 IF (fade_expo < zero) THEN
397!#include "vectorize.inc"
398 DO j=1,nindx
399 i = indx(j)
400 lambda = uvar(i,5) / el_ref
401 fade_expo = finter(ifun_fad,lambda,npf,tf,df)
402 ENDDO
403 ENDIF
404c-----------------------------------------------------------------------------
405 nindx_2 = 0
406 IF (ifun_dmg > 0 ) THEN
407#include "vectorize.inc"
408 DO j=1,nindx
409 i = indx(j)
410 IF (uvar(i,1) < dcrit) THEN
411 nindx_2 = nindx_2 + 1
412 indx_2(nindx_2) = i
413 dp(i) = finter(ifun_dmg,uvar(i,1),npf,tf,df)
414 ENDIF
415 ENDDO
416 ELSE
417#include "vectorize.inc"
418 DO j=1,nindx
419 i = indx(j)
420 IF (uvar(i,1) < dcrit) THEN
421 nindx_2 = nindx_2 + 1
422 indx_2(nindx_2) = i
423 IF (uvar(i,1) == zero) THEN
424 dp(i) = one
425 ELSE
426 dp(i) = dn*uvar(i,1)**(one-one/dn)
427 ENDIF
428 ENDIF
429 ENDDO
430 ENDIF
431#include "vectorize.inc"
432 DO j=1,nindx_2
433 i = indx_2(j)
434 IF (epsf(i) > zero) uvar(i,1) = uvar(i,1)+dp(i)*dpla(i)/epsf(i)
435 IF ((p_thinn*uvar(i,2)) > thk(i)) THEN ! Failure due to thinning
436 uvar(i,1) = dcrit
437 foff(i) = 0
438 tdel(i) = time
439! PTHKF = EM06
440 ENDIF
441c-----
442c Damage accumulation
443 IF (dmg_flag == 1 .AND. uvar(i,1) <= dcrit) THEN
444 IF (epsf_n(i) > zero .AND. sigm(i) >= zero ) THEN
445 uvar(i,3) = uvar(i,3) + dp(i)*dpla(i)/epsf_n(i)
446 ENDIF
447c
448 IF (uvar(i,3) >= one) THEN ! softening starts
449 IF (fade_expo /= zero) THEN
450 uvar(i,4) = uvar(i,4) + dp(i)*dpla(i)/(epsf(i)-epsf_n(i))
451 IF (uvar(i,4) > dd) THEN
452 dmg_scale(i) = one - ((uvar(i,4)-dd)/(one-dd))**fade_expo
453 dmg_scale(i) = max(dmg_scale(i),zero)
454 ENDIF
455 ENDIF
456 ENDIF
457c ELSEIF (DMG_FLAG == 1) THEN
458c DMG_SCALE(I) = ZERO
459 ENDIF ! end damage accumulation and softening
460c-----
461 IF (uvar(i,1) >= dcrit) THEN
462 nindxf = nindxf+1
463 indxf(nindxf) = i
464 tdel(i)= time
465 IF (ifail_sh == 3) THEN
466 foff(i) = -1
467 ELSE
468 foff(i) = 0
469 ENDIF
470 ENDIF
471 ENDDO ! IEL
472c
473c--------------------------------------------
474c Maximum Damage storing for output : 0 < DFMAX < 1
475c
476#include "vectorize.inc"
477 DO j=1,nindx
478 i = indx(j)
479 dfmax(i)= min(one,max(dfmax(i),uvar(i,1)/dcrit))
480 ENDDO
481c--------------------------------------------
482c print
483c--------------------------------------------
484 IF (nindxf > 0) THEN
485 DO j=1,nindxf
486 i = indxf(j)
487#include "lockon.inc"
488 WRITE(iout, 2000) ngl(i),ipg,ilay,ipt
489 WRITE(istdo,2100) ngl(i),ipg,ilay,ipt,time
490#include "lockoff.inc"
491 ENDDO
492 ENDIF
493c------------------------
494 2000 FORMAT(1x,'FAILURE (FTAB) OF SHELL ELEMENT ',i10,1x,',GAUSS PT',
495 . i2,1x,',LAYER',i3,1x,',INTEGRATION PT',i3)
496 2100 FORMAT(1x,'FAILURE (FTAB) OF SHELL ELEMENT ',i10,1x,',GAUSS PT',
497 . i2,1x,',LAYER',i3,1x,',INTEGRATION PT',i3,1x,'AT TIME :',1pe12.4)
498c------------------------
499 RETURN
500 END
ecrit
subroutine ecrit(timers, partsav, ms, v, in, r, dmas, weight, enintot, ekintot, a, ar, fxbipm, fxbrpm, monvol, xmom_sms, sensors, qfricint, ipari, weight_md, wfexth, iflag, ms_2d, multi_fvm, mas_nd, kend, h3d_data, dynain_data, usreint, output)
Definition ecrit.F:52
fail_tab_c
subroutine fail_tab_c(nel, nuparam, nuvar, uparam, uvar, nfunc, ifunc, table, npf, tf, time, ngl, ipg, ilay, ipt, signxx, signyy, signxy, ntablf, itablf, dpla, epsp, thk, aldt, temp, dmg_flag, dmg_scale, off, foff, dfmax, tdel, inloc)
Definition fail_tab_c.F:46
interface_table_mod::table_interp
Definition table_mod.F:242
interface_table_mod::table_vinterp
Definition table_mod.F:251
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
interface_table_mod
Definition table_mod.F:238
message_mod
Definition message_mod.F:1249
table_mod
Definition table_mod.F:112
table_mod::ttable
Definition table_mod.F:125
vinter2
subroutine vinter2(tf, iad, ipos, ilen, nel0, x, dydx, y)
Definition vinter.F:143