OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
fail_tbutcher_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_tbutcher_s ../engine/source/materials/fail/tuler_butcher/fail_tbutcher_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!||====================================================================
32 SUBROUTINE fail_tbutcher_s(
33 1 NEL ,NUPARAM,NUVAR ,
34 2 TIME ,TIMESTEP ,UPARAM ,NGL ,
35 3 SIGNXX ,SIGNYY ,SIGNZZ ,SIGNXY ,SIGNYZ ,SIGNZX ,
36 4 UVAR ,OFF ,DFMAX ,TDELE )
37C-----------------------------------------------
38C I m p l i c i t T y p e s
39C-----------------------------------------------
40#include "implicit_f.inc"
41C---------+---------+---+---+--------------------------------------------
42c Tuler Butcher
43C-----------------------------------------------
44C VAR | SIZE |TYP| RW| DEFINITION
45C---------+---------+---+---+--------------------------------------------
46C NEL | 1 | I | R | SIZE OF THE ELEMENT GROUP NEL
47C NUPARAM | 1 | I | R | SIZE OF THE USER PARAMETER ARRAY
48C NUVAR | 1 | I | R | NUMBER OF USER ELEMENT VARIABLES
49C---------+---------+---+---+--------------------------------------------
50
51C---------+---------+---+---+--------------------------------------------
52C TIME | 1 | F | R | CURRENT TIME
53C TIMESTEP| 1 | F | R | CURRENT TIME STEP
54C UPARAM | NUPARAM | F | R | USER MATERIAL PARAMETER ARRAY
55C EPSPXX | NEL | F | R | STRAIN RATE XX
56C EPSPYY | NEL | F | R | STRAIN RATE YY
57C ... | | | |
58C DEPSXX | NEL | F | R | STRAIN INCREMENT XX
59C DEPSYY | NEL | F | R | STRAIN INCREMENT YY
60C ... | | | |
61C EPSXX | NEL | F | R | STRAIN XX
62C EPSYY | NEL | F | R | STRAIN YY
63C ... | | | |
64C SIGOXX | NEL | F | R | OLD ELASTO PLASTIC STRESS XX
65C SIGOYY | NEL | F | R | OLD ELASTO PLASTIC STRESS YY
66C ... | | | |
67C---------+---------+---+---+--------------------------------------------
68C SIGNXX | NEL | F | W | NEW ELASTO PLASTIC STRESS XX
69C SIGNYY | NEL | F | W | NEW ELASTO PLASTIC STRESS YY
70C ... | | | |
71C SIGVXX | NEL | F | W | VISCOUS STRESS XX
72C SIGVYY | NEL | F | W | VISCOUS STRESS YY
73C ... | | | |
74C SOUNDSP | NEL | F | W | SOUND SPEED (NEEDED FOR TIME STEP)
75C VISCMAX | NEL | F | W | MAXIMUM DAMPING MODULUS(NEEDED FOR TIME STEP)
76C---------+---------+---+---+--------------------------------------------
77C UVAR |NEL*NUVAR| F |R/W| USER ELEMENT VARIABLE ARRAY
78C OFF | NEL | F |R/W| DELETED ELEMENT FLAG (=1. ON, =0. OFF)
79C---------+---------+---+---+--------------------------------------------
80#include "mvsiz_p.inc"
81#include "scr17_c.inc"
82#include "units_c.inc"
83#include "comlock.inc"
84#include "param_c.inc"
85#include "impl1_c.inc"
86C-----------------------------------------------
87C I N P U T A r g u m e n t s
88C-----------------------------------------------
89C
90 INTEGER NEL, NUPARAM, NUVAR,NGL(NEL)
91 my_real
92 . TIME,TIMESTEP,UPARAM(*),
93 . SIGNXX(NEL),SIGNYY(NEL),SIGNZZ(NEL),
94 . signxy(nel),signyz(nel),signzx(nel)
95C-----------------------------------------------
96C O U T P U T A r g u m e n t s
97C-----------------------------------------------
98cc my_real
99
100C-----------------------------------------------
101C I N P U T O U T P U T A r g u m e n t s
102C-----------------------------------------------
103 my_real uvar(nel,nuvar), off(nel),dfmax(nel),tdele(nel)
104C-----------------------------------------------
105C L o c a l V a r i a b l e s
106C-----------------------------------------------
107 INTEGER I,J,IDEL,IDEV,IFLAG,INDX(MVSIZ),IADBUF,NINDX,
108 . NINDEX,INDEX(MVSIZ),IFAIL,IR,JJ
109 my_real
110 . TBA,TBK,SIGR,SVM,SCALE,SXX,SYY,SZZ,
111 . e1,e2,e3,e4,e5,e6,
112 . epst2, a, cc1, b, y ,yp, d, e42, e52, c, e62,p,sigmax
113c=======================================================================
114
115 tba = uparam(1)
116 tbk = uparam(2)
117 sigr = uparam(3)
118 iflag = int(uparam(5))
119
120C-----------------------------------------------
121 idel=0
122 idev=0
123 scale = zero
124 IF(iflag==1)THEN
125 idel=1
126 ELSEIF(iflag==2)THEN
127 idev =1
128 END IF
129C...
130 IF(idel==1)THEN
131 DO i=1,nel
132 IF(off(i)<0.1) off(i)=0.0
133 IF(off(i)<1.0) off(i)=off(i)*0.8
134 END DO
135 END IF
136C
137 IF(idel==1)THEN
138 nindx=0
139C-------------------------------
140C RUPTURE DUCTILE
141C-------------------------------
142C Tuler Butcher
143 DO i=1,nel
144 IF(iflag==1.AND.off(i)==1.)THEN
145C-------------------
146C STREES principal 1, 4 newton iterations
147C-------------------
148 p = third*(signxx(i) + signyy(i) + signzz(i))
149 e1 = signxx(i) - p
150 e2 = signyy(i) - p
151 e3 = signzz(i) - p
152 e4 = signxy(i)
153 e5 = signyz(i)
154 e6 = signzx(i)
155C -y = (e1-x)(e2-x)(e3-x)
156C - e5^2(e1-x) - e6^2(e2-x) - e4^2(e3-x)
157C + 2e4 e5 e6
158C e1 + e2 + e3 = 0 => terme en x^2 = 0
159C y = x^3 + c x + d
160c yp= 3 x^2 + c
161 e42 = e4*e4
162 e52 = e5*e5
163 e62 = e6*e6
164 c = - half * (e1*e1 + e2*e2 + e3*e3) - e42 - e52 - e62
165 d = - e1*e2*e3 + e1*e52 + e2*e62 + e3*e42
166 & - two*e4*e5*e6
167 cc1 = c*third
168 sigmax = sqrt(-cc1)
169 epst2 = sigmax * sigmax
170 y = (epst2 + c)* sigmax + d
171 IF(abs(y)>em8)THEN
172 sigmax = 1.75 * sigmax
173 epst2 = sigmax * sigmax
174 y = (epst2 + c)* sigmax + d
175 yp = three*epst2 + c
176 IF(yp/=zero)sigmax = sigmax - y/yp
177 epst2 = sigmax * sigmax
178 y = (epst2 + c)* sigmax + d
179 yp = three*epst2 + c
180 IF(yp/=zero)sigmax = sigmax - y/yp
181 epst2 = sigmax * sigmax
182 y = (epst2 + c)* sigmax + d
183 yp = three*epst2 + c
184 IF(yp/=zero)sigmax = sigmax - y/yp
185 epst2 = sigmax * sigmax
186 y = (epst2 + c)* sigmax + d
187 yp = three*epst2 + c
188 IF(yp/=zero)sigmax = sigmax - y/yp
189 ENDIF
190 sigmax = sigmax + p
191 IF(sigmax>=sigr)
192 . uvar(i,1)=uvar(i,1) + timestep*(sigmax - sigr)**tba
193cc UVAR(I,2)=UVAR(I,2) + TIMESTEP
194 IF (uvar(i,1)>tbk) THEN
195 off(i) = four_over_5
196 nindx=nindx+1
197 indx(nindx)=i
198 tdele(i) = time
199 ENDIF
200 ENDIF
201 ENDDO
202 IF(nindx>0.AND.imconv==1)THEN
203 DO j=1,nindx
204 i=indx(j)
205#include "lockon.inc"
206 WRITE(istdo,1000)ngl(i)
207 WRITE(iout,1100)ngl(i),time
208#include "lockoff.inc"
209 END DO
210 END IF
211C end Tuler Butcher
212 END IF
213
214Cc deviatoric will be vanished
215 IF(idev==1)THEN
216 nindx=0
217 DO i=1,nel
218 IF(iflag==2.AND.off(i)==1.)THEN
219 IF(uvar(i,1)<tbk)THEN
220 p = third*(signxx(i) + signyy(i) + signzz(i))
221 e1 = signxx(i) - p
222 e2 = signyy(i) - p
223 e3 = signzz(i) - p
224 e4 = signxy(i)
225 e5 = signyz(i)
226 e6 = signzx(i)
227C -y = (e1-x)(e2-x)(e3-x)
228C - e5^2(e1-x) - e6^2(e2-x) - e4^2(e3-x)
229C + 2e4 e5 e6
230C e1 + e2 + e3 = 0 => terme en x^2 = 0
231C y = x^3 + c x + d
232c yp= 3 x^2 + c
233 e42 = e4*e4
234 e52 = e5*e5
235 e62 = e6*e6
236 c = - half * (e1*e1 + e2*e2 + e3*e3) - e42 - e52 - e62
237 d = - e1*e2*e3 + e1*e52 + e2*e62 + e3*e42
238 & - two*e4*e5*e6
239 cc1 = c*third
240 sigmax = sqrt(-cc1)
241 epst2 = sigmax * sigmax
242 y = (epst2 + c)* sigmax + d
243 IF(abs(y)>em8)THEN
244 sigmax = 1.75 * sigmax
245 epst2 = sigmax * sigmax
246 y = (epst2 + c)* sigmax + d
247 yp = three*epst2 + c
248 IF(yp/=zero)sigmax = sigmax - y/yp
249 epst2 = sigmax * sigmax
250 y = (epst2 + c)* sigmax + d
251 yp = three*epst2 + c
252 IF(yp/=zero)sigmax = sigmax - y/yp
253 epst2 = sigmax * sigmax
254 y = (epst2 + c)* sigmax + d
255 yp = three*epst2 + c
256 IF(yp/=zero)sigmax = sigmax - y/yp
257 epst2 = sigmax * sigmax
258 y = (epst2 + c)* sigmax + d
259 yp = three*epst2 + c
260 IF(yp/=zero)sigmax = sigmax - y/yp
261 ENDIF
262 sigmax = sigmax + p
263 IF(sigmax>=sigr)
264 . uvar(i,1)=uvar(i,1) + timestep*(sigmax - sigr)**tba
265cc UVAR(I,2)=UVAR(I,2) + TIMESTEP
266 IF(uvar(i,1)>tbk) THEN
267 nindx=nindx+1
268 indx(nindx)=i
269 signxx(i) = p
270 signyy(i) = p
271 signzz(i) = p
272 signxy(i) = zero
273 signyz(i) = zero
274 signzx(i) = zero
275 ENDIF
276C uvar> tbk
277 ELSE
278 p= third*(signxx(i) + signyy(i) + signzz(i))
279 signxx(i) = p
280 signyy(i) = p
281 signzz(i) = p
282 signxy(i) = zero
283 signyz(i) = zero
284 signzx(i) = zero
285 ENDIF
286 ENDIF
287 ENDDO
288 IF(nindx>0.AND.imconv==1)THEN
289 DO j=1,nindx
290 i = indx(j)
291#include "lockon.inc"
292 WRITE(iout, 2000) ngl(i)
293 WRITE(istdo,2100) ngl(i),time
294#include "lockoff.inc"
295 END DO
296 END IF
297 ENDIF
298C-------------Maximum Damage storing for output : 0 < DFMAX < 1--------------
299 DO i=1,nel
300 dfmax(i)= min(one,max(dfmax(i),uvar(i,1)/tbk))
301 ENDDO
302C-----------------------------------------------
303 1000 FORMAT(1x,'DELETE SOLID ELEMENT NUMBER ',i10)
304 1100 FORMAT(1x,'DELETE SOLID ELEMENT NUMBER ',i10,
305 . ' AT TIME :',1pe20.13)
306CC
307 2000 FORMAT(1x,' DEVIATORIC STRESS WILL BE VANISHED',i10)
308 2100 FORMAT(1x,' DEVIATORIC STRESS WILL BE VANISHED',i10,
309 . ' AT TIME :',1pe20.13)
310 RETURN
311 END
fail_tbutcher_s
subroutine fail_tbutcher_s(nel, nuparam, nuvar, time, timestep, uparam, ngl, signxx, signyy, signzz, signxy, signyz, signzx, uvar, off, dfmax, tdele)
Definition fail_tbutcher_s.F:37
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21