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 35 of file strs_tenscor3.F.

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