OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
strs_tenscor3.F File Reference
#include "implicit_f.inc"
#include "vect01_c.inc"
#include "mvsiz_p.inc"
#include "com04_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine strs_tenscor3 (elbuf_tab, iparg, ixs, ixs10, x, pm, kcvt, nel, evar)

Function/Subroutine Documentation

◆ strs_tenscor3()

subroutine strs_tenscor3 ( type (elbuf_struct_), target elbuf_tab,
integer, dimension(nparg) iparg,
integer, dimension(nixs,*) ixs,
integer, dimension(6,*) ixs10,
x,
pm,
integer kcvt,
integer nel,
evar )

Definition at line 34 of file strs_tenscor3.F.

36C-----------------------------------------------
37C M o d u l e s
38C-----------------------------------------------
39c USE INITBUF_MOD
40 USE elbufdef_mod
41C-----------------------------------------------
42C I m p l i c i t T y p e s
43C-----------------------------------------------
44#include "implicit_f.inc"
45C-----------------------------------------------
46C C o m m o n B l o c k s
47C-----------------------------------------------
48#include "vect01_c.inc"
49#include "mvsiz_p.inc"
50#include "com04_c.inc"
51#include "param_c.inc"
52C-----------------------------------------------
53C D u m m y A r g u m e n t s
54C-----------------------------------------------
55C REAL
56 my_real
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
60C-----------------------------------------------
61C L o c a l V a r i a b l e s
62C-----------------------------------------------
63C REAL
64 my_real
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 . ksi,eta,zeta
71 INTEGER I,II, ISS, ISC,NBGAMA,
72 . IADD, N, J, MLW,
73 . ISTRAIN,NN, JTURB,MT, IMID, IALEL,IPID,
74 . NN1,NF,OFFSET,K,INC,KK, IUS, NUVAR,
75 . INOD, ISOLNOD, IPRT, LIAD, NPTR, NPTS, NPTT, IPT,
76 . IS, IR, IT, NPTG,NC(10,MVSIZ),NNOD,IEXPAN,IHBE,MPT,ILAY,
77 . ICSIG,DIR,IVISC,JJ(6),MAT(MVSIZ)
78 INTEGER MLW2,NLAY
79 TYPE(G_BUFEL_) ,POINTER :: GBUF
80 TYPE(L_BUFEL_) ,POINTER :: LBUF
81 my_real
82 . a_gauss(9,9),evar_tmp(6),alpha,beta,alpha_1,beta_1,
83 . jr0(mvsiz),js0(mvsiz),jt0(mvsiz),nu(mvsiz),sig_hour(mvsiz,6),
84 . evar_t10(6,10),a_heph(3,8)
85 INTEGER
86 . SOL_NODE(3,8), IPERM1(10),IPERM2(10),NN2
87 DATA iperm1/0,0,0,0,1,2,3,1,2,3/
88 DATA iperm2/0,0,0,0,2,3,1,4,4,4/
89C=======================================================================
90 DATA a_gauss /
91 1 0. ,0. ,0. ,
92 1 0. ,0. ,0. ,
93 1 0. ,0. ,0. ,
94 2 -.577350269189626,0.577350269189626,0. ,
95 2 0. ,0. ,0. ,
96 2 0. ,0. ,0. ,
97 3 -.774596669241483,0. ,0.774596669241483,
98 3 0. ,0. ,0. ,
99 3 0. ,0. ,0. ,
100 4 -.861136311594053,-.339981043584856,0.339981043584856,
101 4 0.861136311594053,0. ,0. ,
102 4 0. ,0. ,0. ,
103 5 -.906179845938664,-.538469310105683,0. ,
104 5 0.538469310105683,0.906179845938664,0. ,
105 5 0. ,0. ,0. ,
106 6 -.932469514203152,-.661209386466265,-.238619186083197,
107 6 0.238619186083197,0.661209386466265,0.932469514203152,
108 6 0. ,0. ,0. ,
109 7 -.949107912342759,-.741531185599394,-.405845151377397,
110 7 0. ,0.405845151377397,0.741531185599394,
111 7 0.949107912342759,0. ,0. ,
112 8 -.960289856497536,-.796666477413627,-.525532409916329,
113 8 -.183434642495650,0.183434642495650,0.525532409916329,
114 8 0.796666477413627,0.960289856497536,0. ,
115 9 -.968160239507626,-.836031107326636,-.613371432700590,
116 9 -.324253423403809,0. ,0.324253423403809,
117 9 0.613371432700590,0.836031107326636,0.968160239507626/
118 DATA sol_node /
119 1 -1 ,-1 ,-1 ,
120 2 -1 ,-1 , 1 ,
121 3 1 ,-1 , 1 ,
122 4 1 ,-1 ,-1 ,
123 5 -1 , 1 ,-1 ,
124 6 -1 , 1 , 1 ,
125 7 1 , 1 , 1 ,
126 8 1 , 1 ,-1 /
127C-----Nj : KSI,ETA,ZETA
128 DATA a_heph /
129 1 -1 ,-1 ,-1 ,
130 4 1 ,-1 ,-1 ,
131 5 -1 , 1 ,-1 ,
132 8 1 , 1 ,-1 ,
133 2 -1 ,-1 , 1 ,
134 3 1 ,-1 , 1 ,
135 7 1 , 1 , 1 ,
136 6 -1 , 1 , 1 /
137C=======================================================================
138C------not available w/ S16,S20
139 ir = 0
140 is = 0
141 it = 0
142 n1 = zero
143 ilay = -huge(ilay)
144 alpha = zep1381966
145 beta = zep5854102
146 evar(1:6,1:20,1:mvsiz)=zero
147 isolnod = iparg(28)
148 ivisc = iparg(61)
149 lft=1
150 llt=nel
151 nnod = 0
152!
153 DO i=1,6
154 jj(i) = nel*(i-1)
155 ENDDO
156!
157C-----------------------------------------------
158C SOLID 8N
159C-----------------------------------------------
160c IF (ITY == 1) THEN
161 gbuf => elbuf_tab%GBUF
162 IF (kcvt==1.AND.isorth/=0) kcvt=2
163 nnod = isolnod
164 DO i=lft,llt
165 n = i + nft
166 IF(isolnod == 8)THEN
167 DO j = 1,isolnod
168 nc(j,i) = ixs(j+1,n)
169 ENDDO
170 ELSEIF(isolnod == 4)THEN
171 nc(1,i)=ixs(2,n)
172 nc(2,i)=ixs(4,n)
173 nc(3,i)=ixs(7,n)
174 nc(4,i)=ixs(6,n)
175 ELSEIF(isolnod == 6)THEN
176 nc(1,i)=ixs(2,n)
177 nc(2,i)=ixs(3,n)
178 nc(3,i)=ixs(4,n)
179 nc(4,i)=ixs(6,n)
180 nc(5,i)=ixs(7,n)
181 nc(6,i)=ixs(8,n)
182 ELSEIF(isolnod == 10)THEN
183 nc(1,i)=ixs(2,n)
184 nc(2,i)=ixs(4,n)
185 nc(3,i)=ixs(7,n)
186 nc(4,i)=ixs(6,n)
187 nn1 = n - numels8
188 DO j=1,6
189 nc(j+4,i) = ixs10(j,nn1)
190 ENDDO
191c ELSEIF(ISOLNOD == 16)THEN
192c DO J = 1,8
193c NC(J,I) = IXS(J+1,N)
194c ENDDO
195c NN1 = N - (NUMELS8+NUMELS10+NUMELS20)
196c DO J=1,8
197c NC(J+8,I) = IXS16(J,NN1)
198c ENDDO
199c ELSEIF(ISOLNOD == 20)THEN
200c DO J = 1,8
201c NC(J,I) = IXS(J+1,N)
202c ENDDO
203c NN1 = N - (NUMELS8+NUMELS10)
204c DO J=1,12
205c NC(J+8,I) = IXS20(J,NN1)
206c ENDDO
207 ENDIF
208 ENDDO
209C
210 nptr = elbuf_tab%NPTR
211 npts = elbuf_tab%NPTS
212 nptt = elbuf_tab%NPTT
213 nlay = elbuf_tab%NLAY
214 npt = nptr*npts*nptt
215 nnod = isolnod
216 sig_hour = zero
217 IF (jhbe == 24) THEN
218 CALL pre_heph(x,ixs,jr0,js0,jt0,pm,mat,nu,nft,nel)
219 ENDIF
220C----------
221 IF(isolnod == 6 .OR. isolnod == 8 )THEN
222c
223c T_SHELL ( JHBE = 15/16 )
224 IF(nlay > 1 .AND. jhbe /= 14) THEN
225 DO i=lft,llt
226 n = i + nft
227 IF (kcvt /= 0) THEN
228 IF(kcvt==2)THEN
229 gama(1) = gbuf%GAMA(jj(1) + i)
230 gama(2) = gbuf%GAMA(jj(2) + i)
231 gama(3) = gbuf%GAMA(jj(3) + i)
232 gama(4) = gbuf%GAMA(jj(4) + i)
233 gama(5) = gbuf%GAMA(jj(5) + i)
234 gama(6) = gbuf%GAMA(jj(6) + i)
235 ELSE
236 gama(1)=one
237 gama(2)=zero
238 gama(3)=zero
239 gama(4)=zero
240 gama(5)=one
241 gama(6)=zero
242 END IF
243 END IF
244 npts = nlay
245C
246 DO j=1,min(8,isolnod)
247 DO k=1,min(8,isolnod)
248 IF(sol_node(2,k) == sol_node(2,j)) THEN
249c
250 IF (sol_node(1,k) == -1 .AND. sol_node(1,j) == -1)
251 . ir = 1
252 IF (sol_node(1,k) == -1 .AND. sol_node(1,j) == 1)
253 . ir = max(1,nptr-1)
254 IF (sol_node(1,k) == 1 .AND. sol_node(1,j) == 1)
255 . ir = nptr
256 IF (sol_node(1,k) == 1 .AND. sol_node(1,j) == -1)
257 . ir = min(nptr,2)
258 IF (sol_node(2,k) == -1 .AND. sol_node(2,j) == -1)
259 . is = 1
260 IF (sol_node(2,k) == -1 .AND. sol_node(2,j) == 1)
261 . is = max(1,npts-1)
262 IF (sol_node(2,k) == 1 .AND. sol_node(2,j) == 1)
263 . is = npts
264 IF (sol_node(2,k) == 1 .AND. sol_node(2,j) == -1)
265 . is = min(npts,2)
266 IF (sol_node(3,k) == -1 .AND. sol_node(3,j) == -1)
267 . it = 1
268 IF (sol_node(3,k) == -1 .AND. sol_node(3,j) == 1)
269 . it = max(1,nptt-1)
270 IF (sol_node(3,k) == 1 .AND. sol_node(3,j) == 1)
271 . it = nptt
272 IF (sol_node(3,k) == 1 .AND. sol_node(3,j) == -1)
273 . it = min(nptt,2)
274c
275 a_gauss_p_r = zero
276 a_gauss_p_s = zero
277 a_gauss_p_t = zero
278c
279 IF (nptr == 1)THEN
280 a_gauss_p_r = zero
281 ELSEIF (sol_node(1,j) == -1 )THEN
282 a_gauss_r = a_gauss(1,nptr)
283 a_gauss_r1 = a_gauss(2,nptr)
284 a_gauss_p_r =
285 . (-one-half*(a_gauss_r1+a_gauss_r))/
286 . (half*(a_gauss_r1-a_gauss_r))
287 ELSEIF(sol_node(1,j) == 1 )THEN
288 a_gauss_r = a_gauss(nptr-1,nptr)
289 a_gauss_r1 = a_gauss(nptr,nptr)
290 a_gauss_p_r =
291 . (one+half*(a_gauss_r1+a_gauss_r))/
292 . (half*(a_gauss_r1-a_gauss_r))
293 ENDIF
294c
295 IF (npts == 1)THEN
296 a_gauss_p_s = zero
297 ELSEIF (sol_node(2,j) == -1 )THEN
298 a_gauss_s = a_gauss(1,npts)
299 a_gauss_s1 = a_gauss(2,npts)
300 a_gauss_p_s =
301 . (-one-half*(a_gauss_s1+a_gauss_s))/
302 . (half*(a_gauss_s1-a_gauss_s))
303 ELSEIF(sol_node(2,j) == 1 )THEN
304 a_gauss_s = a_gauss(npts-1,npts)
305 a_gauss_s1 = a_gauss(npts,npts)
306 a_gauss_p_s =
307 . (one+half*(a_gauss_s1+a_gauss_s))/
308 . (half*(a_gauss_s1-a_gauss_s))
309 ENDIF
310c
311 IF (nptt == 1)THEN
312 a_gauss_p_t = zero
313 ELSEIF (sol_node(3,j) == -1 )THEN
314 a_gauss_t = a_gauss(1,nptt)
315 a_gauss_t1 = a_gauss(2,nptt)
316 a_gauss_p_t =
317 . (-one-half*(a_gauss_t1+a_gauss_t))/
318 . (half*(a_gauss_t1-a_gauss_t))
319 ELSEIF(sol_node(3,j) == 1 )THEN
320 a_gauss_t = a_gauss(nptt-1,nptt)
321 a_gauss_t1 = a_gauss(nptt,nptt)
322 a_gauss_p_t =
323 . (one+half*(a_gauss_t1+a_gauss_t))/
324 . (half*(a_gauss_t1-a_gauss_t))
325 ENDIF
326c
327 IF (jhbe == 15 .OR. jhbe == 16) THEN
328 ilay = is
329 is = 1
330 n1 = fourth*(
331 . (one+sol_node(1,k) * a_gauss_p_r) *
332 . (one+sol_node(3,k) * a_gauss_p_t) )
333 ENDIF
334c
335 lbuf => elbuf_tab%BUFLY(ilay)%LBUF(ir,is,it)
336 evar_tmp(1:6) = lbuf%SIG(jj(1:6) + i)
337 IF(ivisc > 0) THEN
338 evar_tmp(1:6) = evar_tmp(1:6) + lbuf%VISC(jj(1:6) + i)
339 ENDIF
340 IF (kcvt /= 0)
341 . CALL srota6(
342 1 x, ixs(1,n),kcvt, evar_tmp,
343 2 gama, jhbe, igtyp, isorth)
344 evar(1:6,j,i) = evar(1:6,j,i)+ n1 * evar_tmp(1:6)
345 ENDIF
346 ENDDO
347 ENDDO
348 ENDDO
349 ELSEIF (jhbe == 24) THEN
350 DO i=lft,llt
351 n = i + nft
352 IF (kcvt /= 0) THEN
353 IF(kcvt==2)THEN
354 gama(1:6) = gbuf%GAMA(jj(1:6) + i)
355 ELSE
356 gama(1)=one
357 gama(2)=zero
358 gama(3)=zero
359 gama(4)=zero
360 gama(5)=one
361 gama(6)=zero
362 END IF
363 END IF
364 DO j=1,8
365 ksi = a_heph(1,j)
366 eta = a_heph(2,j)
367 zeta = a_heph(3,j)
368c
369 ilay = 1
370
371 lbuf => elbuf_tab%BUFLY(ilay)%LBUF(1,1,1)
372C------ orthotropic laws will be treated later
373 CALL szsigpara(jr0 ,js0 ,jt0 ,gbuf%HOURG ,gbuf%SIG ,
374 . sig_hour ,ksi ,eta ,zeta ,nu ,nel , i)
375 evar_tmp(1:6) = sig_hour(i,1:6)
376 IF(ivisc > 0) THEN
377 evar_tmp(1:6) =evar_tmp(1:6)+ lbuf%VISC(jj(1:6) + i)
378 ENDIF
379 IF (kcvt /= 0)
380 . CALL srota6(
381 1 x, ixs(1,n),kcvt, evar_tmp,
382 2 gama, jhbe, igtyp, isorth)
383 evar(1:6,j,i) = evar_tmp(1:6)
384 ENDDO
385 END DO !I=LFT,LLT
386 ELSE
387C---------- JHBE /= 24
388 DO i=lft,llt
389 n = i + nft
390 IF (kcvt /= 0) THEN
391 IF(kcvt==2)THEN
392 gama(1:6) = gbuf%GAMA(jj(1:6) + i)
393 ELSE
394 gama(1)=one
395 gama(2)=zero
396 gama(3)=zero
397 gama(4)=zero
398 gama(5)=one
399 gama(6)=zero
400 END IF
401 END IF
402 IF(igtyp == 20 .OR. igtyp ==21 .OR. igtyp == 22) THEN
403 nptt = nlay
404 ENDIF
405 DO j=1,min(8,isolnod)
406 DO k=1,min(8,isolnod)
407 IF (sol_node(1,k) == -1 .AND. sol_node(1,j) == -1)
408 . is = 1
409 IF (sol_node(1,k) == -1 .AND. sol_node(1,j) == 1)
410 . is = max(1,npts-1)
411 IF (sol_node(1,k) == 1 .AND. sol_node(1,j) == 1)
412 . is = npts
413 IF (sol_node(1,k) == 1 .AND. sol_node(1,j) == -1)
414 . is = min(npts,2)
415 IF (sol_node(2,k) == -1 .AND. sol_node(2,j) == -1)
416 . it = 1
417 IF (sol_node(2,k) == -1 .AND. sol_node(2,j) == 1)
418 . it = max(1,nptt-1)
419 IF (sol_node(2,k) == 1 .AND. sol_node(2,j) == 1)
420 . it = nptt
421 IF (sol_node(2,k) == 1 .AND. sol_node(2,j) == -1)
422 . it = min(nptt,2)
423 IF (sol_node(3,k) == -1 .AND. sol_node(3,j) == -1)
424 . ir = 1
425 IF (sol_node(3,k) == -1 .AND. sol_node(3,j) == 1)
426 . ir = max(1,nptr-1)
427 IF (sol_node(3,k) == 1 .AND. sol_node(3,j) == 1)
428 . ir = nptr
429 IF (sol_node(3,k) == 1 .AND. sol_node(3,j) == -1)
430 . ir = min(nptr,2)
431c
432 a_gauss_p_r = zero
433 a_gauss_p_s = zero
434 a_gauss_p_t = zero
435c
436 IF (nptr == 1)THEN
437 a_gauss_p_r = zero
438 ELSEIF (sol_node(1,j) == -1 )THEN
439 a_gauss_r = a_gauss(1,nptr)
440 a_gauss_r1 = a_gauss(2,nptr)
441 a_gauss_p_r =
442 . (-one-half*(a_gauss_r1+a_gauss_r))/
443 . (half*(a_gauss_r1-a_gauss_r))
444 ELSEIF(sol_node(1,j) == 1 )THEN
445 a_gauss_r = a_gauss(nptr-1,nptr)
446 a_gauss_r1 = a_gauss(nptr,nptr)
447 a_gauss_p_r =
448 . (one+half*(a_gauss_r1+a_gauss_r))/
449 . (half*(a_gauss_r1-a_gauss_r))
450 ENDIF
451c
452 IF (npts == 1)THEN
453 a_gauss_p_s = zero
454 ELSEIF (sol_node(2,j) == -1 )THEN
455 a_gauss_s = a_gauss(1,npts)
456 a_gauss_s1 = a_gauss(2,npts)
457 a_gauss_p_s =
458 . (-one-half*(a_gauss_s1+a_gauss_s))/
459 . (half*(a_gauss_s1-a_gauss_s))
460 ELSEIF(sol_node(2,j) == 1 )THEN
461 a_gauss_s = a_gauss(npts-1,npts)
462 a_gauss_s1 = a_gauss(npts,npts)
463 a_gauss_p_s =
464 . (one+half*(a_gauss_s1+a_gauss_s))/
465 . (half*(a_gauss_s1-a_gauss_s))
466 ENDIF
467c
468 IF (nptt == 1)THEN
469 a_gauss_p_t = zero
470 ELSEIF (sol_node(3,j) == -1 )THEN
471 a_gauss_t = a_gauss(1,nptt)
472 a_gauss_t1 = a_gauss(2,nptt)
473 a_gauss_p_t =
474 . (-one-half*(a_gauss_t1+a_gauss_t))/
475 . (half*(a_gauss_t1-a_gauss_t))
476 ELSEIF(sol_node(3,j) == 1 )THEN
477 a_gauss_t = a_gauss(nptt-1,nptt)
478 a_gauss_t1 = a_gauss(nptt,nptt)
479 a_gauss_p_t =
480 . (one+half*(a_gauss_t1+a_gauss_t))/
481 . (half*(a_gauss_t1-a_gauss_t))
482 ENDIF
483c
484 n1 = one_over_8*(
485 . (one+sol_node(1,k) * a_gauss_p_r) *
486 . (one+sol_node(2,k) * a_gauss_p_s) *
487 . (one+sol_node(3,k) * a_gauss_p_t) )
488c
489 IF (igtyp == 20 .OR. igtyp ==21 .OR. igtyp == 22) THEN
490 ilay = it
491 it = 1
492 ELSE
493 ilay = 1
494 ENDIF
495c
496 ksi = a_gauss(ir,2)
497 eta = a_gauss(is,2)
498 zeta = a_gauss(it,2)
499
500 lbuf => elbuf_tab%BUFLY(ilay)%LBUF(ir,is,it)
501
502 evar_tmp(1) = lbuf%SIG(jj(1) + i)
503 evar_tmp(2) = lbuf%SIG(jj(2) + i)
504 evar_tmp(3) = lbuf%SIG(jj(3) + i)
505 evar_tmp(4) = lbuf%SIG(jj(4) + i)
506 evar_tmp(5) = lbuf%SIG(jj(5) + i)
507 evar_tmp(6) = lbuf%SIG(jj(6) + i)
508 IF(ivisc > 0) THEN
509 evar_tmp(1) =evar_tmp(1)+ lbuf%VISC(jj(1) + i)
510 evar_tmp(2) =evar_tmp(2)+ lbuf%VISC(jj(2) + i)
511 evar_tmp(3) =evar_tmp(3)+ lbuf%VISC(jj(3) + i)
512 evar_tmp(4) =evar_tmp(4)+ lbuf%VISC(jj(4) + i)
513 evar_tmp(5) =evar_tmp(5)+ lbuf%VISC(jj(5) + i)
514 evar_tmp(6) =evar_tmp(6)+ lbuf%VISC(jj(6) + i)
515 ENDIF
516 IF (kcvt /= 0)
517 . CALL srota6(
518 1 x, ixs(1,n),kcvt, evar_tmp,
519 2 gama, jhbe, igtyp, isorth)
520 evar(1:6,j,i) = evar(1:6,j,i)+ n1 * evar_tmp(1:6)
521 ENDDO
522 ENDDO
523 ENDDO
524 ENDIF
525c
526 ELSEIF(isolnod == 4 )THEN
527c
528 DO i=lft,llt
529 n = i + nft
530 IF (kcvt /= 0) THEN
531 IF(kcvt==2)THEN
532 gama(1) = gbuf%GAMA(jj(1) + i)
533 gama(2) = gbuf%GAMA(jj(2) + i)
534 gama(3) = gbuf%GAMA(jj(3) + i)
535 gama(4) = gbuf%GAMA(jj(4) + i)
536 gama(5) = gbuf%GAMA(jj(5) + i)
537 gama(6) = gbuf%GAMA(jj(6) + i)
538 ELSE
539 gama(1)=one
540 gama(2)=zero
541 gama(3)=zero
542 gama(4)=zero
543 gama(5)=one
544 gama(6)=zero
545 END IF
546 END IF
547 n1 = fourth
548 ilay = 1
549 lbuf => elbuf_tab%BUFLY(ilay)%LBUF(1,1,1)
550 evar_tmp(1) = lbuf%SIG(jj(1) + i)
551 evar_tmp(2) = lbuf%SIG(jj(2) + i)
552 evar_tmp(3) = lbuf%SIG(jj(3) + i)
553 evar_tmp(4) = lbuf%SIG(jj(4) + i)
554 evar_tmp(5) = lbuf%SIG(jj(5) + i)
555 evar_tmp(6) = lbuf%SIG(jj(6) + i)
556 IF(ivisc > 0) THEN
557 evar_tmp(1) =evar_tmp(1)+ lbuf%VISC(jj(1) + i)
558 evar_tmp(2) =evar_tmp(2)+ lbuf%VISC(jj(2) + i)
559 evar_tmp(3) =evar_tmp(3)+ lbuf%VISC(jj(3) + i)
560 evar_tmp(4) =evar_tmp(4)+ lbuf%VISC(jj(4) + i)
561 evar_tmp(5) =evar_tmp(5)+ lbuf%VISC(jj(5) + i)
562 evar_tmp(6) =evar_tmp(6)+ lbuf%VISC(jj(6) + i)
563 ENDIF
564 IF (kcvt /= 0)
565 . CALL srota6(
566 1 x, ixs(1,n),kcvt, evar_tmp,
567 2 gama, jhbe, igtyp, isorth)
568 DO j=1,4
569 evar(1:6,j,i) = n1 * evar_tmp(1:6)
570 ENDDO
571 ENDDO
572 ELSEIF(isolnod == 10)THEN
573c
574 alpha_1 = -alpha/(beta-alpha)
575 beta_1 = (one-alpha)/(beta-alpha)
576 DO i=lft,llt
577 n = i + nft
578 IF (kcvt /= 0) THEN
579 IF(kcvt==2)THEN
580 gama(1) = gbuf%GAMA(jj(1) + i)
581 gama(2) = gbuf%GAMA(jj(2) + i)
582 gama(3) = gbuf%GAMA(jj(3) + i)
583 gama(4) = gbuf%GAMA(jj(4) + i)
584 gama(5) = gbuf%GAMA(jj(5) + i)
585 gama(6) = gbuf%GAMA(jj(6) + i)
586 ELSE
587 gama(1)=one
588 gama(2)=zero
589 gama(3)=zero
590 gama(4)=zero
591 gama(5)=one
592 gama(6)=zero
593 END IF
594 END IF
595 DO j=1,4
596 evar_t10(1:6,j)=zero
597 DO k=1,4
598 ir = k
599 is = 1
600 it = 1
601C
602 IF (j==k) THEN
603 n1 = beta_1
604 ELSE
605 n1 = alpha_1
606 ENDIF
607 ilay = 1
608 lbuf => elbuf_tab%BUFLY(ilay)%LBUF(ir,is,it)
609 evar_t10(1,j) = evar_t10(1,j)+ n1 *lbuf%SIG(jj(1) + i)
610 evar_t10(2,j) = evar_t10(2,j)+ n1 *lbuf%SIG(jj(2) + i)
611 evar_t10(3,j) = evar_t10(3,j)+ n1 *lbuf%SIG(jj(3) + i)
612 evar_t10(4,j) = evar_t10(4,j)+ n1 *lbuf%SIG(jj(4) + i)
613 evar_t10(5,j) = evar_t10(5,j)+ n1 *lbuf%SIG(jj(5) + i)
614 evar_t10(6,j) = evar_t10(6,j)+ n1 *lbuf%SIG(jj(6) + i)
615 IF(ivisc > 0) THEN
616 evar_t10(1,j) =evar_t10(1,j)+ n1 *lbuf%VISC(jj(1) + i)
617 evar_t10(2,j) =evar_t10(2,j)+ n1 *lbuf%VISC(jj(2) + i)
618 evar_t10(3,j) =evar_t10(3,j)+ n1 *lbuf%VISC(jj(3) + i)
619 evar_t10(4,j) =evar_t10(4,j)+ n1 *lbuf%VISC(jj(4) + i)
620 evar_t10(5,j) =evar_t10(5,j)+ n1 *lbuf%VISC(jj(5) + i)
621 evar_t10(6,j) =evar_t10(6,j)+ n1 *lbuf%VISC(jj(6) + i)
622 ENDIF
623 ENDDO
624 IF (kcvt /= 0)
625 . CALL srota6(
626 1 x, ixs(1,n), kcvt, evar_t10(1,j),
627 2 gama, jhbe, igtyp, isorth)
628 END DO !J=1,4
629 DO j=5,10
630 nn1=iperm1(j)
631 nn2=iperm2(j)
632 evar_t10(1:6,j) = half*(evar_t10(1:6,nn1)+evar_t10(1:6,nn2))
633 END DO
634 DO j=1,10
635 evar(1:6,j,i) = evar_t10(1:6,j)
636 ENDDO
637 ENDDO
638 ENDIF
639C-----------------------------------------------
640 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
alpha
#define alpha
Definition eval.h:35
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
srota6
subroutine srota6(x, ixs, kcvt, tens, gama)
Definition srota6.F:32
szsigpara
subroutine szsigpara(jr0, js0, jt0, fhour, sig0, sig, ksi, eta, zeta, nu, nel, i)
Definition szsigpara.F:33
pre_heph
subroutine pre_heph(x, ixs, jr0, js0, jt0, pm, mat, nu, nft, nel)
Definition tensor6.F:5451