OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
fail_tab_s.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_s ../engine/source/materials/fail/tabulated/fail_tab_s.F
25!||--- called by ------------------------------------------------------
26!|| mmain ../engine/source/materials/mat_share/mmain.F90
27!|| mmain8 ../engine/source/materials/mat_share/mmain8.F
28!|| mulaw ../engine/source/materials/mat_share/mulaw.F90
29!|| mulaw8 ../engine/source/materials/mat_share/mulaw8.F90
30!|| usermat_solid ../engine/source/materials/mat_share/usermat_solid.F
31!||--- calls -----------------------------------------------------
32!|| finter ../engine/source/tools/curve/finter.F
33!|| table_vinterp ../engine/source/tools/curve/table_tools.F
34!||--- uses -----------------------------------------------------
35!|| interface_table_mod ../engine/share/modules/table_mod.F
36!|| table_mod ../engine/share/modules/table_mod.F
37!||====================================================================
38 SUBROUTINE fail_tab_s (
39 1 NEL ,NUVAR ,NPF ,TF ,TIME ,
40 2 UPARAM ,NGL ,ALDT ,
41 4 SIGNXX ,SIGNYY ,SIGNZZ ,SIGNXY ,SIGNYZ ,SIGNZX ,
42 5 DPLA ,EPSP ,TSTAR ,UVAR ,NTABLF ,ITABLF ,
43 6 OFF ,TABLE ,DFMAX ,TDELE ,NFUNC ,IFUNC )
44C---------+---------+---+---+--------------------------------------------
45 USE table_mod
46 USE interface_table_mod
47C---------+---------+---+---+--------------------------------------------
48C /FAIL/TAB - tabulated rupture criteria for solids
49C-----------------------------------------------
50C I m p l i c i t T y p e s
51C-----------------------------------------------
52#include "implicit_f.inc"
53C---------+---------+---+---+--------------------------------------------
54C VAR | SIZE |TYP| RW| DEFINITION
55C---------+---------+---+---+--------------------------------------------
56C NEL | 1 | I | R | SIZE OF THE ELEMENT GROUP NEL
57C NUPARAM | 1 | I | R | SIZE OF THE USER PARAMETER ARRAY
58C NUVAR | 1 | I | R | NUMBER OF FAILURE ELEMENT VARIABLES
59C---------+---------+---+---+--------------------------------------------
60C NPF | * | I | R | FUNCTION ARRAY
61C TF | * | F | R | FUNCTION ARRAY
62C---------+---------+---+---+--------------------------------------------
63C TIME | 1 | F | R | CURRENT TIME
64C TIMESTEP| 1 | F | R | CURRENT TIME STEP
65C UPARAM | NUPARAM | F | R | USER FAILURE PARAMETER ARRAY
66C---------+---------+---+---+--------------------------------------------
67C SIGNXX | NEL | F | W | NEW ELASTO PLASTIC STRESS XX
68C SIGNYY | NEL | F | W | NEW ELASTO PLASTIC STRESS YY
69C ... | | | |
70C ... | | | |
71C---------+---------+---+---+--------------------------------------------
72C UVAR |NEL*NUVAR| F |R/W| USER ELEMENT VARIABLE ARRAY
73C OFF | NEL | F |R/W| DELETED ELEMENT FLAG (=1. ON, =0. OFF)
74C---------+---------+---+---+--------------------------------------------
75#include "mvsiz_p.inc"
76#include "units_c.inc"
77#include "param_c.inc"
78#include "scr17_c.inc"
79#include "impl1_c.inc"
80#include "comlock.inc"
81C-----------------------------------------------
82C I N P U T A r g u m e n t s
83C-----------------------------------------------
84 INTEGER NEL,NUVAR
85 INTEGER NGL(NEL)
86 INTEGER, INTENT(IN) :: NFUNC
87 INTEGER, INTENT(IN) :: NTABLF
88 INTEGER, DIMENSION(NFUNC) ,INTENT(IN) :: IFUNC
89 INTEGER, DIMENSION(NTABLF) ,INTENT(IN) :: ITABLF
90c
91 my_real time,uparam(*),aldt(nel),
92 . signxx(nel),signyy(nel),signzz(nel),
93 . signxy(nel),signyz(nel),signzx(nel),
94 . dpla(nel),epsp(nel),tstar(nel)
95C-----------------------------------------------
96C I N P U T O U T P U T A r g u m e n t s
97C-----------------------------------------------
98 TYPE(ttable) TABLE(*)
99 my_real, DIMENSION(NEL,3) :: XX0
100 my_real
101 . UVAR(NEL,NUVAR), OFF(NEL), DFMAX(NEL),TDELE(NEL)
102C-----------------------------------------------
103C VARIABLES FOR FUNCTION INTERPOLATION
104C-----------------------------------------------
105 INTEGER NPF(*)
106 my_real FINTER ,TF(*)
107 EXTERNAL FINTER
108C Y = FINTER(IFUNC(J),X,NPF,TF,DYDX)
109C Y : y = f(x)
110C X : x
111C DYDX : f'(x) = dy/dx
112C IFUNC(J): FUNCTION INDEX
113C J : FIRST(J=1), SECOND(J=2) .. FUNCTION USED FOR THIS LAW
114C NPF,TF : FUNCTION PARAMETER
115C-----------------------------------------------
116C L o c a l V a r i a b l e s
117C-----------------------------------------------
118 INTEGER I,J,IDEL,IDEV,NINDX,
119 . IFUN_EL,IFUN_TEMP,ID_DD ,ITAB_EPSF
120 INTEGER :: SFLAG
121 INTEGER, DIMENSION(MVSIZ) :: INDX
122 INTEGER :: NINDX_2
123 INTEGER, DIMENSION(MVSIZ) :: INDX_2
124 INTEGER, DIMENSION(NEL,3) :: IPOS
125 my_real, DIMENSION(MVSIZ) :: epsf,yy,dydx,dp
126 my_real :: dcrit,dd,dn,sc_temp,sc_el,el_ref
127 my_real
128 . p,sigm,svm,sxx,syy,szz,df,fac,lambda,
129 . xi,theta, det,y1scale,
130 . x1scale
131C=======================================================================
132C INITIALIZATIONS
133C-----------------------------------------------
134 sflag = int(uparam(1))
135 dcrit = uparam(4)
136 dd = uparam(5)
137 dn = uparam(6)
138 sc_temp = uparam(7)
139 sc_el = uparam(8)
140 el_ref = uparam(9)
141 y1scale = uparam(12)
142 x1scale = uparam(13)
143c---
144 idel = 0
145 idev = 0
146 indx = 0
147 IF (sflag == 1) THEN
148 idel=1
149 ELSEIF (sflag == 2) THEN
150 idev =1
151 ELSEIF (sflag == 3) THEN
152 idev = 2
153 ENDIF
154C-------------------------------------------------------------------
155c Failure strain value - function interpolation
156C-------------------------------------------------------------------
157
158 ipos(1:nel,1:3) = 1
159 DO i=1,nel
160C--- failure strain interpolation
161 p = third*(signxx(i) + signyy(i) + signzz(i))
162 sxx = signxx(i) - p
163 syy = signyy(i) - p
164 szz = signzz(i) - p
165 svm = half*(sxx**2 + syy**2 + szz**2)
166 . + signxy(i)**2+ signzx(i)**2 + signyz(i)**2
167 svm = sqrt(three*svm)
168 sigm = p / max(em20,svm)
169C----
170 det = sxx*syy*szz + two*signxy(i)*signzx(i)*signyz(i)-
171 . sxx*signyz(i)**2-szz*signxy(i)**2-syy*signzx(i)**2
172
173 xi = one/max(em20,svm**3)
174 xi = half*twenty7*det*xi
175 IF(xi < -one) xi = -one
176 IF(xi > one) xi = one
177 theta = one - two*acos(xi)/pi
178 xx0(i,1)=sigm
179 xx0(i,2)=epsp(i) *x1scale
180 xx0(i,3)=theta
181 ENDDO
182 itab_epsf = itablf(1)
183
184 CALL table_vinterp(table(itab_epsf),nel,nel,ipos,xx0,yy,dydx)
185 epsf(1:nel) = yy(1:nel)*y1scale
186
187
188c---- Scale functions
189 DO i=1,nel
190 ifun_el = ifunc(1)
191 ifun_temp = ifunc(2)
192c---- element length scale function
193 IF (ifun_el > 0) THEN
194 lambda = aldt(i) / el_ref
195 fac = sc_el*finter(ifun_el,lambda,npf,tf,df)
196 epsf(i) = epsf(i)* fac
197 ENDIF
198c---- temperature scale function
199 IF (ifun_temp > 0) THEN
200 fac = sc_temp*finter(ifun_temp,tstar(i),npf,tf,df)
201 epsf(i) = epsf(i)* fac
202 ENDIF
203 ENDDO
204c-------------------------------------------------------------------
205c---- element will be deleted
206 IF (idel == 1) THEN
207 DO i=1,nel
208 IF (off(i) < 0.1) off(i)=zero
209 IF (off(i) < one) off(i)=off(i)*four_over_5
210 ENDDO
211 ENDIF
212C
213 IF (idel == 1)THEN
214 nindx = 0
215 nindx_2 = 0
216 id_dd = ifunc(3)
217 ! --------------
218 ! need to split the loop to vectorize the ID_DD==0 loop
219 IF(id_dd /= 0 )THEN
220 DO i=1,nel
221 IF (sflag==1 .AND. off(i)==one) THEN
222 nindx_2 = nindx_2 + 1
223 indx_2(nindx_2) = i
224 dp(i) = finter(id_dd,uvar(i,1),npf,tf,df)
225 ENDIF
226 ENDDO
227 ELSE
228 DO i=1,nel
229 IF (sflag==1 .AND. off(i)==one) THEN
230 nindx_2 = nindx_2 + 1
231 indx_2(nindx_2) = i
232 dp(i) = dn*dd**(one-one/dn)
233 ENDIF
234 ENDDO
235 ENDIF
236 ! --------------
237#include "vectorize.inc"
238 DO j=1,nindx_2
239 i = indx_2(j)
240 IF (epsf(i) > zero) uvar(i,1)=uvar(i,1)+dp(i)*dpla(i)/epsf(i)
241 IF (uvar(i,1) >= dcrit) THEN
242 off(i)=four_over_5
243 nindx=nindx+1
244 indx(nindx)=i
245 tdele(i) = time
246 ENDIF
247 ENDDO
248 IF (nindx > 0 .AND. imconv == 1)THEN
249 DO j=1,nindx
250#include "lockon.inc"
251 WRITE(iout, 1000) ngl(indx(j))
252 WRITE(istdo,1100) ngl(indx(j)),time
253#include "lockoff.inc"
254 ENDDO
255 ENDIF
256 ENDIF
257C----
258 IF (idev > 0) THEN ! element deleted when rupture in all integration points
259
260 ! --------------
261 nindx = 0
262 nindx_2 = 0
263 DO i=1,nel
264 IF (off(i) == one .AND. (sflag==2 .OR. sflag==3)) THEN
265 nindx_2 = nindx_2 + 1
266 indx_2(nindx_2) = i
267 dp(i) = zero
268 IF (uvar(i,1) < dcrit)THEN
269 id_dd = ifunc(3)
270 IF(id_dd /= 0 )THEN
271 dp(i) = finter(id_dd,uvar(i,1),npf,tf,df)
272 ELSE
273 dp(i) = dn*dd**(one-one/dn)
274 ENDIF
275 ENDIF
276 ENDIF
277 ENDDO
278 ! --------------
279#include "vectorize.inc"
280 DO j=1,nindx_2
281 i = indx_2(j)
282 IF (uvar(i,1) < dcrit)THEN
283 IF (epsf(i) > zero) uvar(i,1)=uvar(i,1)+dp(i)*dpla(i)/epsf(i)
284 IF (uvar(i,1) >= dcrit) THEN
285 nindx=nindx+1
286 indx(nindx)=i
287 p = third*(signxx(i) + signyy(i) + signzz(i))
288 IF (sflag == 2) THEN
289 signxx(i) = p
290 signyy(i) = p
291 signzz(i) = p
292 ENDIF
293 ENDIF
294 ELSEIF (sflag == 2) THEN ! UVAR > DCRIT
295 p = third*(signxx(i) + signyy(i) + signzz(i))
296 signxx(i) = p
297 signyy(i) = p
298 signzz(i) = p
299 ENDIF
300 ENDDO
301 ! --------------
302 IF (nindx > 0.AND.imconv == 1) THEN
303 DO j=1,nindx
304 i = indx(j)
305#include "lockon.inc"
306 WRITE(iout, 2000) ngl(i)
307 WRITE(istdo,2100) ngl(i),time
308#include "lockoff.inc"
309 END DO
310 ENDIF
311 ! --------------
312 ENDIF
313C-------------Maximum Damage storing for output : 0 < DFMAX < 1--------------
314 DO i=1,nel
315 dfmax(i)= min(one,max(dfmax(i),uvar(i,1)/dcrit))
316 ENDDO
317C-----------------------------------------------
318 1000 FORMAT(1x,'DELETE SOLID ELEMENT NUMBER ',i10)
319 1100 FORMAT(1x,'DELETE SOLID ELEMENT NUMBER ',i10,
320 . ' AT TIME :',1pe12.4)
321C
322 2000 FORMAT(1x,' DEVIATORIC STRESS SET TO ZERO',i10)
323 2100 FORMAT(1x,' DEVIATORIC STRESS SET TO ZERO',i10,
324 . ' AT TIME :',1pe12.4)
325c-----------
326 RETURN
327 END
my_real
#define my_real
Definition cppsort.cpp:32
fail_tab_s
subroutine fail_tab_s(nel, nuvar, npf, tf, time, uparam, ngl, aldt, signxx, signyy, signzz, signxy, signyz, signzx, dpla, epsp, tstar, uvar, ntablf, itablf, off, table, dfmax, tdele, nfunc, ifunc)
Definition fail_tab_s.F:44
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
table_mod
Definition table_mod.F:112
table_mod::ttable
Definition table_mod.F:125