OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
fail_tab_old_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_old_s ../engine/source/materials/fail/tabulated/fail_tab_old_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!||====================================================================
34 SUBROUTINE fail_tab_old_s (
35 1 NEL ,NUVAR ,NPF ,TF ,TIME ,
36 2 UPARAM ,NGL ,ALDT ,
37 4 SIGNXX ,SIGNYY ,SIGNZZ ,SIGNXY ,SIGNYZ ,SIGNZX ,
38 5 PLAS ,DPLA ,EPSP ,TSTAR ,UVAR ,
39 6 OFF ,DFMAX ,TDELE ,
40 7 NFUNC ,IFUNC )
41C---------+---------+---+---+--------------------------------------------
42C /FAIL/TAB - tabulated rupture criteria for solids (old, obsolete version)
43C-----------------------------------------------
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46#include "implicit_f.inc"
47C-----------------------------------------------
48C G l o b a l P a r a m e t e r s
49C-----------------------------------------------
50#include "units_c.inc"
51#include "param_c.inc"
52#include "scr17_c.inc"
53#include "impl1_c.inc"
54#include "comlock.inc"
55C-----------------------------------------------
56C I N P U T A r g u m e n t s
57C-----------------------------------------------
58 INTEGER NEL,NUVAR
59 INTEGER NGL(NEL)
60 INTEGER, INTENT(IN) :: NFUNC
61 INTEGER, DIMENSION(NFUNC), INTENT(IN) :: IFUNC
62c
63 my_real TIME,TIMESTEP,UPARAM(*),ALDT(NEL),
64 . signxx(nel),signyy(nel),signzz(nel),
65 . signxy(nel),signyz(nel),signzx(nel),
66 . plas(nel),dpla(nel),epsp(nel),tstar(nel)
67C-----------------------------------------------
68C I N P U T O U T P U T A r g u m e n t s
69C-----------------------------------------------
70 my_real :: uvar(nel,nuvar), off(nel), dfmax(nel),tdele(nel)
71C-----------------------------------------------
72C VARIABLES FOR FUNCTION INTERPOLATION
73C-----------------------------------------------
74 INTEGER NPF(*)
75 my_real FINTER ,TF(*)
76 EXTERNAL finter
77C-----------------------------------------------
78C L o c a l V a r i a b l e s
79C-----------------------------------------------
80 INTEGER I,J,K,J1,J2,IDEL,IDEV,IADBUF,NINDX,NRATE,IFUN_EL,IFUN_TEMP,SFLAG
81 INTEGER, DIMENSION(NEL) :: INDX
82C
83 my_real :: dcrit,dd,dn,sc_temp,sc_el,el_ref,dp,p,sigm,svm,
84 . sxx,syy,szz,ef1,ef2,df,fac,lambda,eta,yy
85 my_real, DIMENSION(NEL) :: epsf
86 my_real, DIMENSION(NFUNC) :: yfac,rate
87C=======================================================================
88C INITIALIZATIONS
89C-----------------------------------------------
90 sflag = int(uparam(1))
91 dcrit = uparam(4)
92 dd = uparam(5)
93 dn = uparam(6)
94 sc_temp= uparam(7)
95 sc_el = uparam(8)
96 el_ref = uparam(9)
97c---
98 idel = 0
99 idev = 0
100 indx = 0
101 IF (sflag == 1) THEN
102 idel=1
103 ELSEIF (sflag == 2) THEN
104 idev =1
105 ELSEIF (sflag == 3) THEN
106 idev = 2
107 ENDIF
108 nrate = nfunc - 2
109 yfac(1:nrate) = uparam(11+1 :11+nrate)
110 rate(1:nrate) = uparam(11+nrate:11+nrate*2)
111C-------------------------------------------------------------------
112c Failure strain value - function interpolation
113C-------------------------------------------------------------------
114
115 DO i=1,nel
116C--- failure strain interpolation
117 p = third*(signxx(i) + signyy(i) + signzz(i))
118 sxx = signxx(i) - p
119 syy = signyy(i) - p
120 szz = signzz(i) - p
121 svm = half*(sxx**2 + syy**2 + szz**2)
122 . + signxy(i)**2+ signzx(i)**2 + signyz(i)**2
123 svm = sqrt(three*svm)
124 sigm = p / max(em20,svm)
125c----
126 j1 = 1
127 IF (nrate > 1) THEN
128 j2 = j1+1
129 ef1 = yfac(j1)*finter(ifunc(j1),sigm,npf,tf,df)
130 ef2 = yfac(j2)*finter(ifunc(j2),sigm,npf,tf,df)
131 fac = (epsp(i) - rate(j1)) / (rate(j2) - rate(j1))
132 epsf(i) = max(ef1 + fac*(ef2 - ef1), em20)
133 ELSE
134 epsf(i) = yfac(j1)*finter(ifunc(j1),sigm,npf,tf,df)
135 ENDIF
136 ENDDO
137c
138c---- Scale functions
139 DO i=1,nel
140 ifun_el = ifunc(2)
141 ifun_temp = ifunc(3)
142c---- element length scale function
143 IF (ifun_el > 0) THEN
144 lambda = aldt(i) / el_ref
145 fac = sc_el*finter(ifun_el,lambda,npf,tf,df)
146 epsf(i) = epsf(i)* fac
147 ENDIF
148c---- temperature scale function
149 IF (ifun_temp > 0) THEN
150 fac = sc_temp*finter(ifun_temp,tstar(i),npf,tf,df)
151 epsf(i) = epsf(i)* fac
152 ENDIF
153 ENDDO
154c-------------------------------------------------------------------
155c---- element will be deleted
156 IF (idel == 1) THEN
157 DO i=1,nel
158 IF (off(i) < 0.1) off(i)=zero
159 IF (off(i) < one) off(i)=off(i)*four_over_5
160 ENDDO
161 ENDIF
162C
163 IF (idel == 1)THEN
164 nindx = 0
165 DO i=1,nel
166 IF (sflag==1 .AND. off(i)==one) THEN
167 dp = dn*dd**(one-one/dn)
168 IF (epsf(i) > zero) uvar(i,1)=uvar(i,1) + dp*dpla(i)/epsf(i)
169 IF (uvar(i,1) >= dcrit) THEN
170 off(i)=four_over_5
171 nindx=nindx+1
172 indx(nindx)=i
173 tdele(i) = time
174 ENDIF
175 ENDIF
176 ENDDO
177 IF (nindx > 0 .AND. imconv == 1)THEN
178 DO j=1,nindx
179#include "lockon.inc"
180 WRITE(iout, 1000) ngl(indx(j))
181 WRITE(istdo,1100) ngl(indx(j)),time
182#include "lockoff.inc"
183 ENDDO
184 ENDIF
185 ENDIF
186C----
187 IF (idev > 0) THEN ! element deleted when rupture in all integration points
188 nindx = 0
189 DO i=1,nel
190c---
191 IF (off(i) == one .AND. (sflag==2 .OR. sflag==3)) THEN
192 IF (uvar(i,1) < dcrit)THEN
193 dp = dn*dd**(one-one/dn)
194 IF (epsf(i) > zero) uvar(i,1)=uvar(i,1)+dp*dpla(i)/epsf(i)
195 IF (uvar(i,1) >= dcrit) THEN
196 nindx=nindx+1
197 indx(nindx)=i
198 p = third*(signxx(i) + signyy(i) + signzz(i))
199 IF (sflag == 2) THEN
200 signxx(i) = p
201 signyy(i) = p
202 signzz(i) = p
203 ENDIF
204 ENDIF
205 ELSEIF (sflag == 2) THEN ! UVAR > DCRIT
206 p = third*(signxx(i) + signyy(i) + signzz(i))
207 signxx(i) = p
208 signyy(i) = p
209 signzz(i) = p
210 ENDIF
211 ENDIF
212c---
213 ENDDO
214 IF (nindx > 0.AND.imconv == 1) THEN
215 DO j=1,nindx
216 i = indx(j)
217#include "lockon.inc"
218 WRITE(iout, 2000) ngl(i)
219 WRITE(istdo,2100) ngl(i),time
220#include "lockoff.inc"
221 END DO
222 ENDIF
223 ENDIF
224C-------------Maximum Damage storing for output : 0 < DFMAX < 1--------------
225 DO i=1,nel
226 dfmax(i)= min(one,max(dfmax(i),uvar(i,1)/dcrit))
227 ENDDO
228C-----------------------------------------------
229 1000 FORMAT(1x,'DELETE SOLID ELEMENT NUMBER ',i10)
230 1100 FORMAT(1x,'DELETE SOLID ELEMENT NUMBER ',i10,
231 . ' AT TIME :',1pe12.4)
232C
233 2000 FORMAT(1x,' DEVIATORIC STRESS SET TO ZERO',i10)
234 2100 FORMAT(1x,' DEVIATORIC STRESS SET TO ZERO',i10,
235 . ' AT TIME :',1pe12.4)
236c-----------
237 RETURN
238 END
fail_tab_old_s
subroutine fail_tab_old_s(nel, nuvar, npf, tf, time, uparam, ngl, aldt, signxx, signyy, signzz, signxy, signyz, signzx, plas, dpla, epsp, tstar, uvar, off, dfmax, tdele, nfunc, ifunc)
Definition fail_tab_old_s.F:41
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21