OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sigeps44pi.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!|| sigeps44pi ../engine/source/materials/mat/mat044/sigeps44pi.F
25!||--- called by ------------------------------------------------------
26!|| mulaw_ib ../engine/source/elements/beam/mulaw_ib.F
27!||--- calls -----------------------------------------------------
28!|| vinter ../engine/source/tools/curve/vinter.F
29!||====================================================================
30 SUBROUTINE sigeps44pi(
31 1 NEL ,NUPARAM ,UPARAM ,IPM ,IMAT ,
32 2 OFF ,PLA ,DEPSXX ,DEPSXY ,DEPSXZ ,
33 3 SIGOXX ,SIGOXY ,SIGOXZ ,EPST ,EPSP ,
34 4 SIGNXX ,SIGNXY ,SIGNXZ ,ETSE ,NUVAR ,
35 5 UVAR ,IFUNC ,NVARTMP ,VARTMP ,NPF ,
36 6 TF ,NFUNC ,SIGY)
37C-----------------------------------------------
38C I m p l i c i t T y p e s
39C-----------------------------------------------
40#include "implicit_f.inc"
41C---------+---------+---+---+--------------------------------------------
42C C o m m o n B l o c k s
43C-----------------------------------------------
44#include "param_c.inc"
45#include "scr17_c.inc"
46#include "com04_c.inc"
47#include "com08_c.inc"
48C-----------------------------------------------
49C I N P U T A r g u m e n t s
50C-----------------------------------------------
51 INTEGER ,INTENT(IN) :: IMAT
52 INTEGER ,INTENT(IN) :: NEL,NUPARAM,NUVAR,
53 . NFUNC,IFUNC(NFUNC),NPF(*),NVARTMP
54 INTEGER ,DIMENSION(NPROPMI,NUMMAT) ,INTENT(IN) :: IPM
55 my_real ,DIMENSION(NEL) ,INTENT(IN) :: EPST,
56 . DEPSXX,DEPSXY,DEPSXZ,SIGOXX,SIGOXY,SIGOXZ
57 my_real ,DIMENSION(*) ,INTENT(IN) :: uparam
58 my_real
59 . tf(*)
60C-----------------------------------------------
61C O U T P U T A r g u m e n t s
62C-----------------------------------------------
63 my_real ,DIMENSION(NEL) ,INTENT(OUT) :: signxx,signxy,signxz,etse
64 my_real ,DIMENSION(NEL) ,INTENT(INOUT) :: pla,off,epsp
65 INTEGER :: VARTMP(NEL,NVARTMP)
66 my_real ,DIMENSION(NEL,NUVAR) ,INTENT(INOUT):: UVAR
67 my_real ,DIMENSION(NEL) ,INTENT(INOUT) :: SIGY
68C-----------------------------------------------
69C L o c a l V a r i a b l e s
70C-----------------------------------------------
71 INTEGER :: I,IADBUF
72 my_real :: svm,shfact,gs,epif,dmg,r,frate,alpha,epsdot
73 INTEGER, DIMENSION(NEL) :: ICC,ISRATE,VFLAG,IAD,IPOS,ILEN
74 my_real, DIMENSION(NEL) :: E,NU,G,G3,YLD,YLDMAX,EPMAX,EPDR,
75 . EPSR1,EPSR2,CA,CB,CN,CP,ASRATE,YSCALE,DFDPLA,DPLA
76C=======================================================================
77 shfact = five_over_6
78 epif = zero
79c
80 iadbuf = ipm(7,imat)-1
81 DO i=1,nel
82 e(i) = uparam(iadbuf+1)
83 nu(i) = uparam(iadbuf+2)
84 ca(i) = uparam(iadbuf+3)
85 yldmax(i)= uparam(iadbuf+4)
86 epmax(i) = uparam(iadbuf+5)
87 epsr1(i) = uparam(iadbuf+6)
88 epsr2(i) = uparam(iadbuf+7)
89 cb(i) = uparam(iadbuf+8)
90 cn(i) = uparam(iadbuf+9)
91 icc(i) = nint(uparam(iadbuf+10))
92 epdr(i) = uparam(iadbuf+11)
93 epif = max(epif,epdr(i))
94 cp(i) = uparam(iadbuf+12)
95 g(i) = uparam(iadbuf+16)
96 g3(i) = uparam(iadbuf+18)
97 israte(i)= nint(uparam(iadbuf+13))
98 asrate(i)= uparam(iadbuf+14)
99 vflag(i) = nint(uparam(iadbuf+23))
100 yscale(i)= uparam(iadbuf+24)
101 IF (vflag(i) == 1) THEN
102 epsp(i) = uvar(i,1)
103 ENDIF
104 dpla(i) = zero
105 ENDDO
106c
107c--- Contraintes elastiques
108c
109 DO i = 1,nel
110 gs = shfact*g(i)
111 signxx(i) = sigoxx(i) + e(i)*depsxx(i)
112 signxy(i) = sigoxy(i) + gs*depsxy(i)
113 signxz(i) = sigoxz(i) + gs*depsxz(i)
114 etse(i) = one
115 ENDDO
116c
117c--- Yield stress
118c
119 IF (nfunc > 0) THEN
120 ipos(1:nel) = vartmp(1:nel,1)
121 iad(1:nel) = npf(ifunc(1)) / 2 + 1
122 ilen(1:nel) = npf(ifunc(1)+1) / 2 - iad(1:nel) - ipos(1:nel)
123 CALL vinter(tf,iad,ipos,ilen,nel,pla,dfdpla,yld)
124 vartmp(1:nel,1) = ipos(1:nel)
125 ENDIF
126c
127c
128c
129 DO i = 1,nel
130 IF (nfunc > 0) THEN
131 yld(i) = yscale(i)*yld(i)
132 ELSE
133 yld(i) = ca(i)
134 ENDIF
135 ENDDO
136c
137c
138c
139 DO i = 1,nel
140 IF (pla(i) > zero) THEN
141 IF (nfunc > 0) THEN
142 yld(i) = yscale(i)*yld(i)
143 ELSE
144 yld(i) = ca(i) + cb(i)*exp(cn(i)*log(pla(i)))
145 ENDIF
146 ENDIF
147 ENDDO
148c
149c Strain rate effect
150c
151 IF (epif > zero) THEN
152 DO i = 1,nel
153 IF (epdr(i) > zero) THEN
154 frate = one + (epsp(i)*epdr(i))**cp(i)
155 IF (icc(i)== 1) yldmax(i) = yldmax(i) * frate
156 IF ((nfunc > 0) .AND. (ca(i) /= zero)) THEN
157 IF (pla(i)>zero) THEN
158 yld(i) = yld(i) + (ca(i) + cb(i)*exp(cn(i)*log(pla(i))))*(frate-one)
159 ELSE
160 yld(i) = yld(i) + ca(i)*(frate-one)
161 ENDIF
162 ELSE
163 yld(i) = yld(i) * frate
164 ENDIF
165 ENDIF
166 ENDDO
167 ENDIF
168c-------------------
169c PROJECTION - radial return
170c-------------------
171 DO i = 1,nel
172 yld(i) = min(yld(i),yldmax(i))
173 sigy(i)= yld(i)
174 svm = signxx(i)**2 + three*(signxy(i)**2 + signxz(i)**2)
175 IF (svm > yld(i)**2) THEN
176 svm = sqrt(svm)
177 r = min( one, yld(i) / svm)
178 signxx(i) = signxx(i)*r
179 signxy(i) = signxy(i)*r
180 signxz(i) = signxz(i)*r
181 dpla(i) = off(i)*svm*(one - r) / e(i)
182 pla(i) = pla(i) + off(i)*svm*(one - r) / e(i)
183 ENDIF
184 ENDDO
185c--------------------------------
186c DUCTILE RUPTURE
187c--------------------------------
188 DO i=1,nel
189 IF (off(i) < em01) off(i) = zero
190 IF (off(i) < one) off(i) = off(i)*four_over_5
191 ENDDO
192c--------------------------------
193c AXIAL TENSION OR PLASTIC STRAIN FAILURE
194c--------------------------------
195 DO i = 1,nel
196 IF (off(i) == one) THEN
197 dmg = one
198 IF (epst(i) > epsr1(i)) THEN
199 dmg = (epsr2(i) - epst(i)) / (epsr2(i) - epsr1(i))
200 dmg = max(dmg, zero)
201 signxx(i) = signxx(i)*dmg
202 signxy(i) = signxy(i)*dmg
203 signxz(i) = signxz(i)*dmg
204 ENDIF
205c test strain failure
206 IF (dmg == zero .or. pla(i) >= epmax(i)) THEN
207 off(i) = four_over_5
208 ENDIF
209 IF (vflag(i) == 1) THEN
210 alpha = min(one, asrate(i)*dt1)
211 epsdot = dpla(i)/max(em20,dt1)
212 epsp(i) = alpha*epsdot + (one - alpha)*epsp(i)
213 uvar(i,1) = epsp(i)
214 ENDIF
215c
216 ENDIF
217 ENDDO
218c-----------
219 RETURN
220 END
alpha
#define alpha
Definition eval.h:35
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
sigeps44pi
subroutine sigeps44pi(nel, nuparam, uparam, ipm, imat, off, pla, depsxx, depsxy, depsxz, sigoxx, sigoxy, sigoxz, epst, epsp, signxx, signxy, signxz, etse, nuvar, uvar, ifunc, nvartmp, vartmp, npf, tf, nfunc, sigy)
Definition sigeps44pi.F:37
vinter
subroutine vinter(tf, iad, ipos, ilen, nel, x, dydx, y)
Definition vinter.F:72