36
37
38
40 USE elbufdef_mod
41
42
43
44#include "implicit_f.inc"
45
46
47
48#include "vect01_c.inc"
49#include "mvsiz_p.inc"
50#include "com04_c.inc"
51#include "param_c.inc"
52
53
54
55
57 . evar(6,20,mvsiz),x(3,*),pm(npropm,*)
58 INTEGER IPARG(NPARG),IXS(NIXS,*),IXS10(6,*),KCVT ,NEL
59 TYPE (ELBUF_STRUCT_), TARGET :: ELBUF_TAB
60
61
62
63
65 . gama(6),off, p, vonm2, vonm, s1, s2, s12, s3, VALUE,
66 . a1,b1,b2,b3,yeq,f1,m1,m2,m3,
for,
area(mvsiz),
67 . a_gauss_r,a_gauss_s,a_gauss_t,n1,
68 . a_gauss_r1,a_gauss_s1,a_gauss_t1,
69 . a_gauss_p_r,a_gauss_p_s,a_gauss_p_t
70 INTEGER I,II, ISS, ISC,NBGAMA,
71 . IADD, N, J, MLW,
72 . ISTRAIN,NN, JTURB,MT, IMID, IALEL,IPID,
73 . NN1,NF,OFFSET,K,INC,KK, , NUVAR,
74 . INOD, ISOLNOD, IPRT, LIAD, NPTR, NPTS, NPTT, IPT,
75 . IS, IR, IT, NPTG,NC(10,MVSIZ),NNOD,IEXPAN,IHBE,MPT,ILAY,
76 . ICSIG,DIR,IVISC,JJ(6),IP
77 INTEGER MLW2,NLAY
78 TYPE(G_BUFEL_) ,POINTER :: GBUF
79 TYPE(L_BUFEL_) ,POINTER :: LBUF
81 . a_gauss(9,9),evar_tmp(6),
alpha,beta,alpha_1,beta_1,
82 . str_is24(mvsiz,6,8),evar_t10(6,10)
83 INTEGER
84 . SOL_NODE(3,8), IPERM1(10),IPERM2(10),NN2
85 DATA iperm1/0,0,0,0,1,2,3,1,2,3/
86 DATA iperm2/0,0,0,0,2,3,1,4,4,4/
87
88 DATA a_gauss /
89 1 0. ,0. ,0. ,
90 1 0. ,0. ,0. ,
91 1 0. ,0. ,0. ,
92 2 -.577350269189626,0.577350269189626,0. ,
93 2 0. ,0. ,0. ,
94 2 0. ,0. ,0. ,
95 3 -.774596669241483,0. ,0.774596669241483,
96 3 0. ,0. ,0. ,
97 3 0. ,0. ,0. ,
98 4 -.861136311594053,-.339981043584856,0.339981043584856,
99 4 0.861136311594053,0. ,0. ,
100 4 0. ,0. ,0. ,
101 5 -.906179845938664,-.538469310105683,0. ,
102 5 0.538469310105683,0.906179845938664,0. ,
103 5 0. ,0. ,0. ,
104 6 -.932469514203152,-.661209386466265,-.238619186083197,
105 6 0.238619186083197,0.661209386466265,0.932469514203152,
106 6 0. ,0. ,0. ,
107 7 -.949107912342759,-.741531185599394,-.405845151377397,
108 7 0. ,0.405845151377397,0.741531185599394,
109 7 0.949107912342759,0. ,0. ,
110 8 -.960289856497536,-.796666477413627,-.525532409916329,
111 8 -.183434642495650,0.183434642495650,0.525532409916329,
112 8 0.796666477413627,0.960289856497536,0. ,
113 9 -.968160239507626,-.836031107326636,-.613371432700590,
114 9 -.324253423403809,0. ,0.324253423403809,
115 9 0.613371432700590,0.836031107326636,0.968160239507626/
116 DATA sol_node /
117 1 -1 ,-1 ,-1 ,
118 2 -1 ,-1 , 1 ,
119 3 1 ,-1 , 1 ,
120 4 1 ,-1 ,-1 ,
121 5 -1 , 1 ,-1 ,
122 6 -1 , 1 , 1 ,
123 7 1 , 1 , 1 ,
124 8 1 , 1 ,-1 /
125
127 beta = zep5854102
128 evar = zero
129 ivisc = iparg(61)
130 gbuf => elbuf_tab%GBUF
131 isolnod = iparg(28)
132 lft=1
133 llt=nel
134 nnod = 0
135
136 DO i=1,6
137 jj(i) = nel*(i-1)
138 ENDDO
139
140
141
142
143 IF (kcvt==1.AND.isorth/=0) kcvt=2
144 nnod = isolnod
145 DO i=lft,llt
146 n = i + nft
147 IF(isolnod == 8)THEN
148 DO j = 1,isolnod
149 nc(j,i) = ixs(j+1,n)
150 ENDDO
151 ELSEIF(isolnod == 4)THEN
152 nc(1,i)=ixs(2,n)
153 nc(2,i)=ixs(4,n)
154 nc(3,i)=ixs(7,n)
155 nc(4,i)=ixs(6,n)
156 ELSEIF(isolnod == 6)THEN
157 nc(1,i)=ixs(2,n)
158 nc(2,i)=ixs(3,n)
159 nc(3,i)=ixs(4,n)
160 nc(4,i)=ixs(6,n)
161 nc(5,i)=ixs(7,n)
162 nc(6,i)=ixs(8,n)
163 ELSEIF(isolnod == 10)THEN
164 nc(1,i)=ixs(2,n)
165 nc(2,i)=ixs(4,n)
166 nc(3,i)=ixs(7,n)
167 nc(4,i)=ixs(6,n)
168 nn1 = n - numels8
169 DO j=1,6
170 nc(j+4,i) = ixs10(j,nn1)
171 ENDDO
172 ENDIF
173 ENDDO
174
175 nptr = elbuf_tab%NPTR
176 npts = elbuf_tab%NPTS
177 nptt = elbuf_tab%NPTT
178 nlay = elbuf_tab%NLAY
179 npt = nptr*npts*nptt
180 IF (jhbe == 24) THEN
181 lbuf => elbuf_tab%BUFLY(1)%LBUF(1,1,1)
182 nptr = 2
183 npts = 2
184 nptt = 2
186 1 lbuf%STRA, str_is24, gbuf%STRHG,nel)
187 ENDIF
188
189 IF(isolnod == 6 .OR. isolnod == 8 .OR.
190 . isolnod == 16 .OR. isolnod == 20)THEN
191
192
193 IF(nlay > 1 .AND. jhbe /= 14) THEN
194 DO i=lft,llt
195 ii = 6*(i-1)
196 n = i + nft
197 IF (kcvt /= 0) THEN
198 IF(kcvt==2)THEN
199 gama(1:6) = gbuf%GAMA(jj(1:6) + i)
200 ELSE
201 gama(1)=one
202 gama(2)=zero
203 gama(3)=zero
204 gama(4)=zero
205 gama(5)=one
206 gama(6)=zero
207 END IF
208 END IF
209 npts = nlay
210
211 DO j=1,8
212 DO k=1,8
213 IF(sol_node(2,k) == sol_node(2,j)) THEN
214
215 IF (sol_node(1,k) == -1 .AND. sol_node(1,j) == -1)
216 . ir = 1
217 IF (sol_node(1,k) == -1 .AND. sol_node(1,j) == 1)
219 IF (sol_node(1,k) == 1 .AND. sol_node(1,j) == 1)
220 . ir = nptr
221 IF (sol_node(1,k) == 1 .AND. sol_node(1,j) == -1)
223 IF (sol_node(2,k) == -1 .AND. sol_node(2,j) == -1)
224 . is = 1
225 IF (sol_node(2,k) == -1 .AND. sol_node(2,j) == 1)
227 IF (sol_node(2,k) == 1 .AND. sol_node(2,j) == 1)
228 . is = npts
229 IF (sol_node(2,k) == 1 .AND. sol_node(2,j) == -1)
231 IF (sol_node(3,k) == -1 .AND. sol_node(3,j) == -1)
232 . it = 1
233 IF (sol_node(3,k) == -1 .AND. sol_node(3,j) == 1)
235 IF (sol_node(3,k) == 1 .AND. sol_node(3,j) == 1)
236 . it = nptt
237 IF (sol_node(3,k) == 1 .AND. sol_node(3,j) == -1)
239
240 a_gauss_p_r = zero
241 a_gauss_p_s = zero
242 a_gauss_p_t = zero
243
244 IF (nptr == 1)THEN
245 a_gauss_p_r = zero
246 ELSEIF (sol_node(1,j) == -1 )THEN
247 a_gauss_r = a_gauss(1,nptr)
248 a_gauss_r1 = a_gauss(2,nptr)
249 a_gauss_p_r =
250 . (-one-half*(a_gauss_r1+a_gauss_r))/
251 . (half*(a_gauss_r1-a_gauss_r))
252 ELSEIF(sol_node(1,j) == 1 )THEN
253 a_gauss_r = a_gauss(nptr-1,nptr)
254 a_gauss_r1 = a_gauss(nptr,nptr)
255 a_gauss_p_r =
256 . (one+half*(a_gauss_r1+a_gauss_r))/
257 . (half*(a_gauss_r1-a_gauss_r))
258 ENDIF
259
260 IF (npts == 1)THEN
261 a_gauss_p_s = zero
262 ELSEIF (sol_node(2,j) == -1 )THEN
263 a_gauss_s = a_gauss(1,npts)
264 a_gauss_s1 = a_gauss(2,npts)
265 a_gauss_p_s =
266 . (-one-half*(a_gauss_s1+a_gauss_s))/
267 . (half*(a_gauss_s1-a_gauss_s))
268 ELSEIF(sol_node(2,j) == 1 )THEN
269 a_gauss_s = a_gauss(npts-1,npts)
270 a_gauss_s1 = a_gauss(npts,npts)
271 a_gauss_p_s =
272 . (one+half*(a_gauss_s1+a_gauss_s))/
273 . (half*(a_gauss_s1-a_gauss_s))
274 ENDIF
275
276 IF (nptt == 1)THEN
277 a_gauss_p_t = zero
278 ELSEIF (sol_node(3,j) == -1 )THEN
279 a_gauss_t = a_gauss(1,nptt)
280 a_gauss_t1 = a_gauss(2,nptt)
281 a_gauss_p_t =
282 . (-one-half*(a_gauss_t1+a_gauss_t))/
283 . (half*(a_gauss_t1-a_gauss_t))
284 ELSEIF(sol_node(3,j) == 1 )THEN
285 a_gauss_t = a_gauss(nptt-1,nptt)
286 a_gauss_t1 = a_gauss(nptt,nptt)
287 a_gauss_p_t =
288 . (one+half*(a_gauss_t1+a_gauss_t))/
289 . (half*(a_gauss_t1-a_gauss_t))
290 ENDIF
291
292 IF (jhbe == 15 .OR. jhbe == 16) THEN
293 ilay = is
294 is = 1
295 n1 = fourth*(
296 . (one+sol_node(1,k) * a_gauss_p_r) *
297 . (one+sol_node(3,k) * a_gauss_p_t) )
298 ENDIF
299
300 lbuf => elbuf_tab%BUFLY(ilay)%LBUF(ir,is,it)
301 ip = ir + ( (is-1) + (it-1)*2 )*2
302 evar_tmp(1) = lbuf%STRA(jj(1) + i)
303 evar_tmp(2) = lbuf%STRA(jj(2) + i)
304 evar_tmp(3) = lbuf%STRA(jj(3) + i)
305 evar_tmp(4) = lbuf%STRA(jj(4) + i)*half
306 evar_tmp(5) = lbuf%STRA(jj(5) + i)*half
307 evar_tmp(6) = lbuf%STRA(jj(6) + i)*half
308 IF (kcvt /= 0)
310 1 x, ixs(1,n),kcvt, evar_tmp,
311 2 gama, jhbe, igtyp, isorth)
312 evar(1:6,j,i) = evar(1:6,j,i) + n1 * evar_tmp(1:6)
313 ENDIF
314 ENDDO
315 ENDDO
316 ENDDO
317 ELSE
318 DO i=lft,llt
319 ii = 6*(i-1)
320 n = i + nft
321 IF (kcvt /= 0) THEN
322 IF(kcvt==2)THEN
323 gama(1:6) = gbuf%GAMA(jj(1:6) + i)
324 ELSE
325 gama(1)=one
326 gama(2)=zero
327 gama(3)=zero
328 gama(4)=zero
329 gama(5)=one
330 gama(6)=zero
331 END IF
332 END IF
333 IF(igtyp == 20 .OR. igtyp ==21 .OR. igtyp == 22) THEN
334 nptt = nlay
335 ENDIF
336 DO j=1,8
337 DO k=1,8
338 IF (sol_node(1,k) == -1 .AND. sol_node(1,j) == -1)
339 . is = 1
340 IF (sol_node(1,k) == -1 .AND. sol_node(1,j) == 1)
342 IF (sol_node(1,k) == 1 .AND. sol_node(1,j) == 1)
343 . is = npts
344 IF (sol_node(1,k) == 1 .AND. sol_node(1,j) == -1)
346 IF (sol_node(2,k) == -1 .AND. sol_node(2,j) == -1)
347 . it = 1
348 IF (sol_node(2,k) == -1 .AND. sol_node(2,j) == 1)
350 IF (sol_node(2,k) == 1 .AND. sol_node(2,j) == 1)
351 . it = nptt
352 IF (sol_node(2,k) == 1 .AND. sol_node(2,j) == -1)
354 IF (sol_node(3,k) == -1 .AND. sol_node(3,j) == -1)
355 . ir = 1
356 IF (sol_node(3,k) == -1 .AND. sol_node(3,j) == 1)
358 IF (sol_node(3,k) == 1 .AND. sol_node(3,j) == 1)
359 . ir = nptr
360 IF (sol_node(3,k) == 1 .AND. sol_node(3,j) == -1)
362
363 a_gauss_p_r = zero
364 a_gauss_p_s = zero
365 a_gauss_p_t = zero
366
367 IF (nptr == 1)THEN
368 a_gauss_p_r = zero
369 ELSEIF (sol_node(1,j) == -1 )THEN
370 a_gauss_r = a_gauss(1,nptr)
371 a_gauss_r1 = a_gauss(2,nptr)
372 a_gauss_p_r =
373 . (-one-half*(a_gauss_r1+a_gauss_r))/
374 . (half*(a_gauss_r1-a_gauss_r))
375 ELSEIF(sol_node(1,j) == 1 )THEN
376 a_gauss_r = a_gauss(nptr-1,nptr)
377 a_gauss_r1 = a_gauss(nptr,nptr)
378 a_gauss_p_r =
379 . (one+half*(a_gauss_r1+a_gauss_r))/
380 . (half*(a_gauss_r1-a_gauss_r))
381 ENDIF
382
383 IF (npts == 1)THEN
384 a_gauss_p_s = zero
385 ELSEIF (sol_node(2,j) == -1 )THEN
386 a_gauss_s = a_gauss(1,npts)
387 a_gauss_s1 = a_gauss(2,npts)
388 a_gauss_p_s =
389 . (-one-half*(a_gauss_s1+a_gauss_s))/
390 . (half*(a_gauss_s1-a_gauss_s))
391 ELSEIF(sol_node(2,j) == 1 )THEN
392 a_gauss_s = a_gauss(npts-1,npts)
393 a_gauss_s1 = a_gauss
394 a_gauss_p_s =
395 . (one+half*(a_gauss_s1+a_gauss_s))/
396 . (half*(a_gauss_s1-a_gauss_s))
397 ENDIF
398
399 IF (nptt == 1)THEN
400 a_gauss_p_t = zero
401 ELSEIF (sol_node(3,j) == -1 )THEN
402 a_gauss_t = a_gauss(1,nptt)
403 a_gauss_t1 = a_gauss(2,nptt)
404 a_gauss_p_t =
405 . (-one-half*(a_gauss_t1+a_gauss_t))/
406 . (half*(a_gauss_t1-a_gauss_t))
407 ELSEIF(sol_node(3,j) == 1 )THEN
408 a_gauss_t = a_gauss(nptt-1,nptt)
409 a_gauss_t1 = a_gauss(nptt,nptt)
410 a_gauss_p_t =
411 . (one+half*(a_gauss_t1+a_gauss_t))/
412 . (half*(a_gauss_t1-a_gauss_t))
413 ENDIF
414
415 n1 = one_over_8*(
416 . (one+sol_node(1,k) * a_gauss_p_r) *
417 . (one+sol_node(2,k) * a_gauss_p_s) *
418 . (one+sol_node(3,k) * a_gauss_p_t) )
419
420 IF (igtyp == 20 .OR. igtyp ==21 .OR. igtyp == 22) THEN
421 ilay = it
422 it = 1
423 ELSE
424 ilay = 1
425 ENDIF
426
427 IF (jhbe == 24 .AND. gbuf%G_STRHG > 0) THEN
428 ip = ir + ( (is-1) + (it-1)*2 )*2
429 evar_tmp(1) = str_is24(i,1,ip)
430 evar_tmp(2) = str_is24(i,2,ip)
431 evar_tmp(3) = str_is24(i,3,ip)
432 evar_tmp(4) = str_is24(i,4,ip)*half
433 evar_tmp(5) = str_is24(i,5,ip)*half
434 evar_tmp(6) = str_is24(i,6,ip)*half
435 ELSE
436 lbuf => elbuf_tab%BUFLY(ilay)%LBUF(ir,is,it)
437 evar_tmp(1) = lbuf%STRA(jj(1) + i)
438 evar_tmp(2) = lbuf%STRA(jj(2) + i)
439 evar_tmp(3) = lbuf%STRA(jj(3) + i)
440 evar_tmp(4) = lbuf%STRA(jj(4) + i)*half
441 evar_tmp(5) = lbuf%STRA(jj(5) + i)*half
442 evar_tmp(6) = lbuf%STRA(jj(6) + i)*half
443 ENDIF
444 IF (kcvt /= 0)
446 1 x, ixs(1,n),kcvt, evar_tmp,
447 2 gama, jhbe, igtyp, isorth)
448 evar(1:6,j,i) = evar(1:6,j,i) + n1 * evar_tmp(1:6)
449 ENDDO
450 ENDDO
451 ENDDO
452 ENDIF
453
454 ELSEIF(isolnod == 4 )THEN
455
456 DO i=lft,llt
457 n = i + nft
458 IF (kcvt /= 0) THEN
459 IF(kcvt==2)THEN
460 gama(1) = gbuf%GAMA(jj(1) + i)
461 gama(2) = gbuf%GAMA(jj(2) + i)
462 gama(3) = gbuf%GAMA(jj(3) + i)
463 gama(4) = gbuf%GAMA(jj(4) + i)
464 gama(5) = gbuf%GAMA(jj(5) + i)
465 gama(6) = gbuf%GAMA(jj(6) + i)
466 ELSE
467 gama(1)=one
468 gama(2)=zero
469 gama(3)=zero
470 gama
471 gama(5)=one
472 gama(6)=zero
473 END IF
474 END IF
475 n1 = fourth
476 ilay = 1
477 lbuf => elbuf_tab%BUFLY(ilay)%LBUF(1,1,1)
478 evar_tmp(1) = lbuf%STRA(jj(1) + i)
479 evar_tmp(2) = lbuf%STRA(jj(2) + i)
480 evar_tmp(3) = lbuf%STRA(jj(3) + i)
481 evar_tmp(4) = lbuf%STRA(jj(4) + i)*half
482 evar_tmp(5) = lbuf%STRA(jj(5) + i)*half
483 evar_tmp(6) = lbuf%STRA(jj(6) + i)*half
484 IF (kcvt /= 0)
486 1 x, ixs(1,n),kcvt, evar_tmp,
487 2 gama, jhbe, igtyp, isorth)
488 DO j=1,4
489 evar(1:6,j,i) = evar(1:6,j,i) + n1 * evar_tmp(1:6)
490 ENDDO
491 ENDDO
492 ELSEIF(isolnod == 10)THEN
493
496 DO i=lft,llt
497 n = i + nft
498 IF (kcvt /= 0) THEN
499 IF(kcvt==2)THEN
500 gama(1) = gbuf%GAMA(jj(1) + i)
501 gama(2) = gbuf%GAMA(jj(2) + i)
502 gama(3) = gbuf%GAMA(jj(3) + i)
503 gama(4) = gbuf%GAMA(jj(4) + i)
504 gama(5) = gbuf%GAMA(jj(5) + i)
505 gama(6) = gbuf%GAMA(jj(6) + i)
506 ELSE
507 gama(1)=one
508 gama(2)=zero
509 gama(3)=zero
510 gama(4)=zero
511 gama(5)=one
512 gama(6)=zero
513 END IF
514 END IF
515 DO j=1,4
516 evar_t10(1:6,j)=zero
517 DO k=1,4
518 ir = k
519 is = 1
520 it = 1
521
522 IF (j==k) THEN
523 n1 = beta_1
524 ELSE
525 n1 = alpha_1
526 ENDIF
527 ilay = 1
528 lbuf => elbuf_tab%BUFLY(ilay)%LBUF(ir,is,it)
529 evar_t10(1,j) = evar_t10(1,j)+ n1 *lbuf%STRA(jj(1) + i)
530 evar_t10(2,j) = evar_t10(2,j)+ n1 *lbuf%STRA(jj(2) + i)
531 evar_t10(3,j) = evar_t10(3,j)+ n1 *lbuf%STRA(jj(3) + i)
532 evar_t10(4,j) = evar_t10(4,j)+ n1 *lbuf%STRA(jj(4) + i)*half
533 evar_t10(5,j) = evar_t10(5,j)+ n1 *lbuf%STRA(jj(5) + i)*half
534 evar_t10(6,j) = evar_t10(6,j)+ n1 *lbuf%STRA(jj(6) + i)*half
535 ENDDO
536 IF (kcvt /= 0)
538 1 x, ixs(1,n), kcvt, evar_t10(1,j),
539 2 gama, jhbe, igtyp, isorth)
540 ENDDO
541 DO j=5,10
542 nn1=iperm1(j)
543 nn2=iperm2(j)
544 evar_t10(1:6,j) = half*(evar_t10(1:6,nn1)+evar_t10(1:6,nn2))
545 END DO
546 DO j=1,10
547 evar(1:6,j,i) = evar_t10(1:6,j)
548 ENDDO
549 ENDDO
550 ENDIF
551
552 RETURN
subroutine area(d1, x, x2, y, y2, eint, stif0)
for(i8=*sizetab-1;i8 >=0;i8--)
subroutine srota6(x, ixs, kcvt, tens, gama)
subroutine szstraingps(strain, str_pi, strhg, nel)