55
56
57
58#include "implicit_f.inc"
59
60
61
62#include "impl1_c.inc"
63
64
65
66 INTEGER ,INTENT(IN) :: NPARF
67 INTEGER ,INTENT(IN) :: NEL,JCVT,NVARF,NUPARAM,NUVAR,ISMSTR,IHET,IEXPAN
68 INTEGER ,INTENT(IN) :: NGL(NEL)
70 my_real ,
DIMENSION(NUPARAM) ,
INTENT(IN) :: uparam
71 my_real ,
DIMENSION(NPARF) ,
INTENT(IN) :: uparamf
72 my_real ,
DIMENSION(NEL) :: rho,rho0,volume,eint,epsth3,
73 . epspxx, epspyy, epspzz, epspxy, epspyz, epspzx,
74 . depsxx, depsyy, depszz, depsxy, depsyz, depszx,
75 . epsxx , epsyy , epszz , epsxy , epsyz , epszx ,
76 . sigoxx, sigoyy, sigozz, sigoxy, sigoyz, sigozx,offg,
77 . mfxx,mfxy,mfxz,mfyx,mfyy,mfyz,mfzx,mfzy,mfzz
78
80
81
82
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)
89
90
91
93 . uvar(nel,nuvar), off(nel) ,uvarf(nel,nvarf)
94
95
96
97 INTEGER (*), NFUNC, IFUNC(NFUNC)
98 my_real finter,fintte,tf(*),fint2v
99 EXTERNAL finter,fintte
100
101
102
103 INTEGER I,J,K,KK,LL,FLAGBB,DIRECT,ITER,NITER,FLAG_MUL,,IFORM
104
106 . et1,et2,et3,a1,a10,ksi,mu,d,lam,g,rbulk,aa,bb,cc,sb, temp,
107 . temp2,maxl,stiff0,dsig,deps,coef1,coef2,coef3,coef4,coef5,coef6,
108 . aa1,b1,c1,dd1,aa2,b2,c2,dd2,aa3,b3,c3,dd3,inv12,inv22,inv32,
109 . evb12,evb22,evb32,jdet2,jm1,etvol,factor,tauref,r3r3,r2r2,r1r1,
110 . c10,c01,c20,c11,c02,c30,c21,c12,c03,d1,d2,d3,expc,expm,r(3),jcst(3),
111 . bi1(nel),bi2(nel),jdet(nel),stiff(nel),
112 . ta1(nel), ta2(nel),ta3(nel),t1(nel), t2(nel),t3(nel),lpchain(nel),
113 . tb1(nel), tb2(nel),tb3(nel),trace(nel),traceb(nel),eta(nel),etb(nel),
114 . sb1(nel), sb2(nel),sb3(nel),sb4(nel), sb5(nel),sb6(nel),
115 . tbnorm(nel),dgamma(nel),
116 . devb1(nel),devb2(nel),devb3(nel),devb4(nel),devb5(nel),devb6(nel),
117 . r1x(nel),r1y(nel),r1z(nel),r2x(nel),r2y(nel),r2z(nel),r3x(nel),r3y(nel),r3z(nel),
118 . nb(nel,3),
119 . f(nel,3,3),ft(nel,3,3),fe(nel,3,3),invfe(nel,3,3),fet(nel,3,3),fp(nel,3,3),
120 . fft(nel,3,3),invfpo(nel,3,3),matb(nel,3,3),fpo(nel,3,3),bpo(nel,3,3),invsn(nel,3,3),
121 . sig(nel,3,3),sigb(nel,3,3),siga(nel,3,3),sn(nel,3,3),fedp(nel,3,3),
122 . dfp(nel,3,3),lb(nel,3,3),dfp2(nel,3,3),fpdot(nel,3,3),
123 . caii(nel,3),cbii(nel,3),c_max(nel),cii(3)
125 . coefr,betaf ,coefm
126
127 coefr = one
128 betaf = zero
129 coefm = one
130
131
132 c10 = uparam(1)
133 c01 = uparam(2)
134 c20 = uparam(3)
135 c11 = uparam(4)
136 c02 = uparam(5)
137 c30 = uparam(6)
138 c21 = uparam(7)
139 c12 = uparam(8)
140 c03 = uparam(9)
141 d1 = uparam(11)
142 d2 = uparam(12)
143 d3 = uparam(13)
144 sb = uparam(14)
145 a10 = uparam(15)
146 a1 = a10*timestep
147 expc = uparam(16)
148 expm = uparam(17)
149 ksi = uparam(18)
150 g = uparam(19)
151 rbulk= uparam(20)
152 tauref= uparam(22)
153 iform = nint(uparam(23))
154
155 stiff0 = four_over_3*g + rbulk
156 maxl = one
157 iavis =1
158 IF (a10*sb==zero) iavis=0
159
160 flag_mul = uparam(21)
161 IF (flag_mul > zero)THEN
162 coefr = uparamf(1)
163 betaf = uparamf(2)
164 coefm = uparamf(3)
165 ENDIF
166
167
168 IF (iavis>0) THEN
169 DO i = 1, nel
170
171 fpo(i,1,1) = uvar(i,1)
172 fpo(i,2,2) = uvar(i,2)
173 fpo(i,3,3) = uvar(i,3)
174 fpo(i,1,2) = uvar(i,4)
175 fpo(i,2,3) = uvar(i,5)
176 fpo(i,3,1) = uvar(i,6)
177 fpo(i,2,1) = uvar(i,7)
178 fpo(i,3,2) = uvar(i,8)
179 fpo(i,1,3) = uvar(i,9)
180 ENDDO
181
182 IF (jcvt >0 ) THEN
183 r1x(1:nel) = gama_r(1:nel,1)
184 r1y(1:nel) = gama_r(1:nel,2)
185 r1z(1:nel) = gama_r(1:nel,3)
186 r2x(1:nel) = gama_r(1:nel,4)
187 r2y(1:nel) = gama_r(1:nel,5)
188 r2z(1:nel) = gama_r(1:nel,6)
189
190 r3x(1:nel) = r1y(1:nel)* r2z(1:nel) - r1z(1:nel) * r2y(1
191 r3y(1:nel) = r1z(1:nel)* r2x(1:nel) - r1x(1:nel) * r2z(1:nel)
192 r3z(1:nel) = r1x(1:nel)* r2y(1:nel) - r1y(1:nel) * r2x(1:nel)
193 DO i=1,nel
194 r3r3 = sqrt(r3x(i)*r3x(i) + r3y(i)*r3y(i) + r3z(i)*r3z(i))
195 IF (r3r3 /= zero) THEN
196 r3x(i) = r3x(i)/r3r3
197 r3y(i) = r3y(i)/r3r3
198 r3z(i) = r3z(i)/r3r3
199 ENDIF
200 ENDDO
202 . r1x, r1y, r1z, r2x, r2y, r2z, r3x, r3y, r3z)
203
204 ENDIF
205 ENDIF
206
207 DO i=1,nel
208 f(i,1,1) = one+mfxx(i)
209 f(i,2,2) = one+mfyy(i)
210 f(i,3,3) = one+mfzz(i)
211 f(i,1,2) = mfxy(i)
212 f(i
213 f(i,3,1) = mfzx(i)
214 f(i,2,1) = mfyx(i)
215 f(i,3,2) = mfzy(i)
216 f(i,1,3) = mfxz(i)
217 ENDDO
218
219
221
222
223
224
225
226
228 1 nel , fft , c10 , c01, c20,
229 2 c11 ,c02 , c30 , c21, c12,
230 3 c03 ,d1 , d2 , d3, siga ,
231 4 bi1 ,bi2 ,jdet ,flag_mul,
232 5 nvarf,coefr,betaf,coefm ,
233 6 uvarf,caii ,rbulk,iform)
234
235
236 IF (iavis>0) THEN
237
238
239
240 DO i=1,nel
241 sigb(i,1,1) = zero
242 sigb(i,2,2) = zero
243 sigb(i,3,3) = zero
244 sigb(i,1,2) = zero
245 sigb(i,2,3) = zero
246 sigb(i,3,1) = zero
247 ENDDO
248
249
250
252 CALL prodmat (f , invfpo, fe, nel)
254
255
256
257
258
260 1 nel , matb , c10, c01, c20,
261 2 c11 ,c02, c30, c21, c12,
262 3 c03 ,d1 ,d2 , d3, sigb ,
263 4 bi1,bi2,jdet ,flag_mul,
264 5 nvarf,coefr, betaf,coefm ,
265 6 uvarf,rbulk,iform)
266
267
268 DO i=1,nel
269 sigb(i,1,1) = sb * sigb
270 sigb(i,2,2) = sb * sigb(i,2,2)
271 sigb(i,3,3) = sb * sigb(i,3,3)
272 sigb(i,1,2) = sb * sigb(i,1,2)
273 sigb(i,2,3) = sb * sigb(i,2,3)
274 sigb(i,3,1) = sb * sigb(i,3,1)
275 ENDDO
276
277
278 DO i=1,nel
279 traceb(i) = third
280
281 sb1(i) = sigb(i,1,1) - traceb(i)
282 sb2(i) = sigb(i,2,2) - traceb(i)
283 sb3(i) = sigb(i,3,3) - traceb(i)
284 sb4(i) = sigb(i,1,2)
285 sb5(i) = sigb(i,2,3)
286 sb6(i) = sigb(i,3,1)
287
288 tbnorm(i) = sqrt(
max(em20,sb1(i)**2+sb2(i)**2+sb3(i)**2
289 . + two*(sb4(i)**2+sb5(i)**2+sb6(i)**2 )) )
290 ENDDO
291
292
293
294
295 CALL viscbb ( nel , fpo, tbnorm , a1 , expc,
296 . expm, ksi, tauref , dgamma )
297
298
299 IF (time == zero) dgamma(1:nel) = uvar(1:nel,10)
300 DO i=1,nel
301 uvar(i,10)= dgamma(i)
302 factor = dgamma(i)/tbnorm(i)
303 lb(i,1,1) = factor *sb1(i)
304 lb(i,2,2) = factor *sb2(i)
305 lb(i,3,3) = factor *sb3(i)
306 lb(i,1,2) = factor *sb4(i)
307 lb(i,2,3) = factor *sb5(i)
308 lb(i,3,1) = factor *sb6(i)
309 lb(i,2,1) = lb(i,1,2)
310 lb(i,3,2) = lb(i,2,3)
311 lb(i,1,3) = lb(i,3,1)
312
313 ENDDO
314
315
316
317
319 CALL prodmat (lb , fe, fedp, nel)
320 CALL prodmat(invfe ,fedp, dfp , nel)
321
322
323 DO i=1,nel
324
325 sn(i,1,1) = one + dfp(i,1,1)
326 sn(i,2,2) = one + dfp(i,2,2)
327 sn(i,3,3) = one + dfp(i,3,3)
328 sn(i,1,2) = dfp(i,1,2)
329 sn(i,2,3) = dfp(i,2,3)
330 sn(i,3,1) = dfp(i,3,1)
331 sn(i,2,1) = dfp(i,2,1)
332 sn(i,3,2) = dfp(i,3,2)
333 sn(i,1,3) = dfp(i,1,3)
334 ENDDO
337
338
339
340
342 1 nel , matb , c10, c01, c20,
343 2 c11 ,c02, c30, c21, c12,
344 3 c03 ,d1 ,d2 , d3, sigb ,
345 4 bi1,bi2,jdet ,flag_mul,
346 5 nvarf,coefr, betaf,coefm ,
347 6 uvarf,cbii,rbulk,iform)
348
349 DO i=1,nel
350 sigb(i,1,1) = sb * sigb(i,1,1)
351 sigb(i,2,2) = sb * sigb(i,2,2)
352 sigb(i,3,3) = sb * sigb(i,3,3)
353 sigb(i,1,2) = sb * sigb(i,1,2)
354 sigb(i,2,3) = sb * sigb(i,2,3)
355 sigb(i,3,1) = sb * sigb(i,3,1)
356 ENDDO
357 IF (jcvt >0 ) THEN
359 . r1x, r1y, r1z, r2x, r2y, r2z, r3x, r3y, r3z)
360
361 ENDIF
362 DO i=1,nel
363 uvar(i,1) = fp(i,1,1)
364 uvar(i,2) = fp(i,2,2)
365 uvar(i,3) = fp(i,3,3)
366 uvar(i,4) = fp(i,1,2)
367 uvar(i,5) = fp(i,2,3)
368 uvar(i,6) = fp(i,3,1)
369 uvar(i,7) = fp(i,2,1)
370 uvar(i,8) = fp(i,3,2)
371 uvar(i,9) = fp(i,1,3)
372 ENDDO
373
374 ELSE
375 DO i=1,nel
376 sigb(i,1:3,1:3) = sb * siga(i,1:3,1:3)
377 cbii(i,1:3) = caii(i,1:3)
378 ENDDO
379 END IF
380
381
382
383
384 DO i=1,nel
385 signxx(i) = siga(i,1,1) + sigb(i,1,1)
386 signyy(i) = siga(i,2,2) + sigb(i,2,2)
387 signzz(i) = siga(i,3,3) + sigb(i,3,3)
388 signxy(i) = siga(i,1,2) + sigb(i,1,2)
389 signyz(i) = siga(i,2,3) + sigb(i,2,3)
390 signzx(i) = siga(i,3,1) + sigb(i,3,1)
391 ENDDO
392
393
394 DO i=1,nel
395 cii(1:3)=caii(i,1:3)+sb*cbii(i,1:3)
396 c_max(i)=
max(stiff0,cii(1),cii(2),cii(3))
397 ENDDO
398
399 DO i=1,nel
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414 soundsp(i)=sqrt(c_max(i)/rho(i))
415 viscmax(i) = zero
416 ENDDO
417 IF (impl_s > 0 .OR. ihet > 1) THEN
418 DO i=1,nel
419 et(i)= one
420 ENDDO
421 ENDIF
422
423
424 RETURN
subroutine calcmatb(nel, f, fp, matb)
subroutine kmatinv3(mat, ainv, nel)
subroutine prodaat(a, c, nel)
subroutine prodmat(a, b, c, nel)
subroutine rottoloc(nel, fp, r1x, r1y, r1z, r2x, r2y, r2z, r3x, r3y, r3z)
subroutine rottoglob(nel, fp, r1x, r1y, r1z, r2x, r2y, r2z, r3x, r3y, r3z)
subroutine polystress2(nel, matb, c10, c01, c20, c11, c02, c30, c21, c12, c03, d1, d2, d3, sig, bi1, bi2, jdet, flag_mul, nvarf, coefr, betaf, coefm, uvarf, rbulk, iform)
subroutine polystrest2(nel, matb, c10, c01, c20, c11, c02, c30, c21, c12, c03, d1, d2, d3, sig, bi1, bi2, jdet, flag_mul, nvarf, coefr, betaf, coefm, uvarf, cii, rbulk, iform)
subroutine viscbb(nel, fp, tbnorm, a1, expc, expm, ksi, tauref, dgamma)