OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sigeps02c.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!|| sigeps02c ../engine/source/materials/mat/mat002/sigeps02c.f
25!||--- called by ------------------------------------------------------
26!|| mulawc ../engine/source/materials/mat_share/mulawc.F90
27!||--- calls -----------------------------------------------------
28!|| m2cplr ../engine/source/materials/mat/mat002/m2cplr.F
29!||====================================================================
30 SUBROUTINE sigeps02c(
31 1 JFT ,JLT ,PM ,EINT ,THK ,
32 2 OFF ,SIGY ,DT1 ,IPLA ,NEL ,
33 3 VOL ,GS ,ISRATE ,THKLYL ,ETSE ,
34 4 NGL ,EPSD_PG ,G_IMP ,SIGKSI ,IOFF_DUCT,
35 5 DPLA ,TSTAR ,JTHE ,HARDM ,EPCHK ,
36 6 IMAT ,IPT ,NPTT ,PLA ,OFF_OLD ,
37 7 SIGOXX ,SIGOYY ,SIGOXY ,SIGOYZ ,SIGOZX ,
38 8 SIGNXX ,SIGNYY ,SIGNXY ,SIGNYZ ,SIGNZX ,
39 9 DEPSXX ,DEPSYY ,DEPSXY ,DEPSYZ ,DEPSZX ,
40 A EPSPXX ,EPSPYY ,EPSPXY ,EPSPYZ ,EPSPZX ,
41 B SIGBAKXX ,SIGBAKYY ,SIGBAKXY ,INLOC ,DPLANL ,
42 C VP ,ASRATE ,LOFF ,EPSD ,
43 D TEMPEL ,FHEAT )
44C-----------------------------------------------
45C I m p l i c i t T y p e s
46C-----------------------------------------------
47#include "implicit_f.inc"
48C-----------------------------------------------
49C G l o b a l P a r a m e t e r s
50C-----------------------------------------------
51#include "mvsiz_p.inc"
52C-----------------------------------------------
53C C o m m o n B l o c k s
54C-----------------------------------------------
55#include "param_c.inc"
56C-----------------------------------------------
57C D u m m y A r g u m e n t s
58C-----------------------------------------------
59
60 INTEGER JFT,JLT,IPLA,NEL,IOFC,JTHE,IPT,NPTT,IMAT,ISRATE
61 INTEGER NGL(MVSIZ),IOFF_DUCT(*),INLOC
62 INTEGER, INTENT(IN) :: VP
63 my_real ,DIMENSION(NEL),INTENT(IN) :: EPSPXX,EPSPYY,EPSPXY,EPSPYZ,EPSPZX
64 my_real ,DIMENSION(NEL),INTENT(IN) :: EPSD_PG
65 my_real ,INTENT(IN) :: ASRATE
66 my_real ,INTENT(IN) :: DT1
67 my_real, DIMENSION(NEL), INTENT(IN) :: LOFF
68 my_real PM(NPROPM,*),EINT(NEL,2),
69 . OFF(*),SIGY(*),VOL(*),GS(*),THK(*),
70 . TSTAR(*),DPLA(*),SIGKSI(MVSIZ,5),ETSE(MVSIZ),
71 . DEPSXX(MVSIZ),DEPSYY(MVSIZ),DEPSXY(MVSIZ),DEPSYZ(MVSIZ),
72 . DEPSZX(MVSIZ),PLA(NEL),
73 . sigbakxx(nel),sigbakyy(nel),sigbakxy(nel),
74 . sigoxx(nel),sigoyy(nel),sigoxy(nel),sigoyz(nel),sigozx(nel),
75 . off_old(mvsiz),thklyl(nel),dplanl(nel)
76!
77 my_real signxx(nel),signyy(nel),signxy(nel),
78 . signyz(nel),signzx(nel),epchk(mvsiz),g_imp(mvsiz)
79!
80 my_real hardm(mvsiz),ezz(mvsiz)
81 my_real, DIMENSION(NEL) , INTENT(INOUT) :: tempel
82 my_real, DIMENSION(NEL) , INTENT(INOUT) :: fheat
83 my_real, DIMENSION(NEL) , INTENT(INOUT) :: epsd
84C-----------------------------------------------
85C L o c a l V a r i a b l e s
86C-----------------------------------------------
87 INTEGER ICC,IRTY,I,J,NPIF
88 my_real EPMX,CA,CB,CN,CP,CC,
89 . DAV,DEVE1,DEVE2,DEVE3,DEVE4,Z3,Z4,FISOKIN,
90 . epif,young,ti,tm,g,a11,a12,nu,
91 . ymax(mvsiz),plap(mvsiz),
92 . epdr(mvsiz),yld(mvsiz),epsdot(mvsiz),
93 . t(mvsiz),rhocp,tref,tmelt
94!=======================================================================
95 ! Variable initialization
96 ezz(1:mvsiz) = zero
97!---
98 ! Recover material law parameters
99 young = pm(20,imat)
100 nu = pm(21,imat)
101 g = pm(22,imat)
102 a11 = pm(24,imat)
103 a12 = pm(25,imat)
104 ca = pm(38,imat)
105 cb = pm(39,imat)
106 cn = pm(40,imat)
107 epmx = pm(41,imat)
108 ymax = pm(42,imat)
109 cc = pm(43,imat)
110 icc = nint(pm(49,imat))
111 irty = nint(pm(50,imat))
112 z3 = pm(51,imat)
113 fisokin= pm(55,imat)
114!
115 ! Recover internal variables
116 DO i=jft,jlt
117 epdr(i) = max(em20,pm(44,imat)*dt1)
118 ENDDO
119!
120 IF (irty == 1) THEN ! Zerilli
121 rhocp = pm(53,imat) ! = 1 /rhocp
122 z4 = pm(52,imat)
123 tref = pm(54,imat)
124 IF (jthe /= 0) THEN
125 DO i=jft,jlt
126 tempel(i) = tref + rhocp*(eint(i,1)+eint(i,2))/vol(i)
127 ENDDO
128 ENDIF
129 ELSE ! Johnson-Cook
130 rhocp = pm(69,imat)
131 tref = pm(79,imat)
132 tmelt = pm(80,imat)
133 DO i=jft,jlt
134 tstar(i) = max( zero, (tempel(i)-tref)/(tmelt-tref) )
135 ENDDO
136 END IF
137!
138 ! Specific strain rate computation
139 ! -> Plastic strain rate
140 ! Old filtered value already stored in EPSD
141!
142 IF (vp == 1) THEN
143 DO i=jft,jlt
144 epsdot(i) = epsd(i)*dt1
145 ENDDO
146 ! -> Total strain rate
147 ELSEIF (vp == 2) THEN
148 DO i=jft,jlt
149 epsd(i) = asrate*epsd_pg(i) + (one-asrate)*epsd(i)
150 epsdot(i) = epsd(i) * dt1
151 ENDDO
152 ! -> Deviatoric strain rate
153 ELSEIF (vp == 3) THEN
154 DO i=jft,jlt
155 dav = (epspxx(i)+epspyy(i))*third
156 deve1 = epspxx(i) - dav
157 deve2 = epspyy(i) - dav
158 deve3 = - dav
159 deve4 = half*epspxy(i)
160 epsdot(i) = half*(deve1**2 + deve2**2 + deve3**2) + deve4**2
161 epsdot(i) = sqrt(three*epsdot(i))/three_half
162 IF (israte > 0) THEN
163 epsdot(i) = asrate*epsdot(i) + (one - asrate)*epsd(i)
164 ENDIF
165 epsd(i) = epsdot(i)
166 epsdot(i) = epsdot(i)*dt1
167 ENDDO
168 ENDIF
169!----------------------------
170! CONTRAINTES PLASTIQUEMENT ADMISSIBLES
171!----------------------------
172 CALL m2cplr(jft ,jlt ,ezz ,off_old ,pla ,
173 2 ipla ,tempel ,z3 ,z4 ,
174 3 irty ,etse ,gs ,epsdot ,
175 4 israte ,yld ,g ,a11 ,a12 ,
176 5 nu ,ca ,cb ,cn ,ymax ,
177 6 epchk ,young ,cc ,epdr ,icc ,
178 7 dpla ,tstar ,fisokin ,g_imp ,sigksi ,
179 8 hardm ,nel ,depsxx ,depsyy ,depsxy ,
180 9 depsyz ,depszx ,signxx ,signyy ,signxy ,
181 a signyz ,signzx ,sigbakxx ,sigbakyy ,sigbakxy,
182 b sigoxx ,sigoyy ,sigoxy ,sigoyz ,sigozx ,
183 c vp )
184!
185!--------------------------------------------
186! UPDATE AND FILTER PLASTIC STRAIN RATE
187!--------------------------------------------
188 IF (vp == 1) THEN
189 DO i=jft,jlt
190 epsdot(i) = dpla(i)/max(em20,dt1)
191 epsd(i) = asrate*epsdot(i) + (one - asrate)*epsd(i)
192 ENDDO
193 ENDIF
194!--------------------------------------------
195 DO i=jft,jlt
196 sigy(i) = sigy(i) + yld(i)/nptt
197 ENDDO
198!----------------------------
199! TEST DE DUCTILE RUPTURE
200!----------------------------
201 DO i=jft,jlt
202 IF (off(i) == off_old(i) .and. off(i) > zero) THEN
203 IF (off(i) == one .and. epchk(i) >= epmx) THEN
204 off(i)= four_over_5
205 ioff_duct(i) = 1 ! debut de la rupture progressive
206 ELSE IF (off(i) < one ) THEN
207 off(i) = off(i)*four_over_5
208 ENDIF
209 ENDIF
210 ENDDO
211c------------------------------------
212! thickness update:
213c------------------------------------
214 DO i=jft,jlt
215 IF (inloc > 0) THEN
216 IF (loff(i) == one) THEN
217 ezz(i) = -nu*(signxx(i)-sigoxx(i)+signyy(i)-sigoyy(i))/young
218 ezz(i) = ezz(i) - max(dplanl(i),zero)*half*(signxx(i)+signyy(i))/yld(i)
219 ENDIF
220 ELSE
221 ezz(i) = -(depsxx(i)+depsyy(i))*nu-(one - two*nu)*ezz(i)
222 ezz(i) = ezz(i)/(one-nu)
223 ENDIF
224 thk(i) = thk(i) + ezz(i) * thklyl(i)*off(i)
225 ENDDO
226C-----------------
227C TEMPERATURE
228C-----------------
229 IF (jthe /= 0) THEN
230 ! heat increment due to plastic work for /heat/mat
231 DO i=1,nel
232 fheat(i) = fheat(i) + sigy(i)*dpla(i)*vol(i)
233 ENDDO
234 ELSEIF(rhocp > zero)THEN
235 IF(irty /= 1)THEN ! Johnson-Cook only
236 DO i=1,nel
237 tempel(i) = tempel(i) + sigy(i)*dpla(i) / rhocp
238 ! internal energy incremented later in parent subroutine (mmain)
239 ! with total energy deformation which already includes plastic work
240 ENDDO
241 ENDIF
242 END IF
243c-----------
244 RETURN
245 END
ymax
subroutine ymax(idn, fac, npc, pld, stiffmin, stiffmax, stiffini, stiffavg)
Definition law100_upd.F:272
m2cplr
subroutine m2cplr(jft, jlt, ezz, off, pla, ipla, temp, z3, z4, irty, etse, gs, epsp, israte, yld, g, a1, a2, nu, ca0, cb0, cn, ymax0, epchk, young, cc, epdr, icc, dpla, tstar, fisokin, gama_imp, signor, hardm, nel, depsxx, depsyy, depsxy, depsyz, depszx, signxx, signyy, signxy, signyz, signzx, sigbakxx, sigbakyy, sigbakxy, sigoxx, sigoyy, sigoxy, sigoyz, sigozx, vp)
Definition m2cplr.F:40
max
#define max(a, b)
Definition macros.h:21
sigeps02c
subroutine sigeps02c(jft, jlt, pm, eint, thk, off, sigy, dt1, ipla, nel, vol, gs, israte, thklyl, etse, ngl, epsd_pg, g_imp, sigksi, ioff_duct, dpla, tstar, jthe, hardm, epchk, imat, ipt, nptt, pla, off_old, sigoxx, sigoyy, sigoxy, sigoyz, sigozx, signxx, signyy, signxy, signyz, signzx, depsxx, depsyy, depsxy, depsyz, depszx, epspxx, epspyy, epspxy, epspyz, epspzx, sigbakxx, sigbakyy, sigbakxy, inloc, dplanl, vp, asrate, loff, epsd, tempel, fheat)
Definition sigeps02c.F:44