OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sigeps69.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "scr05_c.inc"
#include "scr17_c.inc"
#include "impl1_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine sigeps69 (nel, nuparam, nuvar, nfunc, ifunc, npf, tf, time, timestep, uparam, rho0, rho, volume, eint, epspxx, epspyy, epspzz, epspxy, epspyz, epspzx, depsxx, depsyy, depszz, depsxy, depsyz, depszx, epsxx, epsyy, epszz, epsxy, epsyz, epszx, sigoxx, sigoyy, sigozz, sigoxy, sigoyz, sigozx, signxx, signyy, signzz, signxy, signyz, signzx, sigvxx, sigvyy, sigvzz, sigvxy, sigvyz, sigvzx, soundsp, viscmax, uvar, off, wxxdt, wyydt, wzzdt, ismstr, mfxx, mfxy, mfxz, mfyx, mfyy, mfyz, mfzx, mfzy, mfzz, et, ihet, nuvarv, uvarv, offg, epsth3, iexpan)

Function/Subroutine Documentation

◆ sigeps69()

subroutine sigeps69 ( integer nel,
integer nuparam,
integer nuvar,
integer nfunc,
integer, dimension(nfunc) ifunc,
integer, dimension(*) npf,
tf,
time,
timestep,
uparam,
rho0,
rho,
volume,
eint,
epspxx,
epspyy,
epspzz,
epspxy,
epspyz,
epspzx,
depsxx,
depsyy,
depszz,
depsxy,
depsyz,
depszx,
epsxx,
epsyy,
epszz,
epsxy,
epsyz,
epszx,
sigoxx,
sigoyy,
sigozz,
sigoxy,
sigoyz,
sigozx,
signxx,
signyy,
signzz,
signxy,
signyz,
signzx,
sigvxx,
sigvyy,
sigvzz,
sigvxy,
sigvyz,
sigvzx,
soundsp,
viscmax,
uvar,
off,
wxxdt,
wyydt,
wzzdt,
integer ismstr,
mfxx,
mfxy,
mfxz,
mfyx,
mfyy,
mfyz,
mfzx,
mfzy,
mfzz,
et,
integer ihet,
integer nuvarv,
uvarv,
offg,
epsth3,
integer iexpan )

Definition at line 32 of file sigeps69.F.

46C-----------------------------------------------
47C I M P L I C I T T Y P E S
48C-----------------------------------------------
49#include "implicit_f.inc"
50C-----------------------------------------------
51C G l o b a l P a r a m e t e r s
52C-----------------------------------------------
53#include "mvsiz_p.inc"
54C-----------------------------------------------
55C C O M M O N
56C-----------------------------------------------
57#include "scr05_c.inc"
58#include "scr17_c.inc"
59#include "impl1_c.inc"
60C----------------------------------------------------------------
61C I N P U T A R G U M E N T S
62C----------------------------------------------------------------
63 INTEGER :: NEL,NUPARAM,NUVAR,ISMSTR,IHET,NUVARV,IEXPAN
64 my_real
65 . time , timestep , uparam(nuparam),
66 . rho(nel), rho0(nel), volume(nel), eint(nel),
67 . epspxx(nel), epspyy(nel), epspzz(nel),
68 . epspxy(nel), epspyz(nel), epspzx(nel),
69 . depsxx(nel), depsyy(nel), depszz(nel),
70 . depsxy(nel), depsyz(nel), depszx(nel),
71 . epsxx(nel), epsyy(nel), epszz(nel),
72 . epsxy(nel), epsyz(nel), epszx(nel),
73 . sigoxx(nel), sigoyy(nel), sigozz(nel),
74 . sigoxy(nel), sigoyz(nel), sigozx(nel),
75 . mfxx(nel) , mfxy(nel), mfxz(nel),
76 . mfyx(nel) , mfyy(nel), mfyz(nel),
77 . mfzx(nel) , mfzy(nel), mfzz(nel),
78 . wzzdt(nel),wyydt(nel),wxxdt(nel),offg(nel),
79 . epsth3(nel)
80C----------------------------------------------------------------
81C O U T P U T A R G U M E N T S
82C----------------------------------------------------------------
83 my_real
84 . signxx(nel), signyy(nel), signzz(nel),
85 . signxy(nel), signyz(nel), signzx(nel),
86 . sigvxx(nel), sigvyy(nel), sigvzz(nel),
87 . sigvxy(nel), sigvyz(nel), sigvzx(nel),
88 . soundsp(nel), viscmax(nel), et(nel)
89C----------------------------------------------------------------
90C I N P U T O U T P U T A R G U M E N T S
91C----------------------------------------------------------------
92 my_real
93 . uvar(nel,nuvar), off(nel), uvarv(*)
94!! . UVAR(NEL,NUVAR), OFF(NEL), UVARV(NEl*NUVARV)
95C----------------------------------------------------------------
96C VARIABLES FOR FUNCTION INTERPOLATION
97C----------------------------------------------------------------
98 INTEGER NPF(*), NFUNC, IFUNC(NFUNC)
99 my_real finter,fintte,tf(*),fint2v
100 EXTERNAL finter,fintte
101C----------------------------------------------------------------
102C L O C A L V A R I B L E S
103C----------------------------------------------------------------
104 INTEGER I,J,K,KFP,NORDRE,II,NPRONY
105 my_real
106 . tenscut,gmax,fscale,rvt,sumdwdl,efac,dwdrv,rbulk,dpdmu,amax,eti(mvsiz),eth
107 my_real
108 . evv(mvsiz,3),ev(mvsiz,3),evm1(mvsiz),evm2(mvsiz),evm3(mvsiz),p(mvsiz),
109 . mu(5),al(5),dwdl(3),t(mvsiz,3),rv(mvsiz),av(mvsiz,6),dirprv(mvsiz,3,3)
110 my_real
111 . h0(100),h(100),c0(mvsiz,6),c1(mvsiz,6),aa,sv(mvsiz,6),
112 . cc,fac,invdt,fft(3),p_fac(nel),nu_1,amin,lam_al(3),gtmax(nel)
113 my_real, DIMENSION(NEL,3) :: cii
114 DOUBLE PRECISION AMAX1
115C----------------------------------------------------------------
116C SET INITIAL MATERIAL CONSTANTS
117 mu(1) = uparam(1)
118 mu(2) = uparam(2)
119 mu(3) = uparam(3)
120 mu(4) = uparam(4)
121 mu(5) = uparam(5)
122 al(1) = uparam(6)
123 al(2) = uparam(7)
124 al(3) = uparam(8)
125 al(4) = uparam(9)
126 al(5) = uparam(10)
127 rbulk = uparam(11)
128 tenscut= uparam(12)
129 fscale = uparam(15)
130 nordre = nint(uparam(18))
131C
132 kfp = ifunc(1)
133C
134 gmax = zero
135 DO i = 1,nordre
136 gmax = gmax + mu(i)*al(i)
137 ENDDO
138C
139 DO i=1,nel
140 av(i,1)=epsxx(i)
141 av(i,2)=epsyy(i)
142 av(i,3)=epszz(i)
143 av(i,4)=epsxy(i) * half
144 av(i,5)=epsyz(i) * half
145 av(i,6)=epszx(i) * half
146 ENDDO
147C Eigenvalues needed to be calculated in double precision
148C for a simple precision executing
149 IF (iresp == 1) THEN
150 CALL valpvecdp_v(av,evv,dirprv,nel)
151 ELSE
152 CALL valpvec_v(av,evv,dirprv,nel)
153 ENDIF
154C Strain definition
155 IF (ismstr == 1 .OR. ismstr == 3 ) THEN ! engineering strain
156 DO i=1,nel
157 ev(i,1)=evv(i,1)+ one
158 ev(i,2)=evv(i,2)+ one
159 ev(i,3)=evv(i,3)+ one
160 ENDDO
161 ELSEIF(ismstr==10.OR.ismstr==12) THEN
162 DO i =1,nel
163 IF(offg(i)<=one) THEN
164 ev(i,1)=sqrt(evv(i,1)+ one)
165 ev(i,2)=sqrt(evv(i,2)+ one)
166 ev(i,3)=sqrt(evv(i,3)+ one)
167 ELSE
168 ev(i,1)=evv(i,1)+ one
169 ev(i,2)=evv(i,2)+ one
170 ev(i,3)=evv(i,3)+ one
171 END IF
172 ENDDO
173 ELSE ! true strain
174 DO i=1,nel
175 ev(i,1)=exp(evv(i,1))
176 ev(i,2)=exp(evv(i,2))
177 ev(i,3)=exp(evv(i,3))
178 ENDDO
179 ENDIF
180C----------------
181 IF (impl_s > 0 .OR. ihet > 1) THEN
182C ET(I) = ZERO
183 DO j = 1,3
184 eti(1:nel) = zero
185 DO k=1,nordre
186 DO i = 1,nel
187 amax = ev(i,j)
188 IF(amax>zero) THEN
189 IF((al(k)-one)==zero) THEN
190 eti(i) = eti(i) + mu(k)*al(k)
191 ELSE
192 eti(i) = eti(i) + mu(k)*al(k)*exp((al(k)-one)*log(amax))
193 ENDIF
194 ENDIF
195 ENDDO
196 ENDDO
197 et(1:nel) = max(eti(1:nel),et(1:nel))
198 ENDDO
199 DO i=1,nel
200 et(i) = max(one,et(i)/gmax)
201 ENDDO
202 ENDIF
203c--- avoid buckling
204 p_fac(1:nel) = one
205 IF (rbulk > 24*gmax) THEN
206 nu_1 = fourty*(half-(3*rbulk-gmax)/(6*rbulk+gmax))
207 DO i=1,nel
208 amin = min(ev(i,1),ev(i,2),ev(i,3))
209 IF (amin<zep2) p_fac(i) = max(one,nu_1/max(em20,amin))
210 ENDDO
211 END IF
212C----------------
213 DO i=1,nel
214 rv(i) = ev(i,1)*ev(i,2)*ev(i,3)
215 ENDDO
216C----THERM STRESS COMPUTATION-----
217 IF(iexpan > 0.AND.(ismstr==10.OR.ismstr==11.OR.ismstr==12)) THEN
218 DO i=1,nel
219 rv(i)= rv(i)-epsth3(i)
220 ENDDO
221 ENDIF
222 DO i=1,nel
223! RVT = RV(I)**(-THIRD)
224 ! if rv > 0 --> rvt = exp(-third * ln(rv))
225 ! else rvt = 0
226 IF(rv(i)>zero) THEN
227 rvt = exp((-third)*log(rv(i)))
228 ELSE
229 rvt = zero
230 ENDIF
231 evm1(i) = ev(i,1)*rvt
232 evm2(i) = ev(i,2)*rvt
233 evm3(i) = ev(i,3)*rvt
234 IF (kfp > 0) THEN
235* READ BULK MODULE FROM FUNCTION
236 p(i) = rbulk*fscale*finter(kfp,rv(i),npf,tf,dpdmu)
237 ELSE
238* BULK MODULE IS CONSTANT
239 p(i)=p_fac(i)*rbulk
240 ENDIF
241 ENDDO
242c
243 ! For HEPH Hourglass treatment and soundspeed computation
244 gtmax(1:nel) = gmax
245 eti(1:nel) = zero
246 cii(1:nel,1:3) = zero
247 DO ii = 1,nordre
248 IF (mu(ii)*al(ii) /= zero) THEN
249 DO i=1,nel
250 lam_al(1) = exp(al(ii)*log(evm1(i)))
251 lam_al(2) = exp(al(ii)*log(evm2(i)))
252 lam_al(3) = exp(al(ii)*log(evm3(i)))
253 amax = third*(lam_al(1)+lam_al(2)+lam_al(3))
254 cii(i,1:3) = cii(i,1:3) + mu(ii)*al(ii)*(lam_al(1:3)+amax)
255 ENDDO
256 ENDIF
257 ENDDO
258 ! Note: 2GT=3/2 Cii (factor 3 already inside CII)
259 amax1 = 0.81*half/gmax
260 DO i = 1,nel
261 amax = amax1*max(cii(i,1),cii(i,2),cii(i,3))
262 eti(i) = max(one,amax)
263 gtmax(i) = gmax*eti(i)
264 et(i) = eti(i)
265 ENDDO
266 DO i=1,nel
267 dwdl(1) = zero
268 dwdl(2) = zero
269 dwdl(3) = zero
270 DO k = 1,nordre
271 IF(evm1(i)>zero) THEN
272 IF(al(k)/=zero) THEN
273 dwdl(1) = dwdl(1) + mu(k)*exp(al(k)*log(evm1(i)))
274 ELSE
275 dwdl(1) = dwdl(1) + mu(k)
276 ENDIF
277 ENDIF
278 IF(evm2(i)>zero) THEN
279 IF(al(k)/=zero) THEN
280 dwdl(2) = dwdl(2) + mu(k)*exp(al(k)*log(evm2(i)))
281 ELSE
282 dwdl(2) = dwdl(2) + mu(k)
283 ENDIF
284 ENDIF
285 IF(evm3(i)>zero) THEN
286 IF(al(k)/=zero) THEN
287 dwdl(3) = dwdl(3) + mu(k)*exp(al(k)*log(evm3(i)))
288 ELSE
289 dwdl(3) = dwdl(3) + mu(k)
290 ENDIF
291 ENDIF
292 ENDDO
293 dwdrv = p(i)*(rv(i)- one)
294 sumdwdl =(dwdl(1)+dwdl(2)+dwdl(3))* third
295c----------------------------
296C principal Cauchy stress
297 t(i,1) = (dwdl(1)-(sumdwdl))/rv(i) + dwdrv
298 t(i,2) = (dwdl(2)-(sumdwdl))/rv(i) + dwdrv
299 t(i,3) = (dwdl(3)-(sumdwdl))/rv(i) + dwdrv
300 ENDDO
301C
302c----------------------------
303c tension cut
304 DO i=1,nel
305 IF (off(i) /= zero .AND.
306 . (t(i,1) > abs(tenscut) .OR. t(i,2) > abs(tenscut))) THEN
307 t(i,1) = zero
308 t(i,2) = zero
309 t(i,3) = zero
310 off(i) = zero
311 ENDIF
312 ENDDO
313C transform principal Cauchy stress to global directions
314 DO i=1,nel
315 signxx(i) = dirprv(i,1,1)*dirprv(i,1,1)*t(i,1)
316 . + dirprv(i,1,2)*dirprv(i,1,2)*t(i,2)
317 . + dirprv(i,1,3)*dirprv(i,1,3)*t(i,3)
318 signyy(i) = dirprv(i,2,2)*dirprv(i,2,2)*t(i,2)
319 . + dirprv(i,2,3)*dirprv(i,2,3)*t(i,3)
320 . + dirprv(i,2,1)*dirprv(i,2,1)*t(i,1)
321 signzz(i) = dirprv(i,3,3)*dirprv(i,3,3)*t(i,3)
322 . + dirprv(i,3,1)*dirprv(i,3,1)*t(i,1)
323 . + dirprv(i,3,2)*dirprv(i,3,2)*t(i,2)
324 signxy(i) = dirprv(i,1,1)*dirprv(i,2,1)*t(i,1)
325 . + dirprv(i,1,2)*dirprv(i,2,2)*t(i,2)
326 . + dirprv(i,1,3)*dirprv(i,2,3)*t(i,3)
327 signyz(i) = dirprv(i,2,2)*dirprv(i,3,2)*t(i,2)
328 . + dirprv(i,2,3)*dirprv(i,3,3)*t(i,3)
329 . + dirprv(i,2,1)*dirprv(i,3,1)*t(i,1)
330 signzx(i) = dirprv(i,3,3)*dirprv(i,1,3)*t(i,3)
331 . + dirprv(i,3,1)*dirprv(i,1,1)*t(i,1)
332 . + dirprv(i,3,2)*dirprv(i,1,2)*t(i,2)
333 ENDDO
334C-----------------------------------------------------------
335C set sound speed & viscosity
336 DO i=1,nel
337 soundsp(i) = sqrt((two_third*gtmax(i)+p(i))/rho(i))
338 viscmax(i) = zero
339 ENDDO
340C-----------
341 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
valpvecdp_v
subroutine valpvecdp_v(sig, val, vec, nel)
Definition sigeps33.F:2231
valpvec_v
subroutine valpvec_v(sig, val, vec, nel)
Definition sigeps33.F:1902