OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
fail_tab_old_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_old_c ../engine/source/materials/fail/tabulated/fail_tab_old_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!|| vinter ../engine/source/tools/curve/vinter.F
31!||--- uses -----------------------------------------------------
32!|| message_mod ../engine/share/message_module/message_mod.F
33!||====================================================================
34 SUBROUTINE fail_tab_old_c(
35 1 NEL ,NUPARAM ,NUVAR ,UPARAM ,UVAR ,
36 2 NFUNC ,IFUNC ,NPF ,TF ,
37 3 TIME ,NGL ,IPG ,ILAY ,IPT ,
38 4 SIGNXX ,SIGNYY ,SIGNXY ,SIGNYZ ,SIGNZX ,
39 5 DPLA ,EPSP ,THK ,ALDT ,TEMP ,
40 6 OFF ,FOFF ,DFMAX ,TDEL )
41C-----------------------------------------------
42C tabulated failure model
43C-----------------------------------------------
44 USE message_mod
45C-----------------------------------------------
46C I m p l i c i t T y p e s
47C-----------------------------------------------
48#include "implicit_f.inc"
49C-----------------------------------------------
50C G l o b a l P a r a m e t e r s
51C-----------------------------------------------
52#include "units_c.inc"
53#include "comlock.inc"
54C-----------------------------------------------
55C I N P U T A r g u m e n t s
56C-----------------------------------------------
57 INTEGER ,INTENT(IN) :: NEL,NUPARAM,NUVAR,IPG,ILAY,IPT
58 INTEGER ,DIMENSION(NEL) ,INTENT(IN) :: NGL
59 my_real ,INTENT(IN) :: TIME
60 my_real ,DIMENSION(NEL) ,INTENT(IN) :: OFF,THK,ALDT,DPLA,EPSP,
61 . TEMP,SIGNXX,SIGNYY,SIGNXY,SIGNYZ,SIGNZX
62 my_real,DIMENSION(NUPARAM) ,INTENT(IN) :: UPARAM
63C-----------------------------------------------
64C I N P U T O U T P U T A r g u m e n t s
65C-----------------------------------------------
66 INTEGER ,DIMENSION(NEL) ,INTENT(INOUT) :: FOFF
67 my_real ,DIMENSION(NEL) ,INTENT(INOUT) :: DFMAX
68 my_real ,DIMENSION(NEL) ,INTENT(OUT) :: tdel
69 my_real ,DIMENSION(NEL,NUVAR) ,INTENT(INOUT) :: uvar
70C-----------------------------------------------
71C VARIABLES FOR FUNCTION INTERPOLATION
72C-----------------------------------------------
73 INTEGER NPF(*), NFUNC, IFUNC(NFUNC)
74 my_real finter ,tf(*)
75 EXTERNAL finter
76C-----------------------------------------------
77C L o c a l V a r i a b l e s
78C-----------------------------------------------
79 INTEGER :: I,J,J1,J2,K,IP_THICK,NINDX,NINDXF,IFAIL_SH,NRATE,
80 . ifun_el,ifun_temp
81 INTEGER, DIMENSION(NEL) :: INDX,INDXF,IPOSV,IADP,ILENP
82 INTEGER IPOST(NEL,2)
83 INTEGER ,DIMENSION(NFUNC) :: IFUN_STR
84C
85 my_real :: p,svm,df,fac,lambda,dcrit,el_ref,sc_el,sc_temp,p_thick,
86 . dp,dd,dn,yy,yy_n,ef1,ef2
87 my_real, DIMENSION(NFUNC) :: yfac,rate
88 my_real, DIMENSION(NEL) :: epsf,epsf_n,sigm,yyv,dxdyv,lambdav
89C-----------------------------------------------
90C UVAR(1) = DAMAGE
91C UVAR(2) = initial characteristic el. length
92C UVAR(3) = IPOS variable for element length scale function interpolation
93C=======================================================================
94 IF (uvar(1,2) == zero) THEN
95 uvar(1:nel,2) = aldt(1:nel)
96 ENDIF
97c---------------------------
98 ifail_sh = int(uparam(2))
99 p_thick = uparam(3)
100 dcrit = uparam(4)
101 dd = uparam(5)
102 dn = uparam(6)
103 sc_temp = uparam(7)
104 sc_el = uparam(8)
105 el_ref = uparam(9)
106 nrate = nfunc - 2
107 yfac(1:nrate) = uparam(11+1 :11+nrate)
108 rate(1:nrate) = uparam(11+nrate:11+nrate*2)
109c-------------------------------------------------------------------
110c---- Failure strain functions
111 ifun_str(1:nrate) = ifunc(1:nrate)
112c---- Scale functions
113 ifun_el = ifunc(nrate+1)
114 ifun_temp = ifunc(nrate+2)
115C---------
116 nindxf = 0
117 nindx = 0
118 DO i=1,nel
119 IF (off(i) == one .and. foff(i) == 1) THEN
120 nindx = nindx+1
121 indx(nindx) = i
122 ENDIF
123 ENDDO
124c-------------------------------------------------------------------
125c Failure strain value - function interpolation
126c-------------------------------------------------------------------
127 DO j=1,nindx
128 i = indx(j)
129 j1 = 1
130 DO k=2, nrate-1
131 IF (epsp(i) > rate(i)) j1 = k
132 ENDDO
133 p = third*(signxx(i) + signyy(i))
134 svm = sqrt(signxx(i)*signxx(i) + signyy(i)*signyy(i)
135 . - signxx(i)*signyy(i) + three*signxy(i)*signxy(i))
136 sigm = p / max(em20,svm)
137c----
138 IF (nrate > 1) THEN
139 j2 = j1+1
140 ef1 = yfac(j1)*finter(ifunc(j1),sigm,npf,tf,df)
141 ef2 = yfac(j2)*finter(ifunc(j2),sigm,npf,tf,df)
142 fac = (epsp(i) - rate(j1)) / (rate(j2) - rate(j1))
143 epsf(i) = max(ef1 + fac*(ef2 - ef1), em20)
144 ELSE
145 epsf(i) = yfac(j1)*finter(ifunc(j1),sigm,npf,tf,df)
146 ENDIF
147 ENDDO
148c----
149 IF (ifun_el > 0) THEN
150#include "vectorize.inc"
151 DO j=1,nindx
152 i = indx(j)
153c---- element length scale function
154 lambdav(j) = uvar(i,2) / el_ref
155 iposv(j) = nint(uvar(i,3))
156 iadp(j) = npf(ifun_el) / 2 + 1
157 ilenp(j) = npf(ifun_el + 1) / 2 -iadp(j) - iposv(j)
158 ENDDO
159c
160 CALL vinter(tf,iadp,iposv,ilenp,nindx,lambdav,dxdyv,yyv)
161c
162#include "vectorize.inc"
163 DO j=1,nindx
164 i = indx(j)
165 fac = sc_el*yyv(j)
166 epsf(i) = epsf(i)* fac
167 uvar(i,3) = iposv(j)
168 ENDDO
169 ENDIF
170c----
171#include "vectorize.inc"
172 DO j=1,nindx
173 i = indx(j)
174 epsf_n(i) = zero
175 ENDDO
176c---- temperature scale function
177 IF (ifun_temp > 0) THEN
178 DO j=1,nindx
179 i = indx(j)
180 fac = sc_temp*finter(ifun_temp,temp(i),npf,tf,df)
181 epsf(i) = epsf(i)* fac
182 ENDDO
183 ENDIF
184c-----------------------------------------------------------------------------
185 DO j=1,nindx
186 i = indx(j)
187 IF (uvar(i,1) < dcrit) THEN
188 IF (uvar(i,1) == zero) THEN
189 dp = one
190 ELSE
191 dp = dn*uvar(i,1)**(one-one/dn)
192 ENDIF
193 IF (epsf(i) > zero) uvar(i,1) = uvar(i,1)+dp*dpla(i)/epsf(i)
194c-----
195 IF (uvar(i,1) >= dcrit) THEN
196 nindxf = nindxf+1
197 indxf(nindxf) = i
198 tdel(i)= time
199 IF (ifail_sh == 3) THEN
200 foff(i) = -1
201 ELSE
202 foff(i) = 0
203 ENDIF
204 ENDIF
205 ENDIF
206 ENDDO ! IEL
207c
208c--------------------------------------------
209c Maximum Damage storing for output : 0 < DFMAX < 1
210c
211 DO j=1,nindx
212 i = indx(j)
213 dfmax(i)= min(one,max(dfmax(i),uvar(i,1)/dcrit))
214 ENDDO
215c--------------------------------------------
216c print
217c--------------------------------------------
218 IF (nindxf > 0) THEN
219 DO j=1,nindxf
220 i = indxf(j)
221#include "lockon.inc"
222 WRITE(iout, 2000) ngl(i),ipg,ilay,ipt
223 WRITE(istdo,2100) ngl(i),ipg,ilay,ipt,time
224#include "lockoff.inc"
225 ENDDO
226 ENDIF
227c------------------------
228 2000 FORMAT(1x,'FAILURE (FTAB) OF SHELL ELEMENT ',i10,1x,',GAUSS PT',
229 . i2,1x,',LAYER',i3,1x,',INTEGRATION PT',i3)
230 2100 FORMAT(1x,'FAILURE (FTAB) OF SHELL ELEMENT ',i10,1x,',GAUSS PT',
231 . i2,1x,',LAYER',i3,1x,',INTEGRATION PT',i3,1x,'AT TIME :',1pe12.4)
232c------------------------
233 RETURN
234 END
fail_tab_old_c
subroutine fail_tab_old_c(nel, nuparam, nuvar, uparam, uvar, nfunc, ifunc, npf, tf, time, ngl, ipg, ilay, ipt, signxx, signyy, signxy, signyz, signzx, dpla, epsp, thk, aldt, temp, off, foff, dfmax, tdel)
Definition fail_tab_old_c.F:41
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
message_mod
Definition message_mod.F:1249
vinter
subroutine vinter(tf, iad, ipos, ilen, nel, x, dydx, y)
Definition vinter.F:72