43
44
45
46#include "implicit_f.inc"
47
48
49
50#include "mvsiz_p.inc"
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105 INTEGER NEL0, NUPARAM, NUVAR, NPT0, IPT,IFLAG(*),
106 . (NEL0)
108 . time,timestep,uparam(nuparam),
109 .
area(nel0),rho0(nel0),eint(nel0,2),
110 . thkly(nel0),pla(nel0),
111 . epspxx(nel0),epspyy(nel0),
112 . epspxy(nel0),epspyz(nel0),epspzx(nel0),
113 . depsxx(nel0),depsyy(nel0),
114 . depsxy(nel0),depsyz(nel0),depszx(nel0),
115 . epsxx(nel0) ,epsyy(nel0) ,
116 . epsxy(nel0) ,epsyz(nel0) ,epszx(nel0) ,
117 . sigoxx(nel0),sigoyy(nel0),
118 . sigoxy(nel0),sigoyz(nel0),sigozx(nel0), shf(*)
119
120
121
123 . signxx(nel0),signyy(nel0),
124 . signxy(nel0),signyz(nel0),signzx(nel0),
125 . sigvxx(nel0),sigvyy(nel0),
126 . sigvxy(nel0),sigvyz(nel0),sigvzx(nel0),
127 . soundsp(nel0),viscmax(nel0)
128
129
130
131 my_real uvar(nel0,nuvar), off(nel0),thk(nel0)
132
133
134
135 INTEGER NPF(*), NFUNC, IFUNC(NFUNC)
137 EXTERNAL finter
138
139
140
141
142
143
144
145
146
147
148 INTEGER I,J,INDEX(),NINDX,NMAX,N
150 . young,anu,g,ca,cb,cn,epsm,sigm,cc,cd,cm,eps0,
151 . ce,ck,c1,c14g3,a1,a2,g3,gs,
152 . ch1,ch2,ch3,qh1,qh2,
153 . nnu1,nu1,nu2,nu3,s1,s2,s3,
154 . r,umr,dezz,
155 . p2,q2,f,df,yld_i,
156 . cutfre,beta
158 . svm(mvsiz),aa(mvsiz),bb(mvsiz),dpla_j(mvsiz),
159 . dpla_i(mvsiz),dr(mvsiz),pp(mvsiz),qq(mvsiz)
160
161 DATA nmax/3/
162
163
164
165
166
167
168
169
170 young = uparam(1)
171 anu = uparam(2)
172 g = uparam(3)
173 ca = uparam(4)
174 cb = uparam(5)
175 cn = uparam(6)
176 epsm = uparam(7)
177 sigm = uparam(8)
178 cc = uparam(9)
179 cd = uparam(10)
180 cm = uparam(11)
181 eps0 = uparam(12)
182 ce = uparam(13)
183 ck = uparam(14)
184 c1 = uparam(15)
185 c14g3 = uparam(16)
186 a1 = uparam(17)
187 a2 = uparam(18)
188 cutfre = uparam(19)
189
190
191
192 IF(time==zero)THEN
193 DO i=1,nel0
194 uvar(i,1)=zero
195 uvar(i,2)=zero
196 uvar(i,3)=zero
197 uvar(i,4)=zero
198 uvar(i,5)=zero
199 ENDDO
200 ENDIF
201
202 beta = timestep*2.*pi*cutfre
204 g3 = three * g
205 gs = five_over_6 * g
206 nnu1 = anu / (one - anu)
207 nu1 = one/(one-anu)
208 nu2 = one/(one+anu)
209 nu3 = one - nnu1
210
211
212
213
214
215
216
217 DO i=1,nel0
218
219 signxx(i)=sigoxx(i)+a1*depsxx(i)+a2*depsyy(i)
220 signyy(i)=sigoyy(i)+a2*depsxx(i)+a1*depsyy(i)
221 signxy(i)=sigoxy(i)+g *depsxy(i)
222 signyz(i)=sigoyz(i)+gs *depsyz(i)
223 signzx(i)=sigozx(i)+gs *depszx(i)
224
225 soundsp(i) = sqrt(a1/rho0(i))
226 viscmax(i) = zero
227
228
229
230
231
232 uvar(i,2) = half*( abs(epspxx(i)+epspyy(i))
233 . + sqrt( (epspxx(i)-epspyy(i))*(epspxx(i)-epspyy(i))
234 . + epspxy(i)*epspxy(i) ) )
235 uvar(i,2) = beta*uvar(i,2) + (1.-beta)*uvar(i,5)
236 uvar(i,5) = uvar(i,2)
237
238
239
240
241
242
243
244
245
246 ENDDO
247
248
249
250 DO i=1,nel0
251 IF(uvar(i,1)<=zero) THEN
252 ch1=ca
253 ELSEIF(uvar(i,1)>epsm) THEN
254 ch1=ca+cb*epsm**cn
255 ELSE
256 ch1=ca+cb*uvar(i,1)**cn
257 ENDIF
258 IF(uvar(i,2)<=eps0) THEN
259 ch2=0.
260 ELSEIF(uvar(i,1)<=zero) THEN
261 ch2=cc*log(uvar(i,2)/eps0)
262 ELSE
263 ch2=(cc-cd*uvar(i,1)**cm)*log(uvar(i,2)/eps0)
264 ENDIF
265 IF(uvar(i,2)<=zero) THEN
266 ch3=zero
267 ELSE
268 ch3=ce*uvar(i,2)**ck
269 ENDIF
270
271 uvar(i,3)=
min(sigm+ch3,ch1+ch2+ch3)
272 ENDDO
273
274
275
276 DO i=1,nel0
277 IF(uvar(i,1)>zero. and .cn>=one) THEN
278 qh1= cb*cn*uvar(i,1)**(cn-one)
279 ELSEIF(uvar(i,1)>zero. and .cn<one)THEN
280 qh1= cb*cn*uvar(i,1)**(one - cn)
281 ELSE
282 qh1=zero
283 ENDIF
284 IF(uvar(i,1)<=zero. or .uvar(i,2)<=eps0) THEN
285 qh2=zero
286 ELSEIF(cm>=one) THEN
287 qh2=cd*cm*uvar(i,1)**(cm- one)*log(uvar(i,2)/eps0)
288 ELSE
289 qh2=cd*cm*uvar(i,1)**(one -cm)*log(uvar(i,2)/eps0)
290 ENDIF
291 uvar(i,4)=qh1+qh2
292 ENDDO
293
294
295
296 IF(iflag(1)==0)THEN
297
298 DO i=1,nel0
299 svm(i)=sqrt(signxx(i)*signxx(i)
300 . +signyy(i)*signyy(i)
301 . -signxx(i)*signyy(i)
302 . +three*signxy(i)*signxy(i))
303 r =
min(one,uvar(i,3)/
max(em20,svm(i)))
304 signxx(i)=signxx(i)*r
305 signyy(i)=signyy(i)*r
306 signxy(i)=signxy(i)*r
307 umr = one - r
308 dpla_i(i) = off(i)*svm(i)*umr/(g3+uvar(i,4))
309 uvar(i,1) = uvar(i,1) + dpla_i(i)
310 s1=half*(signxx(i)+signyy(i))
311 dezz = dpla_i(i) * half*(signxx(i)+signyy(i)) /uvar(i,3)
312 dezz=-(depsxx(i)+depsyy(i))*nnu1-nu3*dezz
313 thk(i) = thk(i) + dezz*thkly(i)
314
315 ENDDO
316
317 ELSEIF(iflag(1)==1)THEN
318
319
320
321 DO i=1,nel0
322 uvar(i,4) =
max(zero,uvar(i,4))
323 s1=signxx(i)+signyy(i)
324 s2=signxx(i)-signyy(i)
325 s3=signxy(i)
326 aa(i)=fourth*s1*s1
327 bb(i)=three_over_4*s2*s2+3.*s3*s3
328 svm(i)=sqrt(aa(i)+bb(i))
329 dezz = -(depsxx(i)+depsyy(i))*nnu1
330 thk(i) = thk(i) + dezz*thkly(i)
331 ENDDO
332
333
334
335 nindx=0
336 DO i=1,nel0
337 IF(svm(i)>uvar(i,3).AND.off(i)==one) THEN
338 nindx=nindx+1
339 index(nindx)=i
340 ENDIF
341 ENDDO
342 IF(nindx==0) RETURN
343
344
345
346 DO j=1,nindx
347 i=index(j)
348 dpla_j(i)=(svm(i)-uvar(i,3))/(g3+uvar(i,4))
349
350 ENDDO
351
352 DO n=1,nmax
353
354 DO j=1,nindx
355 i=index(j)
356 dpla_i(i)=dpla_j(i)
357 yld_i =uvar(i,3)+uvar(i,4)*dpla_i(i)
358 dr(i) =half*young*dpla_i(i)/yld_i
359 pp(i) =one/(one+dr(i)*nu1)
360 qq(i) =one/(one + three*dr(i)*nu2)
361 p2 =pp(i)*pp(i)
362 q2 =qq(i)*qq(i)
363 f =aa(i)*p2+bb(i)*q2-yld_i*yld_i
364 df =-(aa(i)*nu1*p2*pp(i)+three*bb(i)*nu2*q2*qq(i))
365 . *(young-two*dr(i)*uvar(i,4))/yld_i
366 . -two*uvar(i,4)*yld_i
367 IF(dpla_i(i)>zero) THEN
368 dpla_j(i)=
max(zero,dpla_i(i)-f/df)
369 ELSE
370 dpla_j(i)=zero
371 ENDIF
372 ENDDO
373 ENDDO
374
375
376
377
378 DO j=1,nindx
379 i=index(j)
380 uvar(i,1) = uvar(i,1) + dpla_i(i)
381 s1=(signxx(i)+signyy(i))*pp(i)
382 s2=(signxx(i)-signyy(i))*qq(i)
383 signxx(i)=half*(s1+s2)
384 signyy(i)=half*(s1-s2)
385 signxy(i)=signxy(i)*qq(i)
386 dezz = - nu3*dr(i)*s1/young
387 thk(i) = thk(i) + dezz*thkly(i)
388 ENDDO
389
390 ENDIF
391
392 DO i=1,nel0
393 IF(uvar(i,1)>epsm.AND.off(i)==one)off(i)=four_over_5
394 ENDDO
395
396 RETURN
subroutine area(d1, x, x2, y, y2, eint, stif0)