OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
tensor6.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| tensors ../engine/source/output/anim/generate/tensor6.F
25!||--- called by ------------------------------------------------------
26!|| genani ../engine/source/output/anim/generate/genani.F
27!||--- calls -----------------------------------------------------
28!|| initbuf ../engine/share/resol/initbuf.F
29!|| spmd_r4get_partn ../engine/source/mpi/anim/spmd_r4get_partn.F
30!|| srota6 ../engine/source/output/anim/generate/srota6.F
31!|| srota6_s8s ../engine/source/output/anim/generate/srota6_s8s.F
32!|| write_r_c ../common_source/tools/input_output/write_routines.c
33!||--- uses -----------------------------------------------------
34!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.f90
35!|| element_mod ../common_source/modules/elements/element_mod.F90
36!|| initbuf_mod ../engine/share/resol/initbuf.F
37!|| my_alloc_mod ../common_source/tools/memory/my_alloc.F90
38!||====================================================================
39 SUBROUTINE tensors(ELBUF_TAB,IPARG ,ITENS ,IXS ,PM ,
40 2 EL2FA ,NBF ,TENS ,EPSDOT ,
41 3 NBPART ,X ,IADG ,IPART ,
42 4 IPARTSP ,ISPH3D ,IPM ,IGEO )
43C-----------------------------------------------
44C M o d u l e s
45C-----------------------------------------------
46 USE initbuf_mod
47 USE elbufdef_mod
48 USE my_alloc_mod
49 use element_mod , only : nixs
50C-----------------------------------------------
51C I m p l i c i t T y p e s
52C-----------------------------------------------
53#include "implicit_f.inc"
54C-----------------------------------------------
55C C o m m o n B l o c k s
56C-----------------------------------------------
57#include "vect01_c.inc"
58#include "mvsiz_p.inc"
59#include "com01_c.inc"
60#include "com04_c.inc"
61#include "sphcom.inc"
62#include "param_c.inc"
63#include "task_c.inc"
64#include "spmd_c.inc"
65#include "scr17_c.inc"
66C-----------------------------------------------
67C D u m m y A r g u m e n t s
68C-----------------------------------------------
69 my_real tens(6,*),epsdot(6,*),pm(npropm,*),x(3,*)
70 INTEGER IPARG(NPARG,*),ITENS,
71 . IXS(NIXS,*),EL2FA(*),IADG(NSPMD,*),IPM(NPROPMI,*),
72 . nbf,nbpart,ipart(lipart1,*),ipartsp(*),
73 . isph3d,igeo(npropgi,*)
74 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
75C-----------------------------------------------
76C L o c a l V a r i a b l e s
77C-----------------------------------------------
78 my_real gama(6),evar_tmp(6)
79 REAL R4(18)
80 INTEGER I,N,J,NG,NEL,IPT,MT1,MLW, ISTRAIN,TSHELL,
81 . ipid ,iprt,pti,pid,
82 . nn1,nn2,nn3,nn4,icsig,ior_tsh,nuvar,buf,
83 . kcvt,isolnod,nlay,nptr,npts,nptt,nptg,il,is,ir,it,ivisc,iok,
84 . jj(6),ir0,is0,it0
85 REAL,DIMENSION(:),ALLOCATABLE :: WA
86 TYPE(G_BUFEL_) ,POINTER :: GBUF
87 TYPE(L_BUFEL_) ,POINTER :: LBUF
88 my_real :: evar(6,mvsiz)
89C=======================================================================
90 CALL my_alloc(wa,6*nbf)
91 DO j=1,18
92 r4(j) = zero
93 ENDDO
94 nn1 = 1
95 nn2 = 1
96 nn3 = nn2 + numels
97 nn4 = nn3 + isph3d*(numsph+maxpjet)
98C-----------------------------------------------
99 DO ng=1,ngroup
100 gbuf => elbuf_tab(ng)%GBUF
101 istrain = iparg(44,ng)
102 isolnod = iparg(28,ng)
103 ivisc = iparg(61,ng)
104 CALL initbuf(iparg ,ng ,
105 2 mlw ,nel ,nft ,iad ,ity ,
106 3 npt ,jale ,ismstr ,jeul ,jtur ,
107 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
108 5 nvaux ,jpor ,kcvt ,jclose ,jplasol ,
109 6 irep ,iint ,igtyp ,israt ,isrot ,
110 7 icsen ,isorth ,isorthg ,ifailure,jsms )
111
112 DO i=1,6
113 jj(i) = nel*(i-1)
114 ENDDO
115
116 IF(mlw /= 13) THEN
117 lft=1
118 llt=nel
119C-----------------------------------------------
120C SOLID 8N
121C-----------------------------------------------
122 IF (ity == 1) THEN
123 tshell = 0
124 ior_tsh = 0
125 IF (igtyp==20 .OR. igtyp==21 .OR. igtyp==22) tshell = 1
126 IF (igtyp == 21.OR.igtyp == 22) ior_tsh = 1
127 nlay = elbuf_tab(ng)%NLAY
128 nptr = elbuf_tab(ng)%NPTR
129 npts = elbuf_tab(ng)%NPTS
130 nptt = elbuf_tab(ng)%NPTT
131 nptg = nptt*npts*nptr
132 npt = nptg*nlay
133 pid=ixs(10,1 + nft)
134 mt1=ixs(1,1 + nft)
135
136 IF (kcvt==1.AND.isorth/=0) kcvt=2
137 nuvar = ipm(8,mt1)
138 IF (igtyp /= 22) THEN
139 IF (isorth > 0) isorthg = 0
140 END IF
141 IF(mlw==0)THEN
142 DO i=lft,llt
143 n = i + nft
144 tens(1,el2fa(nn2+n)) = zero
145 tens(2,el2fa(nn2+n)) = zero
146 tens(3,el2fa(nn2+n)) = zero
147 tens(4,el2fa(nn2+n)) = zero
148 tens(5,el2fa(nn2+n)) = zero
149 tens(6,el2fa(nn2+n)) = zero
150 ENDDO
151 cycle !next NG
152 END IF
153 evar(1:6,lft:llt)=zero
154 IF (itens == 1) THEN
155C-----------------------------------------------
156C STRESS
157C-----------------------------------------------
158 DO i=lft,llt
159 n = i + nft
160 evar(1,i) = gbuf%SIG(jj(1) + i)
161 evar(2,i) = gbuf%SIG(jj(2) + i)
162 evar(3,i) = gbuf%SIG(jj(3) + i)
163 evar(4,i) = gbuf%SIG(jj(4) + i)
164 evar(5,i) = gbuf%SIG(jj(5) + i)
165 evar(6,i) = gbuf%SIG(jj(6) + i)
166 ENDDO
167 IF(ivisc > 0) THEN
168 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
169 DO i=lft,llt
170 evar(1,i) =evar(1,i)+ lbuf%VISC(jj(1) + i)
171 evar(2,i) =evar(2,i)+ lbuf%VISC(jj(2) + i)
172 evar(3,i) =evar(3,i)+ lbuf%VISC(jj(3) + i)
173 evar(4,i) =evar(4,i)+ lbuf%VISC(jj(4) + i)
174 evar(5,i) =evar(5,i)+ lbuf%VISC(jj(5) + i)
175 evar(6,i) =evar(6,i)+ lbuf%VISC(jj(6) + i)
176 ENDDO
177 ENDIF
178
179 IF( nfilsol /= 0 .AND. gbuf%G_FILL /= 0 ) THEN
180 DO i=lft,llt
181 evar(1,i) = evar(1,i) * gbuf%FILL(i)
182 evar(2,i) = evar(2,i) * gbuf%FILL(i)
183 evar(3,i) = evar(3,i) * gbuf%FILL(i)
184 evar(4,i) = evar(4,i) * gbuf%FILL(i)
185 evar(5,i) = evar(5,i) * gbuf%FILL(i)
186 evar(6,i) = evar(6,i) * gbuf%FILL(i)
187 ENDDO
188 ENDIF
189
190 IF (jhbe == 17 .AND. iint ==3) THEN !KCVT == 2 .AND.
191! STRESS TENSOR IN GLOBAL SYSTEM
192 DO i=lft,llt
193 n = i + nft
194 IF(el2fa(nn2+n) /= 0)THEN
195! JHBE=14, mean values in corotational frame
196 IF(kcvt==2.AND.jhbe/=14.AND.jhbe/=15)THEN
197 gama(1)=gbuf%GAMA(jj(1) + i)
198 gama(2)=gbuf%GAMA(jj(2) + i)
199 gama(3)=gbuf%GAMA(jj(3) + i)
200 gama(4)=gbuf%GAMA(jj(4) + i)
201 gama(5)=gbuf%GAMA(jj(5) + i)
202 gama(6)=gbuf%GAMA(jj(6) + i)
203 ELSE
204 gama(1)=one
205 gama(2)=zero
206 gama(3)=zero
207 gama(4)=zero
208 gama(5)=one
209 gama(6)=zero
210 END IF
211 CALL srota6_s8s( kcvt, evar(1,i), gama, jhbe,
212 2 igtyp, gbuf%COR_FR(9*(i-1)+1),iint, isorth)
213 ENDIF
214 ENDDO
215 ELSE IF (kcvt /= 0 .AND. jhbe /= 16) THEN
216! STRESS TENSOR IN GLOBAL SYSTEM
217 DO i=lft,llt
218 n = i + nft
219 IF(el2fa(nn2+n) /= 0)THEN
220! JHBE=14, mean values in corotational frame
221 IF(kcvt==2.AND.jhbe/=14.AND.jhbe/=15)THEN
222 gama(1)=gbuf%GAMA(jj(1) + i)
223 gama(2)=gbuf%GAMA(jj(2) + i)
224 gama(3)=gbuf%GAMA(jj(3) + i)
225 gama(4)=gbuf%GAMA(jj(4) + i)
226 gama(5)=gbuf%GAMA(jj(5) + i)
227 gama(6)=gbuf%GAMA(jj(6) + i)
228 ELSE
229 gama(1)=one
230 gama(2)=zero
231 gama(3)=zero
232 gama(4)=zero
233 gama(5)=one
234 gama(6)=zero
235 END IF
236 CALL srota6(x, ixs(1,n), kcvt, evar(1,i),gama, jhbe, igtyp, isorth)
237 ENDIF
238 ENDDO
239 ENDIF
240C
241 ELSEIF (itens == 2)THEN
242C-----------------------------------------------
243C STRAIN
244C-----------------------------------------------
245!-----------missed :IF (IGTYP == 22) -> cycle first IL=1,NLAY and GAMA<- LBUF%GAMA inside
246 IF (isolnod == 8 .AND. igtyp == 43) THEN
247 DO i=lft,llt
248 DO ipt= 1,nptr
249 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ipt,1,1)
250 evar(3,i) = evar(3,i) + lbuf%EPE(jj(1) + i)/npt
251 evar(2,i) = evar(2,i) + lbuf%EPE(jj(2) + i)/npt
252 evar(1,i) = evar(1,i) + lbuf%EPE(jj(3) + i)/npt
253 ENDDO
254 ENDDO
255 DO i=lft,llt
256 n = i + nft
257 IF(el2fa(nn2+n) /= 0)THEN
258 CALL srota6(x, ixs(1,n), kcvt, evar(1,i), gama, jhbe, igtyp, isorth)
259 ENDIF
260 ENDDO
261c-----------
262 ELSEIF (isolnod == 8 .AND. npt == 8 .AND. jhbe /= 14 .AND. jhbe /= 24 .AND. jhbe /= 15 .AND. jhbe /= 17 )THEN
263 nvaux =iparg(18,ng)
264 IF (mlw>=28) THEN
265 DO i=lft,llt
266 n = i + nft
267 DO j=1,8
268 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,j)
269 evar(1,i) = evar(1,i) + lbuf%STRA(jj(1) + i)*one_over_8
270 evar(2,i) = evar(2,i) + lbuf%STRA(jj(2) + i)*one_over_8
271 evar(3,i) = evar(3,i) + lbuf%STRA(jj(3) + i)*one_over_8
272 evar(4,i) = evar(4,i) + lbuf%STRA(jj(4) + i)*one_over_8
273 evar(5,i) = evar(5,i) + lbuf%STRA(jj(5) + i)*one_over_8
274 evar(6,i) = evar(6,i) + lbuf%STRA(jj(6) + i)*one_over_8
275 ENDDO
276 ENDDO
277 ENDIF
278c-----------
279 ELSEIF ((isolnod==8 .OR. (isolnod == 4 .AND. isrot==0)) .AND. npt==1 .AND. jhbe /= 14 .AND. jhbe /= 15) THEN
280 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
281 IF (isorth > 0) isorthg = 1
282 IF (mlw>=28.AND.mlw /= 49) THEN
283 DO i=lft,llt
284 n = i + nft
285 evar(1,i) = lbuf%STRA(jj(1) + i)
286 evar(2,i) = lbuf%STRA(jj(2) + i)
287 evar(3,i) = lbuf%STRA(jj(3) + i)
288 evar(4,i) = lbuf%STRA(jj(4) + i)*half
289 evar(5,i) = lbuf%STRA(jj(5) + i)*half
290 evar(6,i) = lbuf%STRA(jj(6) + i)*half
291 ENDDO
292 IF (isorth > 0) kcvt = 2
293 ELSEIF (mlw == 12 .OR. mlw == 14)THEN
294 DO i=lft,llt
295 n = i + nft
296 evar(1,i) = evar(1,i) + lbuf%EPE(jj(1) + i)
297 evar(2,i) = evar(2,i) + lbuf%EPE(jj(2) + i)
298 evar(3,i) = evar(3,i) + lbuf%EPE(jj(3) + i)
299 ENDDO
300 IF (isorth > 0) kcvt = 2
301 ELSEIF (mlw == 24 .OR. mlw == 25)THEN
302 DO i=lft,llt
303 n = i + nft
304 evar(1,i) = lbuf%STRA(jj(1) + i)
305 evar(2,i) = lbuf%STRA(jj(2) + i)
306 evar(3,i) = lbuf%STRA(jj(3) + i)
307 evar(4,i) = lbuf%STRA(jj(4) + i)*half
308 evar(5,i) = lbuf%STRA(jj(5) + i)*half
309 evar(6,i) = lbuf%STRA(jj(6) + i)*half
310 ENDDO
311 IF (isorth > 0) kcvt = 2
312 ELSEIF (istrain > 0) THEN
313 IF (mlw /= 14 .AND. mlw /= 24 .AND. mlw<28 .OR. mlw == 49) THEN
314 DO i=lft,llt
315 n = i + nft
316 evar(1,i) = lbuf%STRA(jj(1) + i)
317 evar(2,i) = lbuf%STRA(jj(2) + i)
318 evar(3,i) = lbuf%STRA(jj(3) + i)
319 evar(4,i) = lbuf%STRA(jj(4) + i)*half
320 evar(5,i) = lbuf%STRA(jj(5) + i)*half
321 evar(6,i) = lbuf%STRA(jj(6) + i)*half
322 ENDDO
323 ELSE
324 DO i=lft,llt
325 evar(1,i) = zero
326 evar(2,i) = zero
327 evar(3,i) = zero
328 evar(4,i) = zero
329 evar(5,i) = zero
330 evar(6,i) = zero
331 ENDDO
332 ENDIF
333 ENDIF
334 IF (kcvt /= 0) THEN
335! STRAIN TENSOR IN GLOBAL SYSTEM
336 DO i=lft,llt
337 n = i + nft
338 IF(el2fa(nn2+n) /= 0)THEN
339 IF(kcvt==2)THEN
340 gama(1)=gbuf%GAMA(jj(1) + i)
341 gama(2)=gbuf%GAMA(jj(2) + i)
342 gama(3)=gbuf%GAMA(jj(3) + i)
343 gama(4)=gbuf%GAMA(jj(4) + i)
344 gama(5)=gbuf%GAMA(jj(5) + i)
345 gama(6)=gbuf%GAMA(jj(6) + i)
346 ELSE
347 gama(1)=one
348 gama(2)=zero
349 gama(3)=zero
350 gama(4)=zero
351 gama(5)=one
352 gama(6)=zero
353 END IF
354 CALL srota6(x, ixs(1,n), kcvt, evar(1,i),gama, jhbe, igtyp, isorth)
355 ENDIF
356 ENDDO
357 ENDIF
358c-----------
359 ELSEIF(isolnod == 16 .OR. isolnod == 20 .OR. (isolnod == 8 .AND. (jhbe == 14 .OR. jhbe == 17)))THEN
360c-----------
361 IF (mlw>=28.AND.mlw /= 49)THEN
362 DO i=lft,llt
363 n = i + nft
364 DO il=1,nlay
365 DO is=1,npts
366 DO it=1,nptt
367 DO ir=1,nptr
368 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
369 evar(1,i) = evar(1,i) + lbuf%STRA(jj(1) + i)/npt
370 evar(2,i) = evar(2,i) + lbuf%STRA(jj(2) + i)/npt
371 evar(3,i) = evar(3,i) + lbuf%STRA(jj(3) + i)/npt
372 evar(4,i) = evar(4,i) + lbuf%STRA(jj(4) + i)*half/npt
373 evar(5,i) = evar(5,i) + lbuf%STRA(jj(5) + i)*half/npt
374 evar(6,i) = evar(6,i) + lbuf%STRA(jj(6) + i)*half/npt
375 ENDDO
376 ENDDO
377 ENDDO
378 ENDDO
379 ENDDO
380 ELSEIF (mlw == 12 .OR. mlw == 14) THEN
381 DO i=lft,llt
382 n = i + nft
383 DO il=1,nlay
384 DO is=1,npts
385 DO it=1,nptt
386 DO ir=1,nptr
387 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
388 evar(1,i) = evar(1,i) + lbuf%EPE(jj(1) + i)/npt
389 evar(2,i) = evar(2,i) + lbuf%EPE(jj(2) + i)/npt
390 evar(3,i) = evar(3,i) + lbuf%EPE(jj(3) + i)/npt
391 ENDDO
392 ENDDO
393 ENDDO
394 ENDDO
395 ENDDO
396 ELSEIF(mlw == 24 .OR. mlw == 25)THEN
397 DO i=lft,llt
398 n = i + nft
399 DO il=1,nlay
400 DO is=1,npts
401 DO it=1,nptt
402 DO ir=1,nptr
403 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
404 IF (elbuf_tab(ng)%BUFLY(il)%L_STRA > 0) THEN
405 evar_tmp(1) = lbuf%STRA(jj(1) + i)/npt
406 evar_tmp(2) = lbuf%STRA(jj(2) + i)/npt
407 evar_tmp(3) = lbuf%STRA(jj(3) + i)/npt
408 evar_tmp(4) = lbuf%STRA(jj(4) + i)*half/npt
409 evar_tmp(5) = lbuf%STRA(jj(5) + i)*half/npt
410 evar_tmp(6) = lbuf%STRA(jj(6) + i)*half/npt
411 icsig=iparg(17,ng)
412 IF (kcvt /= 0 .AND.icsig > 0) THEN
413 IF (igtyp == 21) THEN
414! STRAIN TENSOR IN GLOBAL SYSTEM
415 IF (jhbe == 14) THEN
416 SELECT CASE (icsig)
417 CASE (1)
418 IF(el2fa(nn2+n) /= 0)THEN
419 IF(kcvt==2)THEN
420 gama(1)= zero
421 gama(2)= gbuf%GAMA(jj(1) + i)
422 gama(3)= gbuf%GAMA(jj(2) + i)
423 gama(4)= zero
424 gama(5)=-gama(2)
425 gama(6)= gama(1)
426 ELSE
427 gama(1)=one
428 gama(2)=zero
429 gama(3)=zero
430 gama(4)=zero
431 gama(5)=one
432 gama(6)=zero
433 END IF
434 CALL srota6(x, ixs(1,n),kcvt, evar_tmp,gama, jhbe, igtyp, isorth)
435 ENDIF
436 CASE (10)
437 IF(el2fa(nn2+n) /= 0)THEN
438 IF(kcvt==2)THEN
439 gama(1)= gbuf%GAMA(jj(1) + i)
440 gama(2)= gbuf%GAMA(jj(2) + i)
441 gama(3)= zero
442 gama(4)=-gama(2)
443 gama(5)= gama(1)
444 gama(6)= zero
445 ELSE
446 gama(1)=one
447 gama(2)=zero
448 gama(3)=zero
449 gama(4)=zero
450 gama(5)=one
451 gama(6)=zero
452 END IF
453 CALL srota6(x, ixs(1,n),kcvt, evar_tmp,gama, jhbe, igtyp, isorth)
454 ENDIF
455 CASE (100)
456 IF(el2fa(nn2+n) /= 0)THEN
457 IF(kcvt==2)THEN
458 gama(1)= gbuf%GAMA(jj(2) + i)
459 gama(2)= zero
460 gama(3)= gbuf%GAMA(jj(1) + i)
461 gama(4)= gama(3)
462 gama(5)= zero
463 gama(6)=-gama(1)
464 ELSE
465 gama(1)=one
466 gama(2)=zero
467 gama(3)=zero
468 gama(4)=zero
469 gama(5)=one
470 gama(6)=zero
471 END IF
472 CALL srota6(x, ixs(1,n),kcvt, evar_tmp,gama, jhbe, igtyp, isorth)
473 ENDIF
474 END SELECT
475 ENDIF
476 ELSE
477C STRAIN TENSOR IN GLOBAL SYSTEM
478 IF (jhbe == 14) THEN
479 SELECT CASE (icsig)
480 CASE (1)
481 IF(el2fa(nn2+n) /= 0)THEN
482 IF(kcvt==2)THEN
483 gama(1)= zero
484 gama(2)= lbuf%GAMA(jj(1) + i)
485 gama(3)= lbuf%GAMA(jj(2) + i)
486 gama(4)= zero
487 gama(5)=-gama(2)
488 gama(6)= gama(1)
489 ELSE
490 gama(1)=one
491 gama(2)=zero
492 gama(3)=zero
493 gama(4)=zero
494 gama(5)=one
495 gama(6)=zero
496 END IF
497 CALL srota6(x, ixs(1,n),kcvt, evar_tmp,gama, jhbe, igtyp, isorth)
498 ENDIF
499 CASE (10)
500 IF(el2fa(nn2+n) /= 0)THEN
501 IF(kcvt==2)THEN
502 gama(1)= lbuf%GAMA(jj(1) + i)
503 gama(2)= lbuf%GAMA(jj(2) + i)
504 gama(3)= zero
505 gama(4)=-gama(2)
506 gama(5)= gama(1)
507 gama(6)= zero
508 ELSE
509 gama(1)=one
510 gama(2)=zero
511 gama(3)=zero
512 gama(4)=zero
513 gama(5)=one
514 gama(6)=zero
515 END IF
516 CALL srota6(x, ixs(1,n),kcvt, evar_tmp,gama, jhbe, igtyp, isorth)
517 ENDIF
518 CASE (100)
519 IF(el2fa(nn2+n) /= 0)THEN
520 IF(kcvt==2)THEN
521 gama(1)= lbuf%GAMA(jj(2) + i)
522 gama(2)= zero
523 gama(3)= lbuf%GAMA(jj(1) + i)
524 gama(4)= gama(3)
525 gama(5)= zero
526 gama(6)=-gama(1)
527 ELSE
528 gama(1)=one
529 gama(2)=zero
530 gama(3)=zero
531 gama(4)=zero
532 gama(5)=one
533 gama(6)=zero
534 END IF
535 CALL srota6(x, ixs(1,n),kcvt, evar_tmp,gama, jhbe, igtyp, isorth)
536 ENDIF
537 END SELECT
538 ENDIF
539 ENDIF
540 ENDIF
541 evar(1,i) = evar(1,i)+evar_tmp(1)
542 evar(2,i) = evar(2,i)+evar_tmp(2)
543 evar(3,i) = evar(3,i)+evar_tmp(3)
544 evar(4,i) = evar(4,i)+evar_tmp(4)
545 evar(5,i) = evar(5,i)+evar_tmp(5)
546 evar(6,i) = evar(6,i)+evar_tmp(6)
547 ENDIF
548 ENDDO
549 ENDDO
550 ENDDO
551 ENDDO
552 ENDDO
553 ELSEIF(istrain > 0)THEN
554 IF (mlw /= 14.AND.mlw /= 24.AND.mlw<28)THEN
555 DO i=lft,llt
556 n = i + nft
557 DO il=1,nlay
558 DO is=1,npts
559 DO it=1,nptt
560 DO ir=1,nptr
561 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
562 evar_tmp(1) = lbuf%STRA(jj(1) + i)/npt
563 evar_tmp(2) = lbuf%STRA(jj(2) + i)/npt
564 evar_tmp(3) = lbuf%STRA(jj(3) + i)/npt
565 evar_tmp(4) = lbuf%STRA(jj(4) + i)*half/npt
566 evar_tmp(5) = lbuf%STRA(jj(5) + i)*half/npt
567 evar_tmp(6) = lbuf%STRA(jj(6) + i)*half/npt
568 icsig=iparg(17,ng)
569 IF (kcvt /= 0 .AND.icsig > 0) THEN
570! STRAIN TENSOR IN GLOBAL SYSTEM
571 IF (jhbe == 14) THEN
572 SELECT CASE (icsig)
573 CASE (1)
574 IF(el2fa(nn2+n) /= 0)THEN
575 IF(kcvt==2)THEN
576 gama(1)= zero
577 gama(2)= lbuf%GAMA(jj(1) + i)
578 gama(3)= lbuf%GAMA(jj(2) + i)
579 gama(4)= zero
580 gama(5)=-gama(2)
581 gama(6)= gama(1)
582 ELSE
583 gama(1)=one
584 gama(2)=zero
585 gama(3)=zero
586 gama(4)=zero
587 gama(5)=one
588 gama(6)=zero
589 END IF
590 CALL srota6(x, ixs(1,n),kcvt, evar_tmp,gama, jhbe, igtyp, isorth)
591 ENDIF
592 CASE (10)
593 IF(el2fa(nn2+n) /= 0)THEN
594 IF(kcvt==2)THEN
595 gama(1)= lbuf%GAMA(jj(1) + i)
596 gama(2)= lbuf%GAMA(jj(2) + i)
597 gama(3)= zero
598 gama(4)=-gama(2)
599 gama(5)= gama(1)
600 gama(6)= zero
601 ELSE
602 gama(1)=one
603 gama(2)=zero
604 gama(3)=zero
605 gama(4)=zero
606 gama(5)=one
607 gama(6)=zero
608 END IF
609 CALL srota6(x, ixs(1,n),kcvt, evar_tmp,gama, jhbe, igtyp, isorth)
610 ENDIF
611 CASE (100)
612 IF(el2fa(nn2+n) /= 0)THEN
613 IF(kcvt==2)THEN
614 gama(1)= lbuf%GAMA(jj(2) + i)
615 gama(2)= zero
616 gama(3)= lbuf%GAMA(jj(1) + i)
617 gama(4)= gama(3)
618 gama(5)= zero
619 gama(6)=-gama(1)
620 ELSE
621 gama(1)=one
622 gama(2)=zero
623 gama(3)=zero
624 gama(4)=zero
625 gama(5)=one
626 gama(6)=zero
627 END IF
628 CALL srota6(x, ixs(1,n),kcvt, evar_tmp,gama, jhbe, igtyp, isorth)
629 ENDIF
630 END SELECT
631 ENDIF
632 ENDIF
633 evar(1,i) = evar(1,i)+evar_tmp(1)
634 evar(2,i) = evar(2,i)+evar_tmp(2)
635 evar(3,i) = evar(3,i)+evar_tmp(3)
636 evar(4,i) = evar(4,i)+evar_tmp(4)
637 evar(5,i) = evar(5,i)+evar_tmp(5)
638 evar(6,i) = evar(6,i)+evar_tmp(6)
639 ENDDO
640 ENDDO
641 ENDDO
642 ENDDO
643 ENDDO
644 ELSE
645 DO i=lft,llt
646 evar(1,i) = zero
647 evar(2,i) = zero
648 evar(3,i) = zero
649 evar(4,i) = zero
650 evar(5,i) = zero
651 evar(6,i) = zero
652 ENDDO
653 ENDIF
654 ENDIF
655 icsig=iparg(17,ng)
656 IF (jhbe == 17) THEN
657 IF (mlw == 12 .OR. mlw == 14 .OR. mlw == 24 .OR. mlw == 25 .OR. (mlw >= 28 .AND. mlw /= 49)) THEN
658 IF (isorth > 0) kcvt = 2
659 ENDIF
660 ENDIF
661 IF (kcvt /= 0 .AND.icsig == 0 .AND. jhbe /= 16) THEN
662! STRAIN TENSOR IN GLOBAL SYSTEM
663 DO i=lft,llt
664 n = i + nft
665 IF(el2fa(nn2+n) /= 0)THEN
666 IF(kcvt==2)THEN
667 gama(1)=gbuf%GAMA(jj(1) + i)
668 gama(2)=gbuf%GAMA(jj(2) + i)
669 gama(3)=gbuf%GAMA(jj(3) + i)
670 gama(4)=gbuf%GAMA(jj(4) + i)
671 gama(5)=gbuf%GAMA(jj(5) + i)
672 gama(6)=gbuf%GAMA(jj(6) + i)
673 ELSE
674 gama(1)=one
675 gama(2)=zero
676 gama(3)=zero
677 gama(4)=zero
678 gama(5)=one
679 gama(6)=zero
680 END IF
681 CALL srota6(x, ixs(1,n), kcvt, evar(1,i),gama, jhbe, igtyp, isorth)
682 ENDIF
683 ENDDO
684 ENDIF
685c-----------
686 ELSEIF (isolnod==10 .OR. (isolnod==4 .AND. isrot==1)) THEN
687c-----------
688 IF (mlw>=28.AND.mlw /= 49)THEN
689 DO i=lft,llt
690 n = i + nft
691 DO ipt=1,npt
692 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ipt,1,1)
693 evar(1,i) = evar(1,i)+lbuf%STRA(jj(1) + i)/npt
694 evar(2,i) = evar(2,i)+lbuf%STRA(jj(2) + i)/npt
695 evar(3,i) = evar(3,i)+lbuf%STRA(jj(3) + i)/npt
696 evar(4,i) = evar(4,i)+lbuf%STRA(jj(4) + i)*half/npt
697 evar(5,i) = evar(5,i)+lbuf%STRA(jj(5) + i)*half/npt
698 evar(6,i) = evar(6,i)+lbuf%STRA(jj(6) + i)*half/npt
699 ENDDO
700 ENDDO
701 ELSEIF(mlw == 12 .OR. mlw == 14)THEN
702 DO i=lft,llt
703 n = i + nft
704 DO ipt=1,npt
705 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ipt,1,1)
706 evar(1,i) = evar(1,i) + lbuf%EPE(jj(1) + i)/npt
707 evar(2,i) = evar(2,i) + lbuf%EPE(jj(2) + i)/npt
708 evar(3,i) = evar(3,i) + lbuf%EPE(jj(3) + i)/npt
709 ENDDO
710 ENDDO
711 ELSEIF ((mlw == 24 .OR. mlw == 25) .and. istrain > 0) THEN
712 DO i=lft,llt
713 n = i + nft
714 DO ipt=1,npt
715 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ipt,1,1)
716 evar(1,i) = evar(1,i)+lbuf%STRA(jj(1) + i)/npt
717 evar(2,i) = evar(2,i)+lbuf%STRA(jj(2) + i)/npt
718 evar(3,i) = evar(3,i)+lbuf%STRA(jj(3) + i)/npt
719 evar(4,i) = evar(4,i)+lbuf%STRA(jj(4) + i)*half/npt
720 evar(5,i) = evar(5,i)+lbuf%STRA(jj(5) + i)*half/npt
721 evar(6,i) = evar(6,i)+lbuf%STRA(jj(6) + i)*half/npt
722 ENDDO
723 ENDDO
724 ELSEIF(istrain > 0)THEN
725 IF (mlw /= 14.AND.mlw /= 24.AND.mlw<28) THEN
726 DO i=lft,llt
727 n = i + nft
728 DO ipt=1,npt
729 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ipt,1,1)
730 evar(1,i) = evar(1,i)+lbuf%STRA(jj(1) + i)/npt
731 evar(2,i) = evar(2,i)+lbuf%STRA(jj(2) + i)/npt
732 evar(3,i) = evar(3,i)+lbuf%STRA(jj(3) + i)/npt
733 evar(4,i) = evar(4,i)+lbuf%STRA(jj(4) + i)*half/npt
734 evar(5,i) = evar(5,i)+lbuf%STRA(jj(5) + i)*half/npt
735 evar(6,i) = evar(6,i)+lbuf%STRA(jj(6) + i)*half/npt
736 ENDDO
737 ENDDO
738 ELSE
739 DO i=lft,llt
740 evar(1,i) = zero
741 evar(2,i) = zero
742 evar(3,i) = zero
743 evar(4,i) = zero
744 evar(5,i) = zero
745 evar(6,i) = zero
746 ENDDO
747 ENDIF
748 ENDIF
749 IF (kcvt /= 0) THEN
750! STRAIN TENSOR IN GLOBAL SYSTEM
751 DO i=lft,llt
752 n = i + nft
753 IF (el2fa(nn2+n) /= 0) THEN
754 IF (kcvt==2) THEN
755 gama(1)=gbuf%GAMA(jj(1) + i)
756 gama(2)=gbuf%GAMA(jj(2) + i)
757 gama(3)=gbuf%GAMA(jj(3) + i)
758 gama(4)=gbuf%GAMA(jj(4) + i)
759 gama(5)=gbuf%GAMA(jj(5) + i)
760 gama(6)=gbuf%GAMA(jj(6) + i)
761 ELSE
762 gama(1)=one
763 gama(2)=zero
764 gama(3)=zero
765 gama(4)=zero
766 gama(5)=one
767 gama(6)=zero
768 ENDIF
769 CALL srota6(x, ixs(1,n), kcvt, evar(1,i), gama, jhbe, igtyp, isorth)
770 ENDIF
771 ENDDO
772 ENDIF
773c-----------
774 ELSEIF(((isolnod == 6.OR.isolnod == 8).AND.jhbe == 15) .OR. ((isolnod == 6).AND.jhbe == 24))THEN
775c-----------
776 IF (mlw>=28.AND.mlw /= 49.AND.istrain > 0) THEN
777 DO i=lft,llt
778 n = i + nft
779 DO il= 1,nlay
780 DO ipt=1,nptg
781 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ipt,1,1)
782 evar(1,i) = evar(1,i)+lbuf%STRA(jj(1) + i)/(nptg*nlay)
783 evar(2,i) = evar(2,i)+lbuf%STRA(jj(2) + i)/(nptg*nlay)
784 evar(3,i) = evar(3,i)+lbuf%STRA(jj(3) + i)/(nptg*nlay)
785 evar(4,i) = evar(4,i)+lbuf%STRA(jj(4) + i)*half/(nptg*nlay)
786 evar(5,i) = evar(5,i)+lbuf%STRA(jj(5) + i)*half/(nptg*nlay)
787 evar(6,i) = evar(6,i)+lbuf%STRA(jj(6) + i)*half/(nptg*nlay)
788 ENDDO
789 ENDDO
790 ENDDO
791 ELSEIF(mlw == 12 .OR. mlw == 14)THEN
792 DO i=lft,llt
793 DO il= 1,nlay
794 DO ipt=1,nptg
795 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ipt,1,1)
796 evar(1,i) = evar(1,i) + lbuf%EPE(jj(1) + i)/(nptg*nlay)
797 evar(2,i) = evar(2,i) + lbuf%EPE(jj(2) + i)/(nptg*nlay)
798 evar(3,i) = evar(3,i) + lbuf%EPE(jj(3) + i)/(nptg*nlay)
799 ENDDO
800 ENDDO
801 ENDDO
802 ELSEIF ((mlw == 24 .OR. mlw == 25) .and. istrain > 0)THEN
803 DO i=lft,llt
804 n = i + nft
805 DO il= 1,nlay
806 DO ipt=1,nptg
807 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ipt,1,1)
808 evar(1,i) = evar(1,i)+lbuf%STRA(jj(1) + i)/(nptg*nlay)
809 evar(2,i) = evar(2,i)+lbuf%STRA(jj(2) + i)/(nptg*nlay)
810 evar(3,i) = evar(3,i)+lbuf%STRA(jj(3) + i)/(nptg*nlay)
811 evar(4,i) = evar(4,i)+lbuf%STRA(jj(4) + i)*half/(nptg*nlay)
812 evar(5,i) = evar(5,i)+lbuf%STRA(jj(5) + i)*half/(nptg*nlay)
813 evar(6,i) = evar(6,i)+lbuf%STRA(jj(6) + i)*half/(nptg*nlay)
814 ENDDO
815 ENDDO
816 ENDDO
817 ELSEIF (istrain > 0) THEN
818 IF(mlw /= 14.AND.mlw /= 24.AND.mlw<28) THEN
819 DO i=lft,llt
820 n = i + nft
821 DO il= 1,nlay
822 DO ipt=1,nptg
823 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ipt,1,1)
824 evar(1,i) = evar(1,i)+lbuf%STRA(jj(1) + i)/(nptg*nlay)
825 evar(2,i) = evar(2,i)+lbuf%STRA(jj(2) + i)/(nptg*nlay)
826 evar(3,i) = evar(3,i)+lbuf%STRA(jj(3) + i)/(nptg*nlay)
827 evar(4,i) = evar(4,i)+lbuf%STRA(jj(4) + i)*half/(nptg*nlay)
828 evar(5,i) = evar(5,i)+lbuf%STRA(jj(5) + i)*half/(nptg*nlay)
829 evar(6,i) = evar(6,i)+lbuf%STRA(jj(6) + i)*half/(nptg*nlay)
830 ENDDO
831 ENDDO
832 ENDDO
833 ELSE
834 DO i=lft,llt
835 evar(1,i) = zero
836 evar(2,i) = zero
837 evar(3,i) = zero
838 evar(4,i) = zero
839 evar(5,i) = zero
840 evar(6,i) = zero
841 ENDDO
842 ENDIF
843 ENDIF
844 IF (kcvt /= 0) THEN
845! STRAIN TENSOR IN GLOBAL SYSTEM
846 DO i=lft,llt
847 n = i + nft
848 IF (el2fa(nn2+n) /= 0) THEN
849 IF (kcvt==2)THEN
850 gama(1)= gbuf%GAMA(jj(1) + i)
851 gama(2)= gbuf%GAMA(jj(2) + i)
852 gama(3)= zero
853 gama(4)=-gama(2)
854 gama(5)= gama(1)
855 gama(6)= zero
856 ELSE
857 gama(1)=one
858 gama(2)=zero
859 gama(3)=zero
860 gama(4)=zero
861 gama(5)=one
862 gama(6)=zero
863 END IF
864 CALL srota6(x, ixs(1,n), kcvt, evar(1,i),gama, jhbe, igtyp, isorth)
865 ENDIF
866 ENDDO
867 ENDIF
868c-----------
869 ENDIF ! ISOLNOD & ......
870C-----------------------------------------------
871C CRACKS
872C-----------------------------------------------
873 ELSEIF (itens == 4 .AND. mlw == 24 .AND. nint(pm(56,mt1)) == 1) THEN
874c-----------
875 DO i=lft,llt
876 evar(1,i) = zero
877 evar(2,i) = zero
878 evar(3,i) = zero
879 evar(4,i) = zero
880 evar(5,i) = zero
881 evar(6,i) = zero
882 ENDDO
883
884 IF (isolnod == 8 .AND.(jhbe == 14 .OR. jhbe == 15)) THEN
885
886 ELSE
887 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
888 DO i=lft,llt
889 evar(1,i) = evar(1,i)+lbuf%DGLO(jj(1) + i)
890 evar(2,i) = evar(2,i)+lbuf%DGLO(jj(2) + i)
891 evar(3,i) = evar(3,i)+lbuf%DGLO(jj(3) + i)
892 evar(4,i) = evar(4,i)+lbuf%DGLO(jj(4) + i)
893 evar(5,i) = evar(5,i)+lbuf%DGLO(jj(5) + i)
894 evar(6,i) = evar(6,i)+lbuf%DGLO(jj(6) + i)
895 ENDDO
896 ENDIF
897 IF (kcvt /= 0) THEN
898! DAMAGE IN GLOBAL SYSTEM
899 DO i=lft,llt
900 n = i + nft
901 IF(el2fa(nn2+n) /= 0)THEN
902 IF (kcvt==2) THEN
903 gama(1)= gbuf%GAMA(jj(1) + i)
904 gama(2)= gbuf%GAMA(jj(2) + i)
905 gama(3)= zero
906 gama(4)=-gama(2)
907 gama(5)= gama(1)
908 gama(6)= zero
909 ELSE
910 gama(1)=one
911 gama(2)=zero
912 gama(3)=zero
913 gama(4)=zero
914 gama(5)=one
915 gama(6)=zero
916 END IF
917 CALL srota6(x, ixs(1,n), kcvt, evar(1,i),gama, jhbe, igtyp, isorth)
918 ENDIF
919 ENDDO
920 ENDIF
921!
922 ELSEIF (itens == 5) THEN
923C-----------------------------------------------
924C - START - FULL PLASTIC STRAIN TENSOR (MEAN)
925C-----------------------------------------------
926 DO i=lft,llt
927 evar(1,i) = zero
928 evar(2,i) = zero
929 evar(3,i) = zero
930 evar(4,i) = zero
931 evar(5,i) = zero
932 evar(6,i) = zero
933 ENDDO
934c-----------
935 IF ((isolnod == 8 .OR. (isolnod == 4 .AND. isrot == 0)) .AND. npt == 1 .AND. jhbe /= 14 .AND. jhbe /= 15) THEN
936c-----------
937 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
938 IF (isorth > 0) isorthg = 1
939 IF (mlw == 24) THEN
940 DO i=lft,llt
941 n = i + nft
942 evar(1,i) = lbuf%PLA(jj(1) + i + nel)
943 evar(2,i) = lbuf%PLA(jj(2) + i + nel)
944 evar(3,i) = lbuf%PLA(jj(3) + i + nel)
945 evar(4,i) = lbuf%PLA(jj(4) + i + nel)*half
946 evar(5,i) = lbuf%PLA(jj(5) + i + nel)*half
947 evar(6,i) = lbuf%PLA(jj(6) + i + nel)*half
948 ENDDO
949 ENDIF ! IF (MLW == 24)
950!
951 IF (kcvt /= 0) THEN
952! PLASTIC STRAIN TENSOR IN GLOBAL SYSTEM
953 DO i=lft,llt
954 n = i + nft
955 IF (el2fa(nn2+n) /= 0) THEN
956 IF (kcvt == 2) THEN
957 gama(1) = gbuf%GAMA(jj(1) + i)
958 gama(2) = gbuf%GAMA(jj(2) + i)
959 gama(3) = gbuf%GAMA(jj(3) + i)
960 gama(4) = gbuf%GAMA(jj(4) + i)
961 gama(5) = gbuf%GAMA(jj(5) + i)
962 gama(6) = gbuf%GAMA(jj(6) + i)
963 ELSE
964 gama(1) = one
965 gama(2) = zero
966 gama(3) = zero
967 gama(4) = zero
968 gama(5) = one
969 gama(6) = zero
970 ENDIF ! IF (KCVT == 2)
971 CALL srota6(x, ixs(1,n), kcvt, evar(1,i),gama, jhbe, igtyp, isorth)
972 ENDIF ! IF (EL2FA(NN2+N) /= 0)
973 ENDDO ! DO I=LFT,LLT
974 ENDIF ! IF (KCVT /= 0)
975c-----------
976 ELSEIF (isolnod == 16 .OR. isolnod == 20 .OR. (isolnod == 8 .AND. (jhbe == 14 .OR. jhbe == 17))) THEN
977c-----------
978 IF (mlw == 24) THEN
979 DO i=lft,llt
980 n = i + nft
981 DO il=1,nlay
982 DO is=1,npts
983 DO it=1,nptt
984 DO ir=1,nptr
985 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
986 IF (elbuf_tab(ng)%BUFLY(il)%L_PLA > 0) THEN
987!
988 evar_tmp(1) = lbuf%PLA(jj(1) + i + nel)/npt
989 evar_tmp(2) = lbuf%PLA(jj(2) + i + nel)/npt
990 evar_tmp(3) = lbuf%PLA(jj(3) + i + nel)/npt
991 evar_tmp(4) = lbuf%PLA(jj(4) + i + nel)*half/npt
992 evar_tmp(5) = lbuf%PLA(jj(5) + i + nel)*half/npt
993 evar_tmp(6) = lbuf%PLA(jj(6) + i + nel)*half/npt
994!
995 icsig=iparg(17,ng)
996 IF (kcvt /= 0 .AND.icsig > 0) THEN
997 IF (igtyp == 21) THEN
998! PLASTIC STRAIN TENSOR IN GLOBAL SYSTEM
999 IF (jhbe == 14) THEN
1000 SELECT CASE (icsig)
1001 CASE (1)
1002 IF (el2fa(nn2+n) /= 0) THEN
1003 IF (kcvt == 2) THEN
1004 gama(1) = zero
1005 gama(2) = gbuf%GAMA(jj(1) + i)
1006 gama(3) = gbuf%GAMA(jj(2) + i)
1007 gama(4) = zero
1008 gama(5) =-gama(2)
1009 gama(6) = gama(1)
1010 ELSE
1011 gama(1) = one
1012 gama(2) = zero
1013 gama(3) = zero
1014 gama(4) = zero
1015 gama(5) = one
1016 gama(6) = zero
1017 ENDIF ! IF (KCVT == 2)
1018 CALL srota6(x, ixs(1,n),kcvt, evar_tmp,gama, jhbe, igtyp, isorth)
1019 ENDIF ! IF (EL2FA(NN2+N) /= 0)
1020 CASE (10)
1021 IF (el2fa(nn2+n) /= 0) THEN
1022 IF (kcvt == 2) THEN
1023 gama(1) = gbuf%GAMA(jj(1) + i)
1024 gama(2) = gbuf%GAMA(jj(2) + i)
1025 gama(3) = zero
1026 gama(4) =-gama(2)
1027 gama(5) = gama(1)
1028 gama(6) = zero
1029 ELSE
1030 gama(1) = one
1031 gama(2) = zero
1032 gama(3) = zero
1033 gama(4) = zero
1034 gama(5) = one
1035 gama(6) = zero
1036 ENDIF ! IF (KCVT == 2)
1037 CALL srota6(x, ixs(1,n),kcvt, evar_tmp,gama, jhbe, igtyp, isorth)
1038 ENDIF ! IF (EL2FA(NN2+N) /= 0)
1039 CASE (100)
1040 IF (el2fa(nn2+n) /= 0) THEN
1041 IF (kcvt == 2) THEN
1042 gama(1) = gbuf%GAMA(jj(2) + i)
1043 gama(2) = zero
1044 gama(3) = gbuf%GAMA(jj(1) + i)
1045 gama(4) = gama(3)
1046 gama(5) = zero
1047 gama(6) =-gama(1)
1048 ELSE
1049 gama(1) = one
1050 gama(2) = zero
1051 gama(3) = zero
1052 gama(4) = zero
1053 gama(5) = one
1054 gama(6) = zero
1055 ENDIF ! IF (KCVT == 2)
1056 CALL srota6(x, ixs(1,n),kcvt, evar_tmp,gama, jhbe, igtyp, isorth)
1057 ENDIF ! IF (EL2FA(NN2+N) /= 0)
1058 END SELECT
1059 ENDIF ! IF (JHBE == 14)
1060 ELSE
1061! PLASTIC STRAIN TENSOR IN GLOBAL SYSTEM
1062 IF (jhbe == 14) THEN
1063 SELECT CASE (icsig)
1064 CASE (1)
1065 IF (el2fa(nn2+n) /= 0) THEN
1066 IF (kcvt == 2) THEN
1067 gama(1) = zero
1068 gama(2) = lbuf%GAMA(jj(1) + i)
1069 gama(3) = lbuf%GAMA(jj(2) + i)
1070 gama(4) = zero
1071 gama(5) =-gama(2)
1072 gama(6) = gama(1)
1073 ELSE
1074 gama(1) = one
1075 gama(2) = zero
1076 gama(3) = zero
1077 gama(4) = zero
1078 gama(5) = one
1079 gama(6) = zero
1080 ENDIF ! IF (KCVT == 2)
1081 CALL srota6(x, ixs(1,n),kcvt, evar_tmp,gama, jhbe, igtyp, isorth)
1082 ENDIF ! IF (EL2FA(NN2+N) /= 0)
1083 CASE (10)
1084 IF (el2fa(nn2+n) /= 0) THEN
1085 IF (kcvt == 2) THEN
1086 gama(1) = lbuf%GAMA(jj(1) + i)
1087 gama(2) = lbuf%GAMA(jj(2) + i)
1088 gama(3) = zero
1089 gama(4) =-gama(2)
1090 gama(5) = gama(1)
1091 gama(6) = zero
1092 ELSE
1093 gama(1) = one
1094 gama(2) = zero
1095 gama(3) = zero
1096 gama(4) = zero
1097 gama(5) = one
1098 gama(6) = zero
1099 ENDIF ! IF (KCVT == 2)
1100 CALL srota6(x, ixs(1,n),kcvt, evar_tmp, gama, jhbe, igtyp, isorth)
1101 ENDIF ! IF (EL2FA(NN2+N) /= 0)
1102 CASE (100)
1103 IF (el2fa(nn2+n) /= 0) THEN
1104 IF (kcvt == 2) THEN
1105 gama(1) = lbuf%GAMA(jj(2) + i)
1106 gama(2) = zero
1107 gama(3) = lbuf%GAMA(jj(1) + i)
1108 gama(4) = gama(3)
1109 gama(5) = zero
1110 gama(6) =-gama(1)
1111 ELSE
1112 gama(1) = one
1113 gama(2) = zero
1114 gama(3) = zero
1115 gama(4) = zero
1116 gama(5) = one
1117 gama(6) = zero
1118 ENDIF ! IF (KCVT == 2)
1119 CALL srota6(x, ixs(1,n),kcvt, evar_tmp,gama, jhbe, igtyp, isorth)
1120 ENDIF ! IF (EL2FA(NN2+N) /= 0)
1121 END SELECT
1122 ENDIF ! IF (JHBE == 14)
1123 ENDIF ! IF (IGTYP == 21)
1124 ENDIF ! IF (KCVT /= 0 .AND.ICSIG > 0)
1125 evar(1,i) = evar(1,i)+evar_tmp(1)
1126 evar(2,i) = evar(2,i)+evar_tmp(2)
1127 evar(3,i) = evar(3,i)+evar_tmp(3)
1128 evar(4,i) = evar(4,i)+evar_tmp(4)
1129 evar(5,i) = evar(5,i)+evar_tmp(5)
1130 evar(6,i) = evar(6,i)+evar_tmp(6)
1131 ENDIF ! IF (ELBUF_TAB(NG)%BUFLY(IL)%L_PLA > 0)
1132 ENDDO ! DO IR=1,NPTR
1133 ENDDO ! DO IT=1,NPTT
1134 ENDDO ! DO IS=1,NPTS
1135 ENDDO ! DO IL=1,NLAY
1136 ENDDO ! DO I=LFT,LLT
1137 ENDIF ! IF (MLW == 24)
1138
1139 icsig = iparg(17,ng)
1140 IF (kcvt /= 0 .AND. icsig == 0 .AND. jhbe /= 16) THEN
1141! PLASTIC STRAIN TENSOR IN GLOBAL SYSTEM
1142 DO i=lft,llt
1143 n = i + nft
1144 IF (el2fa(nn2+n) /= 0) THEN
1145 IF (kcvt == 2) THEN
1146 gama(1) = gbuf%GAMA(jj(1) + i)
1147 gama(2) = gbuf%GAMA(jj(2) + i)
1148 gama(3) = gbuf%GAMA(jj(3) + i)
1149 gama(4) = gbuf%GAMA(jj(4) + i)
1150 gama(5) = gbuf%GAMA(jj(5) + i)
1151 gama(6) = gbuf%GAMA(jj(6) + i)
1152 ELSE
1153 gama(1) = one
1154 gama(2) = zero
1155 gama(3) = zero
1156 gama(4) = zero
1157 gama(5) = one
1158 gama(6) = zero
1159 ENDIF !IF (KCVT == 2)
1160 CALL srota6(x, ixs(1,n), kcvt, evar(1,i), gama, jhbe, igtyp, isorth)
1161 ENDIF ! IF (EL2FA(NN2+N) /= 0)
1162 ENDDO ! DO I=LFT,LLT
1163 ENDIF ! IF (KCVT /= 0 .AND. ICSIG == 0 .AND. JHBE /= 16)
1164c-----------
1165 ELSEIF (isolnod == 10 .OR. (isolnod == 4 .AND. isrot == 1)) THEN
1166c-----------
1167 IF (mlw == 24 .AND. istrain > 0) THEN
1168 DO i=lft,llt
1169 n = i + nft
1170 DO ipt=1,npt
1171 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ipt,1,1)
1172 evar(1,i) = evar(1,i) + lbuf%PLA(jj(1) + i + nel)/npt
1173 evar(2,i) = evar(2,i) + lbuf%PLA(jj(2) + i + nel)/npt
1174 evar(3,i) = evar(3,i) + lbuf%PLA(jj(3) + i + nel)/npt
1175 evar(4,i) = evar(4,i) + lbuf%PLA(jj(4) + i + nel)*half/npt
1176 evar(5,i) = evar(5,i) + lbuf%PLA(jj(5) + i + nel)*half/npt
1177 evar(6,i) = evar(6,i) + lbuf%PLA(jj(6) + i + nel)*half/npt
1178 ENDDO
1179 ENDDO ! DO I=LFT,LLT
1180 ENDIF ! IF ((MLW == 24 .AND. ISTRAIN > 0)
1181!
1182 IF (kcvt /= 0) THEN
1183! PALSTIC STRAIN TENSOR IN GLOBAL SYSTEM
1184 DO i=lft,llt
1185 n = i + nft
1186 IF (el2fa(nn2+n) /= 0) THEN
1187 IF (kcvt == 2) THEN
1188 gama(1) = gbuf%GAMA(jj(1) + i)
1189 gama(2) = gbuf%GAMA(jj(2) + i)
1190 gama(3) = gbuf%GAMA(jj(3) + i)
1191 gama(4) = gbuf%GAMA(jj(4) + i)
1192 gama(5) = gbuf%GAMA(jj(5) + i)
1193 gama(6) = gbuf%GAMA(jj(6) + i)
1194 ELSE
1195 gama(1) = one
1196 gama(2) = zero
1197 gama(3) = zero
1198 gama(4) = zero
1199 gama(5) = one
1200 gama(6) = zero
1201 ENDIF ! IF (KCVT == 2)
1202 CALL srota6(x, ixs(1,n), kcvt, evar(1,i), gama, jhbe, igtyp, isorth)
1203 ENDIF ! IF (EL2FA(NN2+N) /= 0)
1204 ENDDO ! DO I=LFT,LLT
1205 ENDIF ! IF (KCVT /= 0)
1206c-----------
1207 ELSEIF (((isolnod == 6.OR.isolnod == 8).AND.jhbe == 15) .OR. ((isolnod == 6).AND.jhbe == 24)) THEN
1208c-----------
1209 IF (mlw == 24 .AND. istrain > 0) THEN
1210 DO i=lft,llt
1211 n = i + nft
1212 DO il= 1,nlay
1213 DO ipt=1,nptg
1214 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ipt,1,1)
1215 evar(1,i) = evar(1,i)+lbuf%PLA(jj(1) + i + nel)/(nptg*nlay)
1216 evar(2,i) = evar(2,i)+lbuf%PLA(jj(2) + i + nel)/(nptg*nlay)
1217 evar(3,i) = evar(3,i)+lbuf%PLA(jj(3) + i + nel)/(nptg*nlay)
1218 evar(4,i) = evar(4,i)+lbuf%PLA(jj(4) + i + nel)*half/(nptg*nlay)
1219 evar(5,i) = evar(5,i)+lbuf%PLA(jj(5) + i + nel)*half/(nptg*nlay)
1220 evar(6,i) = evar(6,i)+lbuf%PLA(jj(6) + i + nel)*half/(nptg*nlay)
1221 ENDDO
1222 ENDDO
1223 ENDDO
1224 ENDIF ! IF (MLW == 24 .AND. ISTRAIN > 0)
1225
1226 IF (kcvt /= 0) THEN
1227! PLASTIC STRAIN TENSOR IN GLOBAL SYSTEM
1228 DO i=lft,llt
1229 n = i + nft
1230 IF (el2fa(nn2+n) /= 0) THEN
1231 IF (kcvt == 2) THEN
1232 gama(1) = gbuf%GAMA(jj(1) + i)
1233 gama(2) = gbuf%GAMA(jj(2) + i)
1234 gama(3) = zero
1235 gama(4) =-gama(2)
1236 gama(5) = gama(1)
1237 gama(6) = zero
1238 ELSE
1239 gama(1) = one
1240 gama(2) = zero
1241 gama(3) = zero
1242 gama(4) = zero
1243 gama(5) = one
1244 gama(6) = zero
1245 ENDIF ! IF (KCVT == 2)
1246 CALL srota6(x, ixs(1,n), kcvt, evar(1,i), gama, jhbe, igtyp, isorth)
1247 ENDIF ! IF (EL2FA(NN2+N) /= 0)
1248 ENDDO ! DO I=LFT,LLT
1249 ENDIF ! IF (KCVT /= 0)
1250
1251 ENDIF ! ISOLNOD & ......
1252!-----------------------------------------------
1253! - END OF - FULL PLASTIC STRAIN TENSOR (MEAN)
1254!-----------------------------------------------
1255! STRESS / integration point
1256!-----------------------------------------------
1257 ELSEIF (itens>=10.AND.itens<=1009)THEN
1258 pti = itens - 10
1259
1260 IF (isolnod == 8 .AND. igtyp == 43) THEN
1261
1262 IF(ivisc == 0) THEN
1263 DO i=lft,llt
1264 DO ipt= 1,nptr
1265 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ipt,1,1)
1266 evar(3,i) = evar(3,i) + lbuf%SIG(jj(3) + i)/nptr
1267 evar(2,i) = evar(2,i) + lbuf%SIG(jj(5) + i)/nptr
1268 evar(1,i) = evar(1,i) + lbuf%SIG(jj(6) + i)/nptr
1269 ENDDO
1270 ENDDO
1271 ELSE
1272 DO i=lft,llt
1273 DO ipt= 1,nptr
1274 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ipt,1,1)
1275 evar(3,i)= evar(3,i)+ lbuf%SIG(jj(3) + i)/nptr+ lbuf%VISC(jj(3) + i)/nptr
1276 evar(2,i)= evar(2,i)+ lbuf%SIG(jj(5) + i)/nptr+ lbuf%VISC(jj(5) + i)/nptr
1277 evar(1,i)= evar(1,i)+ lbuf%SIG(jj(6) + i)/nptr+ lbuf%VISC(jj(6) + i)/nptr
1278 ENDDO
1279 ENDDO
1280 ENDIF
1281 DO i=lft,llt
1282 n = i + nft
1283 IF(el2fa(nn2+n) /= 0)THEN
1284 CALL srota6(x, ixs(1,n), kcvt, evar(1,i), gama, jhbe, igtyp, isorth)
1285 ENDIF
1286 ENDDO
1287c-----------
1288 ELSEIF (isolnod == 8 .AND. npt == 8.AND. jhbe /= 14 .AND. jhbe /= 24 .AND. jhbe /= 15) THEN
1289c-----------
1290 ir = abs(pti)/100
1291 is = mod(abs(pti)/10,10)
1292 it = mod(abs(pti),10)
1293 IF (ir == 0 .AND. it == 0)THEN
1294
1295 ELSEIF(ir <= nptr .AND. is <= npts .AND. it <= nptt)THEN
1296 ipt = ir + ( (is-1) + (it-1)*npts )*nptr
1297 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ir,is,it)
1298 IF (ipt <= 8 )THEN
1299 DO i=lft,llt
1300 evar(1,i) = lbuf%SIG(jj(1) + i)
1301 evar(2,i) = lbuf%SIG(jj(2) + i)
1302 evar(3,i) = lbuf%SIG(jj(3) + i)
1303 evar(4,i) = lbuf%SIG(jj(4) + i)
1304 evar(5,i) = lbuf%SIG(jj(5) + i)
1305 evar(6,i) = lbuf%SIG(jj(6) + i)
1306 ENDDO
1307 IF(ivisc > 0) THEN
1308 DO i=lft,llt
1309 evar(1,i) =evar(1,i)+lbuf%VISC(jj(1) + i)
1310 evar(2,i) =evar(2,i)+lbuf%VISC(jj(2) + i)
1311 evar(3,i) =evar(3,i)+lbuf%VISC(jj(3) + i)
1312 evar(4,i) =evar(4,i)+lbuf%VISC(jj(4) + i)
1313 evar(5,i) =evar(5,i)+lbuf%VISC(jj(5) + i)
1314 evar(6,i) =evar(6,i)+lbuf%VISC(jj(6) + i)
1315 ENDDO
1316 ENDIF
1317 ENDIF
1318 IF (kcvt /= 0) THEN
1319! STRESS TENSOR IN GLOBAL SYSTEM
1320 DO i=lft,llt
1321 n = i + nft
1322 IF(el2fa(nn2+n) /= 0)THEN
1323 IF(kcvt==2)THEN
1324 gama(1)= gbuf%GAMA(jj(1) + i)
1325 gama(2)= gbuf%GAMA(jj(2) + i)
1326 gama(3)= gbuf%GAMA(jj(3) + i)
1327 gama(4)= gbuf%GAMA(jj(4) + i)
1328 gama(5)= gbuf%GAMA(jj(5) + i)
1329 gama(6)= gbuf%GAMA(jj(6) + i)
1330 ELSE
1331 gama(1)=one
1332 gama(2)=zero
1333 gama(3)=zero
1334 gama(4)=zero
1335 gama(5)=one
1336 gama(6)=zero
1337 END IF
1338 CALL srota6(x, ixs(1,n), kcvt, evar(1,i), gama, jhbe, igtyp, isorth)
1339 ENDIF
1340 ENDDO
1341 ENDIF
1342 ELSE
1343 DO i=lft,llt
1344 evar(1,i) = zero
1345 evar(2,i) = zero
1346 evar(3,i) = zero
1347 evar(4,i) = zero
1348 evar(5,i) = zero
1349 evar(6,i) = zero
1350 ENDDO
1351 ENDIF
1352c-----------
1353 ELSEIF((isolnod == 8.OR.npt == 1) .AND. jhbe /= 14.AND.jhbe /= 15.AND.jhbe /= 17)THEN
1354c-----------
1355 nptr= one
1356 npts= one
1357 nptt= one
1358 ir = abs(pti)/100
1359 is = mod(abs(pti)/10,10)
1360 it = mod(abs(pti),10)
1361 IF (ir == 0 .AND. it == 0)THEN
1362 ELSE
1363 ipt = ir + ( (is-1) + (it-1)*npts )*nptr
1364 IF (ipt == 1 )THEN
1365 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
1366 DO i=lft,llt
1367 evar(1,i) = lbuf%SIG(jj(1) + i)
1368 evar(2,i) = lbuf%SIG(jj(2) + i)
1369 evar(3,i) = lbuf%SIG(jj(3) + i)
1370 evar(4,i) = lbuf%SIG(jj(4) + i)
1371 evar(5,i) = lbuf%SIG(jj(5) + i)
1372 evar(6,i) = lbuf%SIG(jj(6) + i)
1373 ENDDO
1374 IF(ivisc > 0) THEN
1375 DO i=lft,llt
1376 evar(1,i) =evar(1,i)+lbuf%VISC(jj(1) + i)
1377 evar(2,i) =evar(2,i)+lbuf%VISC(jj(2) + i)
1378 evar(3,i) =evar(3,i)+lbuf%VISC(jj(3) + i)
1379 evar(4,i) =evar(4,i)+lbuf%VISC(jj(4) + i)
1380 evar(5,i) =evar(5,i)+lbuf%VISC(jj(5) + i)
1381 evar(6,i) =evar(6,i)+lbuf%VISC(jj(6) + i)
1382 ENDDO
1383 ENDIF
1384 ENDIF
1385 IF (kcvt /= 0) THEN
1386! STRESS TENSOR IN GLOBAL SYSTEM
1387 DO i=lft,llt
1388 n = i + nft
1389 IF(el2fa(nn2+n) /= 0)THEN
1390 IF(kcvt==2)THEN
1391 gama(1)=gbuf%GAMA(jj(1) + i)
1392 gama(2)=gbuf%GAMA(jj(2) + i)
1393 gama(3)=gbuf%GAMA(jj(3) + i)
1394 gama(4)=gbuf%GAMA(jj(4) + i)
1395 gama(5)=gbuf%GAMA(jj(5) + i)
1396 gama(6)=gbuf%GAMA(jj(6) + i)
1397 ELSE
1398 gama(1)=one
1399 gama(2)=zero
1400 gama(3)=zero
1401 gama(4)=zero
1402 gama(5)=one
1403 gama(6)=zero
1404 END IF
1405 CALL srota6(x, ixs(1,n), kcvt, evar(1,i), gama, jhbe, igtyp, isorth)
1406 ENDIF
1407 ENDDO
1408 ENDIF
1409 ENDIF
1410c-----------
1411 ELSEIF (isolnod == 20 .OR. isolnod == 16 ) THEN
1412c-----------
1413 ir=abs(pti)/100
1414 is=mod(abs(pti)/10,10)
1415 it=mod(abs(pti),10)
1416 IF (ir == 0 .OR. is == 0.OR. it == 0) cycle
1417 IF (tshell == 1 .AND. is <= nlay ) THEN
1418 lbuf => elbuf_tab(ng)%BUFLY(is)%LBUF(ir,1,it)
1419 iok = 1
1420 ELSEIF(ir <= nptr .AND. is <= npts .AND. it <= nptt) THEN
1421 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ir,is,it)
1422 iok = 1
1423 ENDIF
1424 ipt = ir + ( (is-1) + (it-1)*npts )*nptr
1425 IF (iok==1) THEN
1426 DO i=lft,llt
1427 evar(1,i) = lbuf%SIG(jj(1) + i)
1428 evar(2,i) = lbuf%SIG(jj(2) + i)
1429 evar(3,i) = lbuf%SIG(jj(3) + i)
1430 evar(4,i) = lbuf%SIG(jj(4) + i)
1431 evar(5,i) = lbuf%SIG(jj(5) + i)
1432 evar(6,i) = lbuf%SIG(jj(6) + i)
1433 ENDDO
1434 IF(ivisc > 0) THEN
1435 DO i=lft,llt
1436 evar(1,i) =evar(1,i)+lbuf%VISC(jj(1) + i)
1437 evar(2,i) =evar(2,i)+lbuf%VISC(jj(2) + i)
1438 evar(3,i) =evar(3,i)+lbuf%VISC(jj(3) + i)
1439 evar(4,i) =evar(4,i)+lbuf%VISC(jj(4) + i)
1440 evar(5,i) =evar(5,i)+lbuf%VISC(jj(5) + i)
1441 evar(6,i) =evar(6,i)+lbuf%VISC(jj(6) + i)
1442 ENDDO
1443 ENDIF
1444 ENDIF
1445 IF (kcvt /= 0 .AND. jhbe /= 16) THEN
1446! STRESS TENSOR IN GLOBAL SYSTEM
1447 DO i=lft,llt
1448 n = i + nft
1449 IF(el2fa(nn2+n) /= 0)THEN
1450 IF(kcvt==2)THEN
1451 gama(1)=gbuf%GAMA(jj(1) + i)
1452 gama(2)=gbuf%GAMA(jj(2) + i)
1453 gama(3)=gbuf%GAMA(jj(3) + i)
1454 gama(4)=gbuf%GAMA(jj(4) + i)
1455 gama(5)=gbuf%GAMA(jj(5) + i)
1456 gama(6)=gbuf%GAMA(jj(6) + i)
1457 ELSE
1458 gama(1)=one
1459 gama(2)=zero
1460 gama(3)=zero
1461 gama(4)=zero
1462 gama(5)=one
1463 gama(6)=zero
1464 END IF
1465 CALL srota6(x, ixs(1,n), kcvt, evar(1,i), gama, jhbe, igtyp, isorth)
1466 ENDIF
1467 ENDDO
1468 ENDIF
1469
1470 ELSEIF (isolnod == 8 .AND. jhbe == 14 )THEN
1471
1472 icsig = iparg(17,ng)
1473 nptg = nptr * npts * nptt * nlay
1474 ir0=abs(pti)/100
1475 is0=mod(abs(pti)/10,10)
1476 it0=mod(abs(pti),10)
1477 ipid = ixs(10,1 + nft)
1478 IF (ir0==0.OR.is0==0.OR.it0==0) cycle
1479 ir = ir0
1480 is = is0
1481 it = it0
1482 IF (tshell == 1) THEN
1483 IF (icsig==100) THEN
1484 ir = is0
1485 is = it0
1486 it = ir0
1487 ELSEIF (icsig==10) THEN
1488 ir = it0
1489 is = ir0
1490 it = is0
1491 ELSE
1492 ir = ir0
1493 is = is0
1494 it = it0
1495 END IF
1496 ENDIF
1497
1498 ipt = ir + ( (is-1) + (it-1)*npts )*nptr
1499 iok = 0
1500 IF (tshell == 1 .AND. it <= nlay ) THEN
1501 lbuf => elbuf_tab(ng)%BUFLY(it)%LBUF(ir,is,1)
1502 iok = 1
1503 ELSEIF(ir0 <= nptr .AND. is0 <= npts .AND. it0 <= nptt) THEN
1504 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ir,is,it)
1505 iok = 1
1506 ENDIF
1507 IF ( iok == 1) THEN
1508 DO i=lft,llt
1509 evar(1,i) = lbuf%SIG(jj(1) + i)
1510 evar(2,i) = lbuf%SIG(jj(2) + i)
1511 evar(3,i) = lbuf%SIG(jj(3) + i)
1512 evar(4,i) = lbuf%SIG(jj(4) + i)
1513 evar(5,i) = lbuf%SIG(jj(5) + i)
1514 evar(6,i) = lbuf%SIG(jj(6) + i)
1515 ENDDO
1516 IF(ivisc > 0) THEN
1517 DO i=lft,llt
1518 evar(1,i) =evar(1,i)+lbuf%VISC(jj(1) + i)
1519 evar(2,i) =evar(2,i)+lbuf%VISC(jj(2) + i)
1520 evar(3,i) =evar(3,i)+lbuf%VISC(jj(3) + i)
1521 evar(4,i) =evar(4,i)+lbuf%VISC(jj(4) + i)
1522 evar(5,i) =evar(5,i)+lbuf%VISC(jj(5) + i)
1523 evar(6,i) =evar(6,i)+lbuf%VISC(jj(6) + i)
1524 ENDDO
1525 ENDIF
1526 ENDIF
1527 IF (kcvt /= 0) THEN
1528! STRESS TENSOR IN GLOBAL SYSTEM
1529!--------------thick shells----only pid21,irep=0--works--------
1530 IF (icsig >0) THEN
1531 IF (igtyp == 21) THEN
1532 SELECT CASE (icsig)
1533 CASE (1)
1534 DO i=lft,llt
1535 n = i + nft
1536 IF(el2fa(nn2+n) /= 0)THEN
1537 IF(kcvt==2)THEN
1538 gama(1)=zero
1539 gama(2)=gbuf%GAMA(jj(1) + i)
1540 gama(3)=gbuf%GAMA(jj(2) + i)
1541 gama(4)=zero
1542 gama(5)=-gama(2)
1543 gama(6)=gama(1)
1544 ELSE
1545 gama(1)=one
1546 gama(2)=zero
1547 gama(3)=zero
1548 gama(4)=zero
1549 gama(5)=one
1550 gama(6)=zero
1551 END IF
1552 CALL srota6(x, ixs(1,n), kcvt, evar(1,i), gama, jhbe, igtyp, isorth)
1553 ENDIF
1554 ENDDO
1555 CASE (10)
1556 DO i=lft,llt
1557 n = i + nft
1558 IF(el2fa(nn2+n) /= 0)THEN
1559 IF(kcvt==2)THEN
1560 gama(1)=gbuf%GAMA(jj(1) + i)
1561 gama(2)=gbuf%GAMA(jj(2) + i)
1562 gama(3)=zero
1563 gama(4)=-gama(2)
1564 gama(5)=gama(1)
1565 gama(6)=zero
1566 ELSE
1567 gama(1)=one
1568 gama(2)=zero
1569 gama(3)=zero
1570 gama(4)=zero
1571 gama(5)=one
1572 gama(6)=zero
1573 END IF
1574 CALL srota6(x, ixs(1,n), kcvt, evar(1,i), gama, jhbe, igtyp, isorth)
1575 ENDIF
1576 ENDDO
1577 CASE (100)
1578 DO i=lft,llt
1579 n = i + nft
1580 IF(el2fa(nn2+n) /= 0)THEN
1581 IF(kcvt==2)THEN
1582 gama(1)=gbuf%GAMA(jj(2) + i)
1583 gama(2)=zero
1584 gama(3)=gbuf%GAMA(jj(1) + i)
1585 gama(4)=gama(3)
1586 gama(5)=zero
1587 gama(6)=-gama(1)
1588 ELSE
1589 gama(1)=one
1590 gama(2)=zero
1591 gama(3)=zero
1592 gama(4)=zero
1593 gama(5)=one
1594 gama(6)=zero
1595 END IF
1596 CALL srota6(x, ixs(1,n), kcvt, evar(1,i), gama, jhbe, igtyp, isorth)
1597 ENDIF
1598 ENDDO
1599 END SELECT
1600 ELSE
1601 SELECT CASE (icsig)
1602 CASE (1)
1603 DO i=lft,llt
1604 n = i + nft
1605 IF(el2fa(nn2+n) /= 0)THEN
1606 IF(kcvt==2)THEN
1607 gama(1)=zero
1608 gama(2)=lbuf%GAMA(jj(1) + i)
1609 gama(3)=lbuf%GAMA(jj(2) + i)
1610 gama(4)=zero
1611 gama(5)=-gama(2)
1612 gama(6)=gama(1)
1613 ELSE
1614 gama(1)=one
1615 gama(2)=zero
1616 gama(3)=zero
1617 gama(4)=zero
1618 gama(5)=one
1619 gama(6)=zero
1620 END IF
1621 CALL srota6(x, ixs(1,n), kcvt, evar(1,i), gama, jhbe, igtyp, isorth)
1622 ENDIF
1623 ENDDO
1624 CASE (10)
1625 DO i=lft,llt
1626 n = i + nft
1627 IF(el2fa(nn2+n) /= 0)THEN
1628 IF(kcvt==2)THEN
1629 gama(1)=lbuf%GAMA(jj(1) + i)
1630 gama(2)=lbuf%GAMA(jj(2) + i)
1631 gama(3)=zero
1632 gama(4)=-gama(2)
1633 gama(5)=gama(1)
1634 gama(6)=zero
1635 ELSE
1636 gama(1)=one
1637 gama(2)=zero
1638 gama(3)=zero
1639 gama(4)=zero
1640 gama(5)=one
1641 gama(6)=zero
1642 END IF
1643 CALL srota6(x, ixs(1,n), kcvt, evar(1,i), gama, jhbe, igtyp, isorth)
1644 ENDIF
1645 ENDDO
1646 CASE (100)
1647 DO i=lft,llt
1648 n = i + nft
1649 IF(el2fa(nn2+n) /= 0)THEN
1650 IF(kcvt==2)THEN
1651 gama(1)=lbuf%GAMA(jj(2) + i)
1652 gama(2)=zero
1653 gama(3)=lbuf%GAMA(jj(1) + i)
1654 gama(4)=gama(3)
1655 gama(5)=zero
1656 gama(6)=-gama(1)
1657 ELSE
1658 gama(1)=one
1659 gama(2)=zero
1660 gama(3)=zero
1661 gama(4)=zero
1662 gama(5)=one
1663 gama(6)=zero
1664 END IF
1665 CALL srota6(x, ixs(1,n), kcvt, evar(1,i), gama, jhbe, igtyp, isorth)
1666 ENDIF
1667 ENDDO
1668 END SELECT
1669 ENDIF
1670 ELSE
1671 DO i=lft,llt
1672 n = i + nft
1673 IF(el2fa(nn2+n) /= 0)THEN
1674 IF(kcvt==2)THEN
1675 gama(1)=gbuf%GAMA(jj(1) + i)
1676 gama(2)=gbuf%GAMA(jj(2) + i)
1677 gama(3)=gbuf%GAMA(jj(3) + i)
1678 gama(4)=gbuf%GAMA(jj(4) + i)
1679 gama(5)=gbuf%GAMA(jj(5) + i)
1680 gama(6)=gbuf%GAMA(jj(6) + i)
1681 ELSE
1682 gama(1)=one
1683 gama(2)=zero
1684 gama(3)=zero
1685 gama(4)=zero
1686 gama(5)=one
1687 gama(6)=zero
1688 END IF
1689 CALL srota6(x, ixs(1,n), kcvt, evar(1,i), gama, jhbe, igtyp, isorth)
1690 ENDIF
1691 ENDDO
1692 ENDIF !(ICSIG >0)
1693 ENDIF
1694
1695 ELSEIF(isolnod == 10.OR.(isolnod == 4 .AND. isrot == 1))THEN
1696
1697 ir=abs(pti)/100
1698 is=mod(abs(pti)/10,10)
1699 it=mod(abs(pti),10)
1700 IF (ir == 0 .AND. it == 0)THEN
1701 ELSE
1702 ipt = 0
1703 IF (ir == 1 .AND. is == 1 .AND. it == 1) ipt = 1
1704 IF (ir == 2 .AND. is == 1 .AND. it == 1) ipt = 2
1705 IF (ir == 1 .AND. is == 2 .AND. it == 1) ipt = 3
1706 IF (ir == 1 .AND. is == 1 .AND. it == 2) ipt = 4
1707 IF (ipt > 0) THEN
1708 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ipt,1,1)
1709 DO i=lft,llt
1710 evar(1,i) = lbuf%SIG(jj(1) + i)
1711 evar(2,i) = lbuf%SIG(jj(2) + i)
1712 evar(3,i) = lbuf%SIG(jj(3) + i)
1713 evar(4,i) = lbuf%SIG(jj(4) + i)
1714 evar(5,i) = lbuf%SIG(jj(5) + i)
1715 evar(6,i) = lbuf%SIG(jj(6) + i)
1716 ENDDO
1717 IF(ivisc > 0) THEN
1718 DO i=lft,llt
1719 evar(1,i) =evar(1,i)+lbuf%VISC(jj(1) + i)
1720 evar(2,i) =evar(2,i)+lbuf%VISC(jj(2) + i)
1721 evar(3,i) =evar(3,i)+lbuf%VISC(jj(3) + i)
1722 evar(4,i) =evar(4,i)+lbuf%VISC(jj(4) + i)
1723 evar(5,i) =evar(5,i)+lbuf%VISC(jj(5) + i)
1724 evar(6,i) =evar(6,i)+lbuf%VISC(jj(6) + i)
1725 ENDDO
1726 ENDIF
1727 ENDIF
1728 IF (kcvt /= 0) THEN
1729! STRESS TENSOR IN GLOBAL SYSTEM
1730 DO i=lft,llt
1731 n = i + nft
1732 IF(el2fa(nn2+n) /= 0)THEN
1733 IF(kcvt==2)THEN
1734 gama(1)=gbuf%GAMA(jj(1) + i)
1735 gama(2)=gbuf%GAMA(jj(2) + i)
1736 gama(3)=gbuf%GAMA(jj(3) + i)
1737 gama(4)=gbuf%GAMA(jj(4) + i)
1738 gama(5)=gbuf%GAMA(jj(5) + i)
1739 gama(6)=gbuf%GAMA(jj(6) + i)
1740 ELSE
1741 gama(1)=one
1742 gama(2)=zero
1743 gama(3)=zero
1744 gama(4)=zero
1745 gama(5)=one
1746 gama(6)=zero
1747 END IF
1748 CALL srota6(x, ixs(1,n), kcvt, evar(1,i), gama, jhbe, igtyp, isorth)
1749 ENDIF
1750 ENDDO
1751 ENDIF
1752 ENDIF
1753c-----------
1754 ELSEIF (((isolnod == 6.OR.isolnod == 8).AND.jhbe == 15) .OR. ((isolnod == 6).AND.jhbe == 24)) THEN
1755 ipt = mod(abs(pti)/10,10)
1756 IF ( ipt > 0 .AND. ipt<=nlay) THEN
1757
1758 lbuf => elbuf_tab(ng)%BUFLY(ipt)%LBUF(1,1,1)
1759 DO i=lft,llt
1760 evar(1,i) = lbuf%SIG(jj(1) + i)
1761 evar(2,i) = lbuf%SIG(jj(2) + i)
1762 evar(3,i) = lbuf%SIG(jj(3) + i)
1763 evar(4,i) = lbuf%SIG(jj(4) + i)
1764 evar(5,i) = lbuf%SIG(jj(5) + i)
1765 evar(6,i) = lbuf%SIG(jj(6) + i)
1766 ENDDO
1767 IF(ivisc > 0) THEN
1768 DO i=lft,llt
1769 evar(1,i) =evar(1,i)+lbuf%VISC(jj(1) + i)
1770 evar(2,i) =evar(2,i)+lbuf%VISC(jj(2) + i)
1771 evar(3,i) =evar(3,i)+lbuf%VISC(jj(3) + i)
1772 evar(4,i) =evar(4,i)+lbuf%VISC(jj(4) + i)
1773 evar(5,i) =evar(5,i)+lbuf%VISC(jj(5) + i)
1774 evar(6,i) =evar(6,i)+lbuf%VISC(jj(6) + i)
1775 ENDDO
1776 ENDIF
1777 IF (kcvt==2) THEN
1778! STRESS TENSOR IN GLOBAL SYSTEM
1779 DO i=lft,llt
1780 n = i + nft
1781 IF(el2fa(nn2+n) /= 0)THEN
1782 gama(1)= gbuf%GAMA(jj(1) + i)
1783 gama(2)= gbuf%GAMA(jj(2) + i)
1784 gama(3)= zero
1785 gama(4)=-gama(2)
1786 gama(5)= gama(1)
1787 gama(6)= zero
1788 CALL srota6(x, ixs(1,n), kcvt, evar(1,i), gama, jhbe, igtyp, isorth)
1789 ENDIF
1790 ENDDO
1791 ENDIF
1792 ENDIF
1793 ENDIF
1794
1795 IF( nfilsol /= 0 .AND. gbuf%G_FILL /= 0 ) THEN
1796 DO i=lft,llt
1797 evar(1,i) = evar(1,i) * gbuf%FILL(i)
1798 evar(2,i) = evar(2,i) * gbuf%FILL(i)
1799 evar(3,i) = evar(3,i) * gbuf%FILL(i)
1800 evar(4,i) = evar(4,i) * gbuf%FILL(i)
1801 evar(5,i) = evar(5,i) * gbuf%FILL(i)
1802 evar(6,i) = evar(6,i) * gbuf%FILL(i)
1803 ENDDO
1804 ENDIF
1805
1806! STRESS TENSOR / integration point more than 9 point in direction s
1807 ELSEIF(itens>=2010.AND.itens<=22109) THEN
1808!-------------- case NLAY>9
1809 pti = itens - 2010
1810 IF (((isolnod == 6.OR.isolnod == 8).AND.jhbe == 15) .OR. ((isolnod == 6).AND.jhbe == 24)) THEN
1811 ipt = mod(abs(pti)/10,201)
1812 IF ( ipt > 0 .AND. ipt<=nlay .AND.nlay>9) THEN
1813
1814 lbuf => elbuf_tab(ng)%BUFLY(ipt)%LBUF(1,1,1)
1815 DO i=lft,llt
1816 evar(1,i) = lbuf%SIG(jj(1) + i)
1817 evar(2,i) = lbuf%SIG(jj(2) + i)
1818 evar(3,i) = lbuf%SIG(jj(3) + i)
1819 evar(4,i) = lbuf%SIG(jj(4) + i)
1820 evar(5,i) = lbuf%SIG(jj(5) + i)
1821 evar(6,i) = lbuf%SIG(jj(6) + i)
1822 ENDDO
1823 IF(ivisc > 0) THEN
1824 DO i=lft,llt
1825 evar(1,i) =evar(1,i)+lbuf%VISC(jj(1) + i)
1826 evar(2,i) =evar(2,i)+lbuf%VISC(jj(2) + i)
1827 evar(3,i) =evar(3,i)+lbuf%VISC(jj(3) + i)
1828 evar(4,i) =evar(4,i)+lbuf%VISC(jj(4) + i)
1829 evar(5,i) =evar(5,i)+lbuf%VISC(jj(5) + i)
1830 evar(6,i) =evar(6,i)+lbuf%VISC(jj(6) + i)
1831 ENDDO
1832 ENDIF
1833 IF (kcvt==2) THEN
1834! STRESS TENSOR IN GLOBAL SYSTEM
1835 DO i=lft,llt
1836 n = i + nft
1837 IF(el2fa(nn2+n) /= 0)THEN
1838 gama(1)= lbuf%GAMA(jj(1) + i)
1839 gama(2)= lbuf%GAMA(jj(2) + i)
1840 gama(3)= zero
1841 gama(4)=-gama(2)
1842 gama(5)= gama(1)
1843 gama(6)= zero
1844 CALL srota6(x, ixs(1,n), kcvt, evar(1,i), gama, jhbe, igtyp, isorth)
1845 ENDIF
1846 ENDDO
1847 ENDIF
1848 ENDIF
1849c-----------
1850 ELSEIF (isolnod == 16.OR.(isolnod == 8 .AND.jhbe == 14)) THEN
1851c----------- ISOLNOD=16 is not available w/ TYPE22 but keep here however
1852 icsig = iparg(17,ng)
1853 ir0=abs(pti)/2010
1854 is0=mod(abs(pti)/10,201)
1855 it0=mod(abs(pti),10)
1856 IF (ir0==0.OR.is0==0.OR.it0==0.OR.nlay<10) cycle
1857 ir = ir0
1858 is = is0
1859 it = it0
1860 IF (tshell == 1) THEN
1861 IF (icsig==100) THEN
1862 ir = is0
1863 is = it0
1864 it = ir0
1865 ELSEIF (icsig==10) THEN
1866 ir = it0
1867 is = ir0
1868 it = is0
1869 ELSE
1870 ir = ir0
1871 is = is0
1872 it = it0
1873 END IF
1874 ENDIF
1875 IF (ir>nptr.OR.is>npts.OR.it>nlay) cycle
1876 ipt = ir + ( (is-1) + (it-1)*npts )*nptr
1877 IF ( ipt <= npt ) THEN
1878 IF (tshell == 1) THEN
1879 lbuf => elbuf_tab(ng)%BUFLY(it)%LBUF(ir,is,1)
1880 ELSE
1881 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ir,is,it)
1882 ENDIF
1883 DO i=lft,llt
1884 evar(1,i) = lbuf%SIG(jj(1) + i)
1885 evar(2,i) = lbuf%SIG(jj(2) + i)
1886 evar(3,i) = lbuf%SIG(jj(3) + i)
1887 evar(4,i) = lbuf%SIG(jj(4) + i)
1888 evar(5,i) = lbuf%SIG(jj(5) + i)
1889 evar(6,i) = lbuf%SIG(jj(6) + i)
1890 ENDDO
1891 IF(ivisc > 0) THEN
1892 DO i=lft,llt
1893 evar(1,i) =evar(1,i)+lbuf%VISC(jj(1) + i)
1894 evar(2,i) =evar(2,i)+lbuf%VISC(jj(2) + i)
1895 evar(3,i) =evar(3,i)+lbuf%VISC(jj(3) + i)
1896 evar(4,i) =evar(4,i)+lbuf%VISC(jj(4) + i)
1897 evar(5,i) =evar(5,i)+lbuf%VISC(jj(5) + i)
1898 evar(6,i) =evar(6,i)+lbuf%VISC(jj(6) + i)
1899 ENDDO
1900 ENDIF
1901 ENDIF
1902 IF (kcvt /= 0 .AND. jhbe /= 16) THEN
1903! STRESS TENSOR IN GLOBAL SYSTEM
1904!-------------- thick shells----only pid21,irep=0--works--------
1905 SELECT CASE (icsig)
1906 CASE (1)
1907 DO i=lft,llt
1908 n = i + nft
1909 IF(el2fa(nn2+n) /= 0)THEN
1910 IF(kcvt==2)THEN
1911 gama(1)=zero
1912 gama(2)=lbuf%GAMA(jj(1) + i)
1913 gama(3)=lbuf%GAMA(jj(2) + i)
1914 gama(4)=zero
1915 gama(5)=-gama(2)
1916 gama(6)=gama(1)
1917 ELSE
1918 gama(1)=one
1919 gama(2)=zero
1920 gama(3)=zero
1921 gama(4)=zero
1922 gama(5)=one
1923 gama(6)=zero
1924 END IF
1925 CALL srota6(x, ixs(1,n), kcvt, evar(1,i), gama, jhbe, igtyp, isorth)
1926 ENDIF
1927 ENDDO
1928 CASE (10)
1929 DO i=lft,llt
1930 n = i + nft
1931 IF(el2fa(nn2+n) /= 0)THEN
1932 IF(kcvt==2)THEN
1933 gama(1)=lbuf%GAMA(jj(1) + i)
1934 gama(2)=lbuf%GAMA(jj(2) + i)
1935 gama(3)=zero
1936 gama(4)=-gama(2)
1937 gama(5)=gama(1)
1938 gama(6)=zero
1939 ELSE
1940 gama(1)=one
1941 gama(2)=zero
1942 gama(3)=zero
1943 gama(4)=zero
1944 gama(5)=one
1945 gama(6)=zero
1946 END IF
1947 CALL srota6(x, ixs(1,n), kcvt, evar(1,i), gama, jhbe, igtyp, isorth)
1948 ENDIF
1949 ENDDO
1950 CASE (100)
1951 DO i=lft,llt
1952 n = i + nft
1953 IF(el2fa(nn2+n) /= 0)THEN
1954 IF(kcvt==2)THEN
1955 gama(1)=lbuf%GAMA(jj(2) + i)
1956 gama(2)=zero
1957 gama(3)=lbuf%GAMA(jj(1) + i)
1958 gama(4)=gama(3)
1959 gama(5)=zero
1960 gama(6)=-gama(1)
1961 ELSE
1962 gama(1)=one
1963 gama(2)=zero
1964 gama(3)=zero
1965 gama(4)=zero
1966 gama(5)=one
1967 gama(6)=zero
1968 END IF
1969 CALL srota6(x, ixs(1,n), kcvt, evar(1,i), gama, jhbe, igtyp, isorth)
1970 ENDIF
1971 ENDDO
1972 END SELECT
1973 END IF !(KCVT /= 0 .AND. JHBE /= 16) THEN
1974
1975 ENDIF ! ISOLNOD
1976
1977 IF( nfilsol /= 0 .AND. gbuf%G_FILL /= 0 ) THEN
1978 DO i=lft,llt
1979 evar(1,i) = evar(1,i) * gbuf%FILL(i)
1980 evar(2,i) = evar(2,i) * gbuf%FILL(i)
1981 evar(3,i) = evar(3,i) * gbuf%FILL(i)
1982 evar(4,i) = evar(4,i) * gbuf%FILL(i)
1983 evar(5,i) = evar(5,i) * gbuf%FILL(i)
1984 evar(6,i) = evar(6,i) * gbuf%FILL(i)
1985 ENDDO
1986 ENDIF
1987
1988! STRAIN / integration point
1989 ELSEIF (itens>=1010.AND.itens<=2009) THEN
1990C-----------------------------------------------
1991 pti = itens - 1010
1992 IF (isolnod == 8.AND.npt == 8 .AND. jhbe /= 14 .AND. jhbe /= 24 .AND. jhbe /= 15 .AND. jhbe /= 17) THEN
1993 ir=abs(pti)/100
1994 is=mod(abs(pti)/10,10)
1995 it=mod(abs(pti),10)
1996 ipt = ir + ( (is-1) + (it-1)*npts )*nptr
1997 IF (ipt <= 8) THEN
1998 IF(ir <= nptr .AND. is <= npts .AND. it <= nptt)THEN
1999 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ir,is,it)
2000 IF (mlw >= 28) THEN
2001 DO i=lft,llt
2002 evar(1,i) = evar(1,i) + lbuf%STRA(jj(1) + i)
2003 evar(2,i) = evar(2,i) + lbuf%STRA(jj(2) + i)
2004 evar(3,i) = evar(3,i) + lbuf%STRA(jj(3) + i)
2005 evar(4,i) = evar(4,i) + lbuf%STRA(jj(4) + i)
2006 evar(5,i) = evar(5,i) + lbuf%STRA(jj(5) + i)
2007 evar(6,i) = evar(6,i) + lbuf%STRA(jj(6) + i)
2008 ENDDO
2009 ENDIF
2010 ELSE
2011 DO i=lft,llt
2012 evar(1,i) = zero
2013 evar(2,i) = zero
2014 evar(3,i) = zero
2015 evar(4,i) = zero
2016 evar(5,i) = zero
2017 evar(6,i) = zero
2018 ENDDO
2019 ENDIF
2020 ENDIF
2021 IF (kcvt /= 0) THEN
2022! STRAIN TENSOR IN GLOBAL SYSTEM
2023 DO i=lft,llt
2024 n = i + nft
2025 IF(el2fa(nn2+n) /= 0)THEN
2026 IF(kcvt==2)THEN
2027 gama(1)=gbuf%GAMA(jj(1) + i)
2028 gama(2)=gbuf%GAMA(jj(2) + i)
2029 gama(3)=gbuf%GAMA(jj(3) + i)
2030 gama(4)=gbuf%GAMA(jj(4) + i)
2031 gama(5)=gbuf%GAMA(jj(5) + i)
2032 gama(6)=gbuf%GAMA(jj(6) + i)
2033 ELSE
2034 gama(1)=one
2035 gama(2)=zero
2036 gama(3)=zero
2037 gama(4)=zero
2038 gama(5)=one
2039 gama(6)=zero
2040 END IF
2041 CALL srota6(x, ixs(1,n), kcvt, evar(1,i), gama, jhbe, igtyp, isorth)
2042 ENDIF
2043 ENDDO
2044 ENDIF
2045c-----------
2046 ELSEIF ((isolnod == 8 .OR. npt == 1 .OR. (isolnod == 4 .AND. isrot == 0)) .AND.
2047 . jhbe /= 14 .AND. jhbe /= 15 .AND. jhbe /= 17) THEN
2048c-----------
2049 ir=abs(pti)/100
2050 is=mod(abs(pti)/10,10)
2051 it=mod(abs(pti),10)
2052 ipt = ir + ( (is-1) + (it-1)*npts )*nptr
2053 IF (ipt == 1 ) THEN
2054 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
2055 IF (mlw>=28.AND.mlw /= 49 .OR. mlw == 24) THEN
2056 DO i=lft,llt
2057 evar(1,i) = evar(1,i) + lbuf%STRA(jj(1) + i)
2058 evar(2,i) = evar(2,i) + lbuf%STRA(jj(2) + i)
2059 evar(3,i) = evar(3,i) + lbuf%STRA(jj(3) + i)
2060 evar(4,i) = evar(4,i) + lbuf%STRA(jj(4) + i)*half
2061 evar(5,i) = evar(5,i) + lbuf%STRA(jj(5) + i)*half
2062 evar(6,i) = evar(6,i) + lbuf%STRA(jj(6) + i)*half
2063 END DO
2064 ELSEIF(mlw == 12 .OR. mlw == 14) THEN
2065 DO i=lft,llt
2066 evar(1,i) = evar(1,i) + lbuf%EPE(jj(1) + i)
2067 evar(2,i) = evar(2,i) + lbuf%EPE(jj(2) + i)
2068 evar(3,i) = evar(3,i) + lbuf%EPE(jj(3) + i)
2069 ENDDO
2070 ELSEIF (istrain > 0)THEN
2071 IF (mlw /= 14.AND.mlw /= 24.AND.mlw<28.OR. mlw == 49) THEN
2072 DO i=lft,llt
2073 evar(1,i) = evar(1,i) + lbuf%STRA(jj(1) + i)
2074 evar(2,i) = evar(2,i) + lbuf%STRA(jj(2) + i)
2075 evar(3,i) = evar(3,i) + lbuf%STRA(jj(3) + i)
2076 evar(4,i) = evar(4,i) + lbuf%STRA(jj(4) + i)*half
2077 evar(5,i) = evar(5,i) + lbuf%STRA(jj(5) + i)*half
2078 evar(6,i) = evar(6,i) + lbuf%STRA(jj(6) + i)*half
2079 ENDDO
2080 ENDIF
2081 ENDIF
2082 ENDIF
2083
2084 IF (kcvt /= 0) THEN
2085! STRAIN TENSOR IN GLOBAL SYSTEM
2086 DO i=lft,llt
2087 n = i + nft
2088 IF(el2fa(nn2+n) /= 0)THEN
2089 IF(kcvt==2)THEN
2090 gama(1)=gbuf%GAMA(jj(1) + i)
2091 gama(2)=gbuf%GAMA(jj(2) + i)
2092 gama(3)=gbuf%GAMA(jj(3) + i)
2093 gama(4)=gbuf%GAMA(jj(4) + i)
2094 gama(5)=gbuf%GAMA(jj(5) + i)
2095 gama(6)=gbuf%GAMA(jj(6) + i)
2096 ELSE
2097 gama(1)=one
2098 gama(2)=zero
2099 gama(3)=zero
2100 gama(4)=zero
2101 gama(5)=one
2102 gama(6)=zero
2103 END IF
2104 CALL srota6(x, ixs(1,n), kcvt, evar(1,i), gama, jhbe, igtyp, isorth)
2105 ENDIF
2106 ENDDO
2107 ENDIF
2108
2109 ELSEIF (isolnod == 16.OR.isolnod == 20.OR.(isolnod == 8.AND. (jhbe == 14 .OR. jhbe == 17))) THEN
2110
2111 icsig = iparg(17,ng)
2112 ir0=abs(pti)/100
2113 is0=mod(abs(pti)/10,10)
2114 it0=mod(abs(pti),10)
2115 IF (ir0==0.OR.is0==0.OR.it0==0) cycle
2116 ir = ir0
2117 is = is0
2118 it = it0
2119 IF (tshell == 1) THEN
2120 IF (icsig==100) THEN
2121 ir = is0
2122 is = it0
2123 it = ir0
2124 ELSEIF (icsig==10) THEN
2125 ir = it0
2126 is = ir0
2127 it = is0
2128 ELSE
2129 ir = ir0
2130 is = is0
2131 it = it0
2132 END IF
2133 ENDIF
2134 IF (ir>nptr.OR.is>npts) cycle
2135 ipt = ir + ( (is-1) + (it-1)*npts )*nptr
2136 iok = 0
2137 IF (tshell == 1) THEN
2138 IF (isolnod == 16.AND. is0 <= nlay) THEN
2139 lbuf => elbuf_tab(ng)%BUFLY(is0)%LBUF(ir,1,it)
2140 iok = 1
2141 ELSEIF (it <= nlay) THEN
2142 lbuf => elbuf_tab(ng)%BUFLY(it)%LBUF(ir,is,1)
2143 iok = 1
2144 END IF
2145 ELSE
2146 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ir,is,it)
2147 iok = 1
2148 ENDIF
2149 IF (iok == 1 ) THEN
2150 IF(mlw>=28.AND.mlw /= 49)THEN
2151 DO i=lft,llt
2152! 3*9*3 points d'integration (r*s*t)
2153 evar(1,i) = lbuf%STRA(jj(1) + i)
2154 evar(2,i) = lbuf%STRA(jj(2) + i)
2155 evar(3,i) = lbuf%STRA(jj(3) + i)
2156 evar(4,i) = lbuf%STRA(jj(4) + i)*half
2157 evar(5,i) = lbuf%STRA(jj(5) + i)*half
2158 evar(6,i) = lbuf%STRA(jj(6) + i)*half
2159 ENDDO
2160 ELSEIF(mlw == 12 .OR. mlw == 14)THEN
2161 DO i=lft,llt
2162! 3*9*3 points d'integration (r*s*t)
2163 evar(1,i) = lbuf%EPE(jj(1) + i)
2164 evar(2,i) = lbuf%EPE(jj(2) + i)
2165 evar(3,i) = lbuf%EPE(jj(3) + i)
2166 ENDDO
2167 ELSEIF(mlw == 24 .OR. mlw == 25)THEN
2168 DO i=lft,llt
2169! 3*9*3 points d'integration (r*s*t)
2170 evar(1,i) = lbuf%STRA(jj(1) + i)
2171 evar(2,i) = lbuf%STRA(jj(2) + i)
2172 evar(3,i) = lbuf%STRA(jj(3) + i)
2173 evar(4,i) = lbuf%STRA(jj(4) + i) * half
2174 evar(5,i) = lbuf%STRA(jj(5) + i) * half
2175 evar(6,i) = lbuf%STRA(jj(6) + i) * half
2176 ENDDO
2177 ELSEIF (mlw == 25) THEN
2178 DO i=lft,llt
2179 evar(1,i) = lbuf%STRA(jj(1) + i)
2180 evar(2,i) = lbuf%STRA(jj(2) + i)
2181 evar(3,i) = lbuf%STRA(jj(3) + i)
2182 evar(4,i) = lbuf%STRA(jj(4) + i) * half
2183 evar(5,i) = lbuf%STRA(jj(5) + i) * half
2184 evar(6,i) = lbuf%STRA(jj(6) + i) * half
2185 ENDDO
2186 ELSEIF(istrain > 0)THEN
2187 IF(mlw /= 14.AND.mlw /= 24.AND.mlw<28)THEN
2188 DO i=lft,llt
2189! 3*9*3 points d'integration (r*s*t)
2190 evar(1,i) = lbuf%STRA(jj(1) + i)
2191 evar(2,i) = lbuf%STRA(jj(2) + i)
2192 evar(3,i) = lbuf%STRA(jj(3) + i)
2193 evar(4,i) = lbuf%STRA(jj(4) + i) * half
2194 evar(5,i) = lbuf%STRA(jj(5) + i) * half
2195 evar(6,i) = lbuf%STRA(jj(6) + i) * half
2196 ENDDO
2197 ENDIF
2198 ENDIF
2199C
2200 IF (kcvt >1 .AND. jhbe /= 16) THEN
2201C STRAIN TENSOR IN GLOBAL SYSTEM
2202 icsig=iparg(17,ng)
2203 IF (jhbe == 14.AND.icsig > 0) THEN
2204 IF (igtyp == 21) THEN
2205 SELECT CASE (icsig)
2206 CASE (1)
2207 DO i=lft,llt
2208 n = i + nft
2209 IF(el2fa(nn2+n) /= 0)THEN
2210 IF(kcvt==2)THEN
2211 gama(1)=zero
2212 gama(2)=gbuf%GAMA(jj(1) + i)
2213 gama(3)=gbuf%GAMA(jj(2) + i)
2214 gama(4)=zero
2215 gama(5)=-gama(2)
2216 gama(6)=gama(1)
2217 ELSE
2218 gama(1)=one
2219 gama(2)=zero
2220 gama(3)=zero
2221 gama(4)=zero
2222 gama(5)=one
2223 gama(6)=zero
2224 END IF
2225 CALL srota6(x, ixs(1,n), kcvt, evar(1,i), gama, jhbe, igtyp, isorth)
2226 ENDIF
2227 ENDDO
2228 CASE (10)
2229 DO i=lft,llt
2230 n = i + nft
2231 IF(el2fa(nn2+n) /= 0)THEN
2232 IF(kcvt==2)THEN
2233 gama(1)=gbuf%GAMA(jj(1) + i)
2234 gama(2)=gbuf%GAMA(jj(2) + i)
2235 gama(3)=zero
2236 gama(4)=-gama(2)
2237 gama(5)=gama(1)
2238 gama(6)=zero
2239 ELSE
2240 gama(1)=one
2241 gama(2)=zero
2242 gama(3)=zero
2243 gama(4)=zero
2244 gama(5)=one
2245 gama(6)=zero
2246 END IF
2247 CALL srota6(x, ixs(1,n), kcvt, evar(1,i), gama, jhbe, igtyp, isorth)
2248 ENDIF
2249 ENDDO
2250 CASE (100)
2251 DO i=lft,llt
2252 n = i + nft
2253 IF(el2fa(nn2+n) /= 0)THEN
2254 IF(kcvt==2)THEN
2255 gama(1)=gbuf%GAMA(jj(2) + i)
2256 gama(2)=zero
2257 gama(3)=gbuf%GAMA(jj(1) + i)
2258 gama(4)=gama(3)
2259 gama(5)=zero
2260 gama(6)=-gama(1)
2261 ELSE
2262 gama(1)=one
2263 gama(2)=zero
2264 gama(3)=zero
2265 gama(4)=zero
2266 gama(5)=one
2267 gama(6)=zero
2268 END IF
2269 CALL srota6(x, ixs(1,n), kcvt, evar(1,i), gama, jhbe, igtyp, isorth)
2270 ENDIF
2271 ENDDO
2272 END SELECT
2273 ELSE
2274 SELECT CASE (icsig)
2275 CASE (1)
2276 DO i=lft,llt
2277 n = i + nft
2278 IF(el2fa(nn2+n) /= 0)THEN
2279 IF(kcvt==2)THEN
2280 gama(1)=zero
2281 gama(2)=lbuf%GAMA(jj(1) + i)
2282 gama(3)=lbuf%GAMA(jj(2) + i)
2283 gama(4)=zero
2284 gama(5)=-gama(2)
2285 gama(6)=gama(1)
2286 ELSE
2287 gama(1)=one
2288 gama(2)=zero
2289 gama(3)=zero
2290 gama(4)=zero
2291 gama(5)=one
2292 gama(6)=zero
2293 END IF
2294 CALL srota6(x, ixs(1,n), kcvt, evar(1,i), gama, jhbe, igtyp, isorth)
2295 ENDIF
2296 ENDDO
2297 CASE (10)
2298 DO i=lft,llt
2299 n = i + nft
2300 IF(el2fa(nn2+n) /= 0)THEN
2301 IF(kcvt==2)THEN
2302 gama(1)=lbuf%GAMA(jj(1) + i)
2303 gama(2)=lbuf%GAMA(jj(2) + i)
2304 gama(3)=zero
2305 gama(4)=-gama(2)
2306 gama(5)=gama(1)
2307 gama(6)=zero
2308 ELSE
2309 gama(1)=one
2310 gama(2)=zero
2311 gama(3)=zero
2312 gama(4)=zero
2313 gama(5)=one
2314 gama(6)=zero
2315 END IF
2316 CALL srota6(x, ixs(1,n), kcvt, evar(1,i), gama, jhbe, igtyp, isorth)
2317 ENDIF
2318 ENDDO
2319 CASE (100)
2320 DO i=lft,llt
2321 n = i + nft
2322 IF(el2fa(nn2+n) /= 0)THEN
2323 IF(kcvt==2)THEN
2324 gama(1)=lbuf%GAMA(jj(2) + i)
2325 gama(2)=zero
2326 gama(3)=lbuf%GAMA(jj(1) + i)
2327 gama(4)=gama(3)
2328 gama(5)=zero
2329 gama(6)=-gama(1)
2330 ELSE
2331 gama(1)=one
2332 gama(2)=zero
2333 gama(3)=zero
2334 gama(4)=zero
2335 gama(5)=one
2336 gama(6)=zero
2337 END IF
2338 CALL srota6(x, ixs(1,n), kcvt, evar(1,i), gama, jhbe, igtyp, isorth)
2339 ENDIF
2340 ENDDO
2341 END SELECT
2342 ENDIF
2343 ELSE
2344 DO i=lft,llt
2345 n = i + nft
2346 IF(el2fa(nn2+n) /= 0)THEN
2347 IF(kcvt==2)THEN
2348 gama(1)=gbuf%GAMA(jj(1) + i)
2349 gama(2)=gbuf%GAMA(jj(2) + i)
2350 gama(3)=gbuf%GAMA(jj(3) + i)
2351 gama(4)=gbuf%GAMA(jj(4) + i)
2352 gama(5)=gbuf%GAMA(jj(5) + i)
2353 gama(6)=gbuf%GAMA(jj(6) + i)
2354 ELSE
2355 gama(1)=one
2356 gama(2)=zero
2357 gama(3)=zero
2358 gama(4)=zero
2359 gama(5)=one
2360 gama(6)=zero
2361 END IF
2362 CALL srota6(x, ixs(1,n), kcvt, evar(1,i), gama, jhbe, igtyp, isorth)
2363 ENDIF
2364 ENDDO
2365 ENDIF !(JHBE == 14.AND.ICSIG > 0)
2366 ENDIF
2367 ENDIF
2368
2369 ELSEIF (((isolnod == 6.OR.isolnod == 8).AND.jhbe == 15) .OR. ((isolnod == 6).AND.jhbe == 24)) THEN
2370 ipt = mod(abs(pti)/10,10)
2371 IF ( ipt > 0 .AND. ipt<=nlay ) THEN
2372 lbuf => elbuf_tab(ng)%BUFLY(ipt)%LBUF(1,1,1)
2373 IF(mlw>=28.AND.mlw /= 49)THEN
2374 DO i=lft,llt
2375 evar(1,i) = lbuf%STRA(jj(1) + i)
2376 evar(2,i) = lbuf%STRA(jj(2) + i)
2377 evar(3,i) = lbuf%STRA(jj(3) + i)
2378 evar(4,i) = lbuf%STRA(jj(4) + i)*half
2379 evar(5,i) = lbuf%STRA(jj(5) + i)*half
2380 evar(6,i) = lbuf%STRA(jj(6) + i)*half
2381 ENDDO
2382 ELSEIF(mlw == 12 .OR. mlw == 14)THEN
2383 DO i=lft,llt
2384 evar(1,i) = lbuf%EPE(jj(1) + i)
2385 evar(2,i) = lbuf%EPE(jj(2) + i)
2386 evar(3,i) = lbuf%EPE(jj(3) + i)
2387 ENDDO
2388 ELSE
2389 DO i=lft,llt
2390 evar(1,i) = lbuf%STRA(jj(1) + i)
2391 evar(2,i) = lbuf%STRA(jj(2) + i)
2392 evar(3,i) = lbuf%STRA(jj(3) + i)
2393 evar(4,i) = lbuf%STRA(jj(4) + i)*half
2394 evar(5,i) = lbuf%STRA(jj(5) + i)*half
2395 evar(6,i) = lbuf%STRA(jj(6) + i)*half
2396 ENDDO
2397 END IF
2398 IF (kcvt /= 0 ) THEN
2399! STRAIN TENSOR IN GLOBAL SYSTEM
2400 DO i=lft,llt
2401 n = i + nft
2402 IF(el2fa(nn2+n) /= 0)THEN
2403 IF(kcvt==2)THEN
2404 gama(1)=gbuf%GAMA(jj(1) + i)
2405 gama(2)=gbuf%GAMA(jj(2) + i)
2406 gama(3)=zero
2407 gama(4)=-gama(2)
2408 gama(5)=gama(1)
2409 gama(6)=zero
2410 ELSE
2411 gama(1)=one
2412 gama(2)=zero
2413 gama(3)=zero
2414 gama(4)=zero
2415 gama(5)=one
2416 gama(6)=zero
2417 END IF
2418 CALL srota6(x, ixs(1,n), kcvt, evar(1,i), gama, jhbe, igtyp, isorth)
2419 ENDIF
2420 ENDDO
2421 ENDIF
2422 END IF
2423c-----------
2424 ELSEIF (isolnod==10 .OR. (isolnod==4 .AND. isrot==1)) THEN
2425c-----------
2426 ir=abs(pti)/100
2427 is=mod(abs(pti)/10,10)
2428 it=mod(abs(pti),10)
2429 ipt = 0
2430 IF (ir == 1 .AND. is == 1 .AND. it == 1) ipt = 1
2431 IF (ir == 2 .AND. is == 1 .AND. it == 1) ipt = 2
2432 IF (ir == 1 .AND. is == 2 .AND. it == 1) ipt = 3
2433 IF (ir == 1 .AND. is == 1 .AND. it == 2) ipt = 4
2434 IF ( ipt > 0) THEN
2435 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ipt,1,1)
2436 IF (mlw>=28.AND.mlw /= 49 .OR. mlw == 24) THEN
2437 DO i=lft,llt
2438 evar(1,i) = evar(1,i) + lbuf%STRA(jj(1) + i)
2439 evar(2,i) = evar(2,i) + lbuf%STRA(jj(2) + i)
2440 evar(3,i) = evar(3,i) + lbuf%STRA(jj(3) + i)
2441 evar(4,i) = evar(4,i) + lbuf%STRA(jj(4) + i)*half
2442 evar(5,i) = evar(5,i) + lbuf%STRA(jj(5) + i)*half
2443 evar(6,i) = evar(6,i) + lbuf%STRA(jj(6) + i)*half
2444 ENDDO
2445 ELSEIF (mlw == 12 .OR. mlw == 14) THEN
2446 DO i=lft,llt
2447 evar(1,i) = evar(1,i) + lbuf%EPE(jj(1) + i)
2448 evar(2,i) = evar(2,i) + lbuf%EPE(jj(2) + i)
2449 evar(3,i) = evar(3,i) + lbuf%EPE(jj(3) + i)
2450 ENDDO
2451 ELSEIF (istrain > 0) THEN
2452 IF (mlw /= 14.AND.mlw /= 24.AND.mlw<28) THEN
2453 DO i=lft,llt
2454 evar(1,i) = evar(1,i) + lbuf%STRA(jj(1) + i)
2455 evar(2,i) = evar(2,i) + lbuf%STRA(jj(2) + i)
2456 evar(3,i) = evar(3,i) + lbuf%STRA(jj(3) + i)
2457 evar(4,i) = evar(4,i) + lbuf%STRA(jj(4) + i)*half
2458 evar(5,i) = evar(5,i) + lbuf%STRA(jj(5) + i)*half
2459 evar(6,i) = evar(6,i) + lbuf%STRA(jj(6) + i)*half
2460 ENDDO
2461 ENDIF
2462 ENDIF
2463 ENDIF
2464
2465 IF (kcvt /= 0) THEN
2466 DO i=lft,llt
2467 n = i + nft
2468 IF(el2fa(nn2+n) /= 0)THEN
2469 IF(kcvt==2)THEN
2470 gama(1)=gbuf%GAMA(jj(1) + i)
2471 gama(2)=gbuf%GAMA(jj(2) + i)
2472 gama(3)=gbuf%GAMA(jj(3) + i)
2473 gama(4)=gbuf%GAMA(jj(4) + i)
2474 gama(5)=gbuf%GAMA(jj(5) + i)
2475 gama(6)=gbuf%GAMA(jj(6) + i)
2476 ELSE
2477 gama(1)=one
2478 gama(2)=zero
2479 gama(3)=zero
2480 gama(4)=zero
2481 gama(5)=one
2482 gama(6)=zero
2483 END IF
2484 CALL srota6(x, ixs(1,n), kcvt, evar(1,i), gama, jhbe, igtyp, isorth)
2485 ENDIF
2486 ENDDO
2487 ENDIF
2488 END IF
2489c-----------
2490C-----------------------------------------------
2491C STRAIN TENSOR / integration point more than 9 point in direction s
2492 ELSEIF (itens>=22110.AND.itens<=42209) THEN
2493C-----------------------------------------------
2494 pti = itens - 22110
2495 IF (((isolnod == 6.OR.isolnod == 8).AND.jhbe == 15) .OR. ((isolnod == 6).AND.jhbe == 24)) THEN
2496 ipt = mod(abs(pti)/10,201)
2497 IF ( ipt > 0 .AND. ipt<=nlay.AND.nlay>9) THEN
2498 lbuf => elbuf_tab(ng)%BUFLY(ipt)%LBUF(1,1,1)
2499 IF(mlw>=28.AND.mlw /= 49)THEN
2500 DO i=lft,llt
2501 evar(1,i) = lbuf%STRA(jj(1) + i)
2502 evar(2,i) = lbuf%STRA(jj(2) + i)
2503 evar(3,i) = lbuf%STRA(jj(3) + i)
2504 evar(4,i) = lbuf%STRA(jj(4) + i)*half
2505 evar(5,i) = lbuf%STRA(jj(5) + i)*half
2506 evar(6,i) = lbuf%STRA(jj(6) + i)*half
2507 ENDDO
2508 ELSEIF(mlw == 12 .OR. mlw == 14)THEN
2509 DO i=lft,llt
2510 evar(1,i) = lbuf%EPE(jj(1) + i)
2511 evar(2,i) = lbuf%EPE(jj(2) + i)
2512 evar(3,i) = lbuf%EPE(jj(3) + i)
2513 ENDDO
2514 ELSE
2515 DO i=lft,llt
2516 evar(1,i) = lbuf%STRA(jj(1) + i)
2517 evar(2,i) = lbuf%STRA(jj(2) + i)
2518 evar(3,i) = lbuf%STRA(jj(3) + i)
2519 evar(4,i) = lbuf%STRA(jj(4) + i)*half
2520 evar(5,i) = lbuf%STRA(jj(5) + i)*half
2521 evar(6,i) = lbuf%STRA(jj(6) + i)*half
2522 ENDDO
2523 END IF
2524 IF (kcvt /= 0 ) THEN
2525! STRAIN TENSOR IN GLOBAL SYSTEM
2526 DO i=lft,llt
2527 n = i + nft
2528 IF(el2fa(nn2+n) /= 0)THEN
2529 IF(kcvt==2)THEN
2530 gama(1)=lbuf%GAMA(jj(1) + i)
2531 gama(2)=lbuf%GAMA(jj(2) + i)
2532 gama(3)=zero
2533 gama(4)=-gama(2)
2534 gama(5)=gama(1)
2535 gama(6)=zero
2536 ELSE
2537 gama(1)=one
2538 gama(2)=zero
2539 gama(3)=zero
2540 gama(4)=zero
2541 gama(5)=one
2542 gama(6)=zero
2543 END IF
2544 CALL srota6(x, ixs(1,n), kcvt, evar(1,i), gama, jhbe, igtyp, isorth)
2545 ENDIF
2546 ENDDO
2547 ENDIF
2548 END IF
2549c-----------
2550 ELSEIF (isolnod==16.OR.(isolnod==8.AND.jhbe==14)) THEN
2551c-----------
2552 icsig = iparg(17,ng)
2553 ir0=abs(pti)/2010
2554 is0=mod(abs(pti)/10,201)
2555 it0=mod(abs(pti),10)
2556 IF (ir0==0.OR.is0==0.OR.it0==0.OR.nlay<10) cycle
2557 ir = ir0
2558 is = is0
2559 it = it0
2560 IF (tshell == 1) THEN
2561 IF (icsig==100) THEN
2562 ir = is0
2563 is = it0
2564 it = ir0
2565 ELSEIF (icsig==10) THEN
2566 ir = it0
2567 is = ir0
2568 it = is0
2569 ELSE
2570 ir = ir0
2571 is = is0
2572 it = it0
2573 END IF
2574 ENDIF
2575 IF (ir>nptr.OR.is>npts.OR.it>nlay) cycle
2576 ipt = ir + ( (is-1) + (it-1)*npts )*nptr
2577 IF (ipt <= npt ) THEN
2578 IF (tshell == 1) THEN
2579 lbuf => elbuf_tab(ng)%BUFLY(it)%LBUF(ir,is,1)
2580 ELSE
2581 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ir,is,it)
2582 ENDIF
2583 IF(mlw>=28.AND.mlw /= 49)THEN
2584 DO i=lft,llt
2585 evar(1,i) = lbuf%STRA(jj(1) + i)
2586 evar(2,i) = lbuf%STRA(jj(2) + i)
2587 evar(3,i) = lbuf%STRA(jj(3) + i)
2588 evar(4,i) = lbuf%STRA(jj(4) + i)*half
2589 evar(5,i) = lbuf%STRA(jj(5) + i)*half
2590 evar(6,i) = lbuf%STRA(jj(6) + i)*half
2591 ENDDO
2592 ELSEIF(mlw == 12 .OR. mlw == 14)THEN
2593 DO i=lft,llt
2594 evar(1,i) = lbuf%EPE(jj(1) + i)
2595 evar(2,i) = lbuf%EPE(jj(2) + i)
2596 evar(3,i) = lbuf%EPE(jj(3) + i)
2597 ENDDO
2598 ELSEIF(mlw == 24 .OR. mlw == 25)THEN
2599 DO i=lft,llt
2600 evar(1,i) = lbuf%STRA(jj(1) + i)
2601 evar(2,i) = lbuf%STRA(jj(2) + i)
2602 evar(3,i) = lbuf%STRA(jj(3) + i)
2603 evar(4,i) = lbuf%STRA(jj(4) + i)*half
2604 evar(5,i) = lbuf%STRA(jj(5) + i)*half
2605 evar(6,i) = lbuf%STRA(jj(6) + i)*half
2606 ENDDO
2607 ELSEIF (mlw == 25) THEN
2608 DO i=lft,llt
2609 evar(1,i) = lbuf%STRA(jj(1) + i)
2610 evar(2,i) = lbuf%STRA(jj(2) + i)
2611 evar(3,i) = lbuf%STRA(jj(3) + i)
2612 evar(4,i) = lbuf%STRA(jj(4) + i) * half
2613 evar(5,i) = lbuf%STRA(jj(5) + i) * half
2614 evar(6,i) = lbuf%STRA(jj(6) + i) * half
2615 ENDDO
2616 ELSEIF(istrain > 0)THEN
2617 IF(mlw /= 14.AND.mlw /= 24.AND.mlw<28)THEN
2618 DO i=lft,llt
2619 evar(1,i) = lbuf%STRA(jj(1) + i)
2620 evar(2,i) = lbuf%STRA(jj(2) + i)
2621 evar(3,i) = lbuf%STRA(jj(3) + i)
2622 evar(4,i) = lbuf%STRA(jj(4) + i) * half
2623 evar(5,i) = lbuf%STRA(jj(5) + i) * half
2624 evar(6,i) = lbuf%STRA(jj(6) + i) * half
2625 ENDDO
2626 ENDIF
2627 END IF
2628 END IF
2629
2630 IF (kcvt /= 0 .AND. jhbe /= 16) THEN
2631! STRAIN TENSOR IN GLOBAL SYSTEM
2632 icsig=iparg(17,ng)
2633 IF (jhbe == 14.AND.icsig > 0) THEN
2634 SELECT CASE (icsig)
2635 CASE (1)
2636 DO i=lft,llt
2637 n = i + nft
2638 IF(el2fa(nn2+n) /= 0)THEN
2639 IF(kcvt==2)THEN
2640 gama(1)=zero
2641 gama(2)=lbuf%GAMA(jj(1) + i)
2642 gama(3)=lbuf%GAMA(jj(2) + i)
2643 gama(4)=zero
2644 gama(5)=-gama(2)
2645 gama(6)=gama(1)
2646 ELSE
2647 gama(1)=one
2648 gama(2)=zero
2649 gama(3)=zero
2650 gama(4)=zero
2651 gama(5)=one
2652 gama(6)=zero
2653 END IF
2654 CALL srota6(x, ixs(1,n), kcvt, evar(1,i), gama, jhbe, igtyp, isorth)
2655 ENDIF
2656 ENDDO
2657 CASE (10)
2658 DO i=lft,llt
2659 n = i + nft
2660 IF(el2fa(nn2+n) /= 0)THEN
2661 IF(kcvt==2)THEN
2662 gama(1)=lbuf%GAMA(jj(1) + i)
2663 gama(2)=lbuf%GAMA(jj(2) + i)
2664 gama(3)=zero
2665 gama(4)=-gama(2)
2666 gama(5)=gama(1)
2667 gama(6)=zero
2668 ELSE
2669 gama(1)=one
2670 gama(2)=zero
2671 gama(3)=zero
2672 gama(4)=zero
2673 gama(5)=one
2674 gama(6)=zero
2675 END IF
2676 CALL srota6(x, ixs(1,n), kcvt, evar(1,i),gama, jhbe, igtyp, isorth)
2677 ENDIF
2678 ENDDO
2679 CASE (100)
2680 DO i=lft,llt
2681 n = i + nft
2682 IF(el2fa(nn2+n) /= 0)THEN
2683 IF(kcvt==2)THEN
2684 gama(1)=lbuf%GAMA(jj(2) + i)
2685 gama(2)=zero
2686 gama(3)=lbuf%GAMA(jj(1) + i)
2687 gama(4)=gama(3)
2688 gama(5)=zero
2689 gama(6)=-gama(1)
2690 ELSE
2691 gama(1)=one
2692 gama(2)=zero
2693 gama(3)=zero
2694 gama(4)=zero
2695 gama(5)=one
2696 gama(6)=zero
2697 END IF
2698 CALL srota6(x, ixs(1,n), kcvt, evar(1,i), gama, jhbe, igtyp, isorth)
2699 ENDIF
2700 ENDDO
2701 END SELECT
2702 END IF !(JHBE == 14.AND.ICSIG > 0)
2703 END IF
2704 END IF
2705C-----------------------------------------------
2706! PLASTIC STRAIN TENSOR / integration point
2707 ELSEIF (itens >= 42210 .AND. itens <= 43209) THEN
2708C--------------------------NLAY<10
2709 pti = itens - 42210
2710c-----------
2711 IF (isolnod == 16.OR.isolnod == 20.OR.(isolnod == 8.AND. (jhbe == 14 .OR. jhbe == 17))) THEN
2712c-----------
2713 icsig = iparg(17,ng)
2714 ir0=abs(pti)/100
2715 is0=mod(abs(pti)/10,10)
2716 it0=mod(abs(pti),10)
2717 ipid = ixs(10,1 + nft)
2718 IF (ir0==0.OR.is0==0.OR.it0==0) cycle
2719 ir = ir0
2720 is = is0
2721 it = it0
2722 IF (tshell == 1) THEN
2723 IF (icsig==100) THEN
2724 ir = is0
2725 is = it0
2726 it = ir0
2727 ELSEIF (icsig==10) THEN
2728 ir = it0
2729 is = ir0
2730 it = is0
2731 ELSE
2732 ir = ir0
2733 is = is0
2734 it = it0
2735 END IF
2736 ENDIF
2737 IF (ir>nptr.OR.is>npts) cycle
2738 ipt = ir + ( (is-1) + (it-1)*npts )*nptr
2739 iok = 0
2740 IF (tshell == 1) THEN
2741 IF (isolnod == 16.AND. is0 <= nlay) THEN
2742 lbuf => elbuf_tab(ng)%BUFLY(is0)%LBUF(ir,1,it)
2743 iok = 1
2744 ELSEIF (it <= nlay) THEN
2745 lbuf => elbuf_tab(ng)%BUFLY(it)%LBUF(ir,is,1)
2746 iok = 1
2747 ENDIF
2748 ELSE
2749 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ir,is,it)
2750 iok = 1
2751 ENDIF
2752 IF (iok == 1 ) THEN
2753!
2754 IF (mlw == 24) THEN
2755 DO i=lft,llt
2756C 3*9*3 points d'integration (r*s*t)
2757 evar(1,i) = lbuf%PLA(jj(1) + i + nel)
2758 evar(2,i) = lbuf%PLA(jj(2) + i + nel)
2759 evar(3,i) = lbuf%PLA(jj(3) + i + nel)
2760 evar(4,i) = lbuf%PLA(jj(4) + i + nel) * half
2761 evar(5,i) = lbuf%PLA(jj(5) + i + nel) * half
2762 evar(6,i) = lbuf%PLA(jj(6) + i + nel) * half
2763 ENDDO
2764 ENDIF ! IF (MLW == 24)
2765!
2766 IF (kcvt /= 0 .AND. jhbe /= 16) THEN
2767! PLASTIC STRAIN TENSOR IN GLOBAL SYSTEM
2768 icsig=iparg(17,ng)
2769 IF (jhbe == 14 .AND. icsig > 0) THEN
2770 IF (igtyp == 21) THEN
2771 SELECT CASE (icsig)
2772 CASE (1)
2773 DO i=lft,llt
2774 n = i + nft
2775 IF (el2fa(nn2+n) /= 0) THEN
2776 IF (kcvt == 2) THEN
2777 gama(1) = zero
2778 gama(2) = gbuf%GAMA(jj(1) + i)
2779 gama(3) = gbuf%GAMA(jj(2) + i)
2780 gama(4) = zero
2781 gama(5) =-gama(2)
2782 gama(6) = gama(1)
2783 ELSE
2784 gama(1) = one
2785 gama(2) = zero
2786 gama(3) = zero
2787 gama(4) = zero
2788 gama(5) = one
2789 gama(6) = zero
2790 ENDIF ! IF (KCVT == 2)
2791 CALL srota6(x, ixs(1,n), kcvt, evar(1,i), gama, jhbe, igtyp, isorth)
2792 ENDIF ! IF (EL2FA(NN2+N) /= 0)
2793 ENDDO ! DO I=LFT,LLT
2794 CASE (10)
2795 DO i=lft,llt
2796 n = i + nft
2797 IF (el2fa(nn2+n) /= 0) THEN
2798 IF (kcvt == 2) THEN
2799 gama(1) = gbuf%GAMA(jj(1) + i)
2800 gama(2) = gbuf%GAMA(jj(2) + i)
2801 gama(3) = zero
2802 gama(4) =-gama(2)
2803 gama(5) = gama(1)
2804 gama(6) = zero
2805 ELSE
2806 gama(1) = one
2807 gama(2) = zero
2808 gama(3) = zero
2809 gama(4) = zero
2810 gama(5) = one
2811 gama(6) = zero
2812 ENDIF ! IF (KCVT == 2)
2813 CALL srota6(x, ixs(1,n), kcvt, evar(1,i), gama, jhbe, igtyp, isorth)
2814 ENDIF ! IF (EL2FA(NN2+N) /= 0)
2815 ENDDO ! DO I=LFT,LLT
2816 CASE (100)
2817 DO i=lft,llt
2818 n = i + nft
2819 IF (el2fa(nn2+n) /= 0) THEN
2820 IF (kcvt == 2) THEN
2821 gama(1) = gbuf%GAMA(jj(2) + i)
2822 gama(2) = zero
2823 gama(3) = gbuf%GAMA(jj(1) + i)
2824 gama(4) = gama(3)
2825 gama(5) = zero
2826 gama(6) =-gama(1)
2827 ELSE
2828 gama(1) = one
2829 gama(2) = zero
2830 gama(3) = zero
2831 gama(4) = zero
2832 gama(5) = one
2833 gama(6) = zero
2834 ENDIF ! IF (KCVT == 2)
2835 CALL srota6(x, ixs(1,n), kcvt, evar(1,i), gama, jhbe, igtyp, isorth)
2836 ENDIF ! IF (EL2FA(NN2+N) /= 0)
2837 ENDDO ! DO I=LFT,LLT
2838 END SELECT
2839 ELSE ! (IGTYP /= 21)
2840 SELECT CASE (icsig)
2841 CASE (1)
2842 DO i=lft,llt
2843 n = i + nft
2844 IF (el2fa(nn2+n) /= 0) THEN
2845 IF (kcvt == 2) THEN
2846 gama(1) = zero
2847 gama(2) = lbuf%GAMA(jj(1) + i)
2848 gama(3) = lbuf%GAMA(jj(2) + i)
2849 gama(4) = zero
2850 gama(5) =-gama(2)
2851 gama(6) = gama(1)
2852 ELSE
2853 gama(1) = one
2854 gama(2) = zero
2855 gama(3) = zero
2856 gama(4) = zero
2857 gama(5) = one
2858 gama(6) = zero
2859 ENDIF ! IF (KCVT == 2)
2860 CALL srota6(x, ixs(1,n), kcvt, evar(1,i), gama, jhbe, igtyp, isorth)
2861 ENDIF ! IF (EL2FA(NN2+N) /= 0)
2862 ENDDO ! DO I=LFT,LLT
2863 CASE (10)
2864 DO i=lft,llt
2865 n = i + nft
2866 IF (el2fa(nn2+n) /= 0) THEN
2867 IF (kcvt == 2) THEN
2868 gama(1) = lbuf%GAMA(jj(1) + i)
2869 gama(2) = lbuf%GAMA(jj(2) + i)
2870 gama(3) = zero
2871 gama(4) =-gama(2)
2872 gama(5) = gama(1)
2873 gama(6) = zero
2874 ELSE
2875 gama(1) = one
2876 gama(2) = zero
2877 gama(3) = zero
2878 gama(4) = zero
2879 gama(5) = one
2880 gama(6) = zero
2881 ENDIF ! IF (KCVT == 2)
2882 CALL srota6(x, ixs(1,n), kcvt, evar(1,i), gama, jhbe, igtyp, isorth)
2883 ENDIF ! IF (EL2FA(NN2+N) /= 0)
2884 ENDDO ! DO I=LFT,LLT
2885 CASE (100)
2886 DO i=lft,llt
2887 n = i + nft
2888 IF (el2fa(nn2+n) /= 0) THEN
2889 IF (kcvt == 2) THEN
2890 gama(1) = lbuf%GAMA(jj(2) + i)
2891 gama(2) = zero
2892 gama(3) = lbuf%GAMA(jj(1) + i)
2893 gama(4) = gama(3)
2894 gama(5) = zero
2895 gama(6) =-gama(1)
2896 ELSE
2897 gama(1) = one
2898 gama(2) = zero
2899 gama(3) = zero
2900 gama(4) = zero
2901 gama(5) = one
2902 gama(6) = zero
2903 ENDIF ! IF (KCVT == 2)
2904 CALL srota6(x, ixs(1,n), kcvt, evar(1,i), gama, jhbe, igtyp, isorth)
2905 ENDIF ! IF (EL2FA(NN2+N) /= 0)
2906 ENDDO ! DO I=LFT,LLT
2907 END SELECT
2908 ENDIF ! IF (IGTYP == 21)
2909 ELSE
2910 DO i=lft,llt
2911 n = i + nft
2912 IF (el2fa(nn2+n) /= 0) THEN
2913 IF (kcvt == 2) THEN
2914 gama(1) = lbuf%GAMA(jj(1) + i)
2915 gama(2) = lbuf%GAMA(jj(2) + i)
2916 gama(3) = lbuf%GAMA(jj(3) + i)
2917 gama(4) = lbuf%GAMA(jj(4) + i)
2918 gama(5) = lbuf%GAMA(jj(5) + i)
2919 gama(6) = lbuf%GAMA(jj(6) + i)
2920 ELSE
2921 gama(1) = one
2922 gama(2) = zero
2923 gama(3) = zero
2924 gama(4) = zero
2925 gama(5) = one
2926 gama(6) = zero
2927 ENDIF ! IF (KCVT == 2)
2928 CALL srota6(x, ixs(1,n), kcvt, evar(1,i), gama, jhbe, igtyp, isorth)
2929 ENDIF ! IF (EL2FA(NN2+N) /= 0)
2930 ENDDO ! DO I=LFT,LLT
2931 ENDIF ! (JHBE == 14.AND.ICSIG > 0)
2932 ENDIF ! IF (KCVT /= 0 .AND. JHBE /= 16)
2933 ENDIF ! IF (IPT <= NPTG .AND. IR <= NPTR .AND. IS <= NPTS .AND. IT <= NPTT .AND. IR*IS*IT >= 1)
2934
2935 ELSEIF (isolnod == 10 .OR. (isolnod==4 .AND. isrot==1)) THEN
2936
2937 ir = abs(pti)/100
2938 is = mod(abs(pti)/10,10)
2939 it = mod(abs(pti),10)
2940 ipt = 0
2941 IF (ir == 1 .AND. is == 1 .AND. it == 1) ipt = 1
2942 IF (ir == 2 .AND. is == 1 .AND. it == 1) ipt = 2
2943 IF (ir == 1 .AND. is == 2 .AND. it == 1) ipt = 3
2944 IF (ir == 1 .AND. is == 1 .AND. it == 2) ipt = 4
2945 IF ( ipt > 0) THEN
2946 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ipt,1,1)
2947 IF (mlw == 24) THEN
2948 DO i=lft,llt
2949 evar(1,i) = evar(1,i) + lbuf%PLA(jj(1) + i + nel)
2950 evar(2,i) = evar(2,i) + lbuf%PLA(jj(2) + i + nel)
2951 evar(3,i) = evar(3,i) + lbuf%PLA(jj(3) + i + nel)
2952 evar(4,i) = evar(4,i) + lbuf%PLA(jj(4) + i + nel)*half
2953 evar(5,i) = evar(5,i) + lbuf%PLA(jj(5) + i + nel)*half
2954 evar(6,i) = evar(6,i) + lbuf%PLA(jj(6) + i + nel)*half
2955 ENDDO
2956 ENDIF ! IF (MLW == 24)
2957 ENDIF ! IF ( IPT > 0)
2958
2959 IF (kcvt /= 0) THEN
2960 DO i=lft,llt
2961 n = i + nft
2962 IF (el2fa(nn2+n) /= 0) THEN
2963 IF (kcvt == 2) THEN
2964 gama(1) = gbuf%GAMA(jj(1) + i)
2965 gama(2) = gbuf%GAMA(jj(2) + i)
2966 gama(3) = gbuf%GAMA(jj(3) + i)
2967 gama(4) = gbuf%GAMA(jj(4) + i)
2968 gama(5) = gbuf%GAMA(jj(5) + i)
2969 gama(6) = gbuf%GAMA(jj(6) + i)
2970 ELSE
2971 gama(1) = one
2972 gama(2) = zero
2973 gama(3) = zero
2974 gama(4) = zero
2975 gama(5) = one
2976 gama(6) = zero
2977 ENDIF ! IF (KCVT == 2)
2978 CALL srota6(x, ixs(1,n), kcvt, evar(1,i),gama, jhbe, igtyp, isorth)
2979 ENDIF ! IF (EL2FA(NN2+N) /= 0)
2980 ENDDO ! DO I=LFT,LLT
2981 ENDIF ! IF (KCVT /= 0)
2982c-----------
2983 ELSEIF (((isolnod == 6.OR.isolnod == 8).AND.jhbe == 15) .OR. ((isolnod == 6).AND.jhbe == 24)) THEN
2984
2985 ipt = mod(abs(pti)/10,10)
2986 IF ( ipt > 0 .AND. ipt<=nlay) THEN
2987 lbuf => elbuf_tab(ng)%BUFLY(ipt)%LBUF(1,1,1) ! TSHELL
2988 IF (mlw == 24) THEN
2989 DO i=lft,llt
2990 evar(1,i) = lbuf%PLA(jj(1) + i + nel)
2991 evar(2,i) = lbuf%PLA(jj(2) + i + nel)
2992 evar(3,i) = lbuf%PLA(jj(3) + i + nel)
2993 evar(4,i) = lbuf%PLA(jj(4) + i + nel)*half
2994 evar(5,i) = lbuf%PLA(jj(5) + i + nel)*half
2995 evar(6,i) = lbuf%PLA(jj(6) + i + nel)*half
2996 ENDDO
2997 ENDIF ! IF (MLW == 24) THEN
2998 DO i=lft,llt
2999 n = i + nft
3000 IF (el2fa(nn2+n) /= 0) THEN
3001 IF (kcvt == 2) THEN
3002 gama(1)=gbuf%GAMA(jj(1) + i)
3003 gama(2)=gbuf%GAMA(jj(2) + i)
3004 gama(3)=zero
3005 gama(4)=-gama(2)
3006 gama(5)=gama(1)
3007 gama(6)=zero
3008 ELSE
3009 gama(1) = one
3010 gama(2) = zero
3011 gama(3) = zero
3012 gama(4) = zero
3013 gama(5) = one
3014 gama(6) = zero
3015 ENDIF !
3016 CALL srota6(x, ixs(1,n), kcvt, evar(1,i), gama, jhbe, igtyp, isorth)
3017 ENDIF
3018 ENDDO ! DO I=LFT,LLT
3019 ENDIF ! IF (IPT <= NPTG .AND. IR <= NPTR .AND. IS <= NPTS .AND. JHBE /= 14.AND.JHBE /= 24.AND.JHBE /= 15.AND.JHBE /= 17)
3020 END IF
3021C-----------------------------------------------
3022! PLASTIC STRAIN TENSOR / integration points more than 9 points in direction s
3023 ELSEIF (itens >= 43210 .AND. itens <= 63309) THEN
3024C----------------------------NLAY>9
3025 pti = itens - 43210
3026c-----------
3027 IF (((isolnod == 6.OR.isolnod == 8).AND.jhbe == 15) .OR. ((isolnod == 6).AND.jhbe == 24)) THEN
3028
3029 ipt = mod(abs(pti)/10,201)
3030 IF ( ipt > 0 .AND. ipt<=nlay .AND. nlay>9) THEN
3031 lbuf => elbuf_tab(ng)%BUFLY(ipt)%LBUF(1,1,1) ! TSHELL
3032 IF (mlw == 24) THEN
3033 DO i=lft,llt
3034 evar(1,i) = lbuf%PLA(jj(1) + i + nel)
3035 evar(2,i) = lbuf%PLA(jj(2) + i + nel)
3036 evar(3,i) = lbuf%PLA(jj(3) + i + nel)
3037 evar(4,i) = lbuf%PLA(jj(4) + i + nel)*half
3038 evar(5,i) = lbuf%PLA(jj(5) + i + nel)*half
3039 evar(6,i) = lbuf%PLA(jj(6) + i + nel)*half
3040 ENDDO
3041 ENDIF ! IF (MLW == 24) THEN
3042 DO i=lft,llt
3043 n = i + nft
3044 IF (el2fa(nn2+n) /= 0) THEN
3045 IF (kcvt == 2) THEN
3046 gama(1)=gbuf%GAMA(jj(1) + i)
3047 gama(2)=gbuf%GAMA(jj(2) + i)
3048 gama(3)=zero
3049 gama(4)=-gama(2)
3050 gama(5)=gama(1)
3051 gama(6)=zero
3052 ELSE
3053 gama(1) = one
3054 gama(2) = zero
3055 gama(3) = zero
3056 gama(4) = zero
3057 gama(5) = one
3058 gama(6) = zero
3059 ENDIF !
3060 CALL srota6(x, ixs(1,n), kcvt, evar(1,i), gama, jhbe, igtyp, isorth)
3061 ENDIF
3062 ENDDO ! DO I=LFT,LLT
3063 ENDIF ! IF (IPT <= NPTG .AND. IR <= NPTR .AND. IS <= NPTS .AND.
3064 ELSEIF ((isolnod == 16.OR.(isolnod == 8 .AND.jhbe == 14))) THEN
3065c-----------
3066 icsig = iparg(17,ng)
3067 ir0=abs(pti)/2010
3068 is0=mod(abs(pti)/10,201)
3069 it0=mod(abs(pti),10)
3070 IF (ir0==0.OR.is0==0.OR.it0==0.OR.nlay<10) cycle
3071 ir = ir0
3072 is = is0
3073 it = it0
3074 IF (tshell == 1) THEN
3075 IF (icsig==100) THEN
3076 ir = is0
3077 is = it0
3078 it = ir0
3079 ELSEIF (icsig==10) THEN
3080 ir = it0
3081 is = ir0
3082 it = is0
3083 ELSE
3084 ir = ir0
3085 is = is0
3086 it = it0
3087 END IF
3088 ENDIF
3089 IF (ir>nptr.OR.is>npts) cycle
3090 ipt = ir + ( (is-1) + (it-1)*npts )*nptr
3091 IF (ipt <= npt ) THEN
3092 IF (isolnod == 16) THEN
3093 lbuf => elbuf_tab(ng)%BUFLY(is0)%LBUF(ir,1,it) ! TSHELL
3094 ELSE
3095 lbuf => elbuf_tab(ng)%BUFLY(it)%LBUF(ir,is,1) ! TSHELL
3096 END IF
3097 IF (mlw == 24) THEN
3098 DO i=lft,llt
3099 evar(1,i) = lbuf%PLA(jj(1) + i + nel)
3100 evar(2,i) = lbuf%PLA(jj(2) + i + nel)
3101 evar(3,i) = lbuf%PLA(jj(3) + i + nel)
3102 evar(4,i) = lbuf%PLA(jj(4) + i + nel)*half
3103 evar(5,i) = lbuf%PLA(jj(5) + i + nel)*half
3104 evar(6,i) = lbuf%PLA(jj(6) + i + nel)*half
3105 ENDDO
3106 ENDIF ! IF (MLW == 24) THEN
3107 ENDIF ! IF (IPT <= NPTG .AND. IR <= NPTR .AND. IS <= NPTS .AND. IT <= NPTT)
3108 IF (kcvt /= 0 .AND. jhbe /= 16) THEN
3109! PLASTIC STRAIN TENSOR IN GLOBAL SYSTEM
3110 icsig=iparg(17,ng)
3111 IF (jhbe == 14 .AND. icsig > 0) THEN
3112 SELECT CASE (icsig)
3113 CASE (1)
3114 DO i=lft,llt
3115 n = i + nft
3116 IF (el2fa(nn2+n) /= 0) THEN
3117 IF (kcvt == 2) THEN
3118 gama(1) = zero
3119 gama(2) = lbuf%GAMA(jj(1) + i)
3120 gama(3) = lbuf%GAMA(jj(2) + i)
3121 gama(4) = zero
3122 gama(5) =-gama(2)
3123 gama(6) = gama(1)
3124 ELSE
3125 gama(1) = one
3126 gama(2) = zero
3127 gama(3) = zero
3128 gama(4) = zero
3129 gama(5) = one
3130 gama(6) = zero
3131 ENDIF ! IF (KCVT == 2)
3132 CALL srota6(x, ixs(1,n), kcvt, evar(1,i), gama, jhbe, igtyp, isorth)
3133 ENDIF ! IF (EL2FA(NN2+N) /= 0)
3134 ENDDO ! DO I=LFT,LLT
3135 CASE (10)
3136 DO i=lft,llt
3137 n = i + nft
3138 IF (el2fa(nn2+n) /= 0) THEN
3139 IF (kcvt == 2) THEN
3140 gama(1) = lbuf%GAMA(jj(1) + i)
3141 gama(2) = lbuf%GAMA(jj(2) + i)
3142 gama(3) = zero
3143 gama(4) =-gama(2)
3144 gama(5) = gama(1)
3145 gama(6) = zero
3146 ELSE
3147 gama(1) = one
3148 gama(2) = zero
3149 gama(3) = zero
3150 gama(4) = zero
3151 gama(5) = one
3152 gama(6) = zero
3153 ENDIF ! IF (KCVT == 2)
3154 CALL srota6(x, ixs(1,n), kcvt, evar(1,i), gama, jhbe, igtyp, isorth)
3155 ENDIF ! IF (EL2FA(NN2+N) /= 0)
3156 ENDDO ! DO I=LFT,LLT
3157 CASE (100)
3158 DO i=lft,llt
3159 n = i + nft
3160 IF (el2fa(nn2+n) /= 0) THEN
3161 IF (kcvt == 2) THEN
3162 gama(1) = lbuf%GAMA(jj(2) + i)
3163 gama(2) = zero
3164 gama(3) = lbuf%GAMA(jj(1) + i)
3165 gama(4) = gama(3)
3166 gama(5) = zero
3167 gama(6) =-gama(1)
3168 ELSE
3169 gama(1) = one
3170 gama(2) = zero
3171 gama(3) = zero
3172 gama(4) = zero
3173 gama(5) = one
3174 gama(6) = zero
3175 ENDIF ! IF (KCVT == 2)
3176 CALL srota6(x, ixs(1,n), kcvt, evar(1,i), gama, jhbe, igtyp, isorth)
3177 ENDIF ! IF (EL2FA(NN2+N) /= 0)
3178 ENDDO ! DO I=LFT,LLT
3179 END SELECT
3180 ELSE ! (JHBE == 14 .AND. ICSIG > 0)
3181 DO i=lft,llt
3182 n = i + nft
3183 IF (el2fa(nn2+n) /= 0) THEN
3184 IF (kcvt == 2) THEN
3185 gama(1) = lbuf%GAMA(jj(1) + i)
3186 gama(2) = lbuf%GAMA(jj(2) + i)
3187 gama(3) = lbuf%GAMA(jj(3) + i)
3188 gama(4) = lbuf%GAMA(jj(4) + i)
3189 gama(5) = lbuf%GAMA(jj(5) + i)
3190 gama(6) = lbuf%GAMA(jj(6) + i)
3191 ELSE
3192 gama(1) = one
3193 gama(2) = zero
3194 gama(3) = zero
3195 gama(4) = zero
3196 gama(5) = one
3197 gama(6) = zero
3198 ENDIF !
3199 CALL srota6(x, ixs(1,n), kcvt, evar(1,i), gama, jhbe, igtyp, isorth)
3200 ENDIF ! IF (KCVT == 2)
3201 ENDDO ! DO I=LFT,LLT
3202 ENDIF !(JHBE == 14.AND.ICSIG > 0)
3203 ENDIF ! IF (KCVT /= 0 .AND. JHBE /= 16)
3204!
3205 ENDIF ! IF ((ISOLNOD == 16.OR.(ISOLNOD ==8 .AND.JHBE == 14).OR.
3206! . ((ISOLNOD == 6 .OR. ISOLNOD ==8).AND.JHBE == 15)).AND.
3207! . IGTYP == 22)
3208!
3209 ELSE ! (ITENS ...)
3210C-----------------------------------------------
3211C
3212C-----------------------------------------------
3213 ENDIF ! (ITENS)
3214C
3215c-----------
3216 IF (isolnod == 16) THEN
3217c-----------
3218 DO i=lft,llt
3219 n = i + nft
3220 IF(el2fa(nn2+n) /= 0)THEN
3221 tens(1,el2fa(nn2+n)) = evar(1,i)
3222 tens(2,el2fa(nn2+n)) = evar(2,i)
3223 tens(3,el2fa(nn2+n)) = evar(3,i)
3224 tens(4,el2fa(nn2+n)) = evar(4,i)
3225 tens(5,el2fa(nn2+n)) = evar(5,i)
3226 tens(6,el2fa(nn2+n)) = evar(6,i)
3227 tens(1,el2fa(nn2+n)+1) = evar(1,i)
3228 tens(2,el2fa(nn2+n)+1) = evar(2,i)
3229 tens(3,el2fa(nn2+n)+1) = evar(3,i)
3230 tens(4,el2fa(nn2+n)+1) = evar(4,i)
3231 tens(5,el2fa(nn2+n)+1) = evar(5,i)
3232 tens(6,el2fa(nn2+n)+1) = evar(6,i)
3233 tens(1,el2fa(nn2+n)+2) = evar(1,i)
3234 tens(2,el2fa(nn2+n)+2) = evar(2,i)
3235 tens(3,el2fa(nn2+n)+2) = evar(3,i)
3236 tens(4,el2fa(nn2+n)+2) = evar(4,i)
3237 tens(5,el2fa(nn2+n)+2) = evar(5,i)
3238 tens(6,el2fa(nn2+n)+2) = evar(6,i)
3239 tens(1,el2fa(nn2+n)+3) = evar(1,i)
3240 tens(2,el2fa(nn2+n)+3) = evar(2,i)
3241 tens(3,el2fa(nn2+n)+3) = evar(3,i)
3242 tens(4,el2fa(nn2+n)+3) = evar(4,i)
3243 tens(5,el2fa(nn2+n)+3) = evar(5,i)
3244 tens(6,el2fa(nn2+n)+3) = evar(6,i)
3245 ENDIF
3246 ENDDO
3247 ELSE
3248 DO i=lft,llt
3249 n = i + nft
3250 IF(el2fa(nn2+n) /= 0)THEN
3251 tens(1,el2fa(nn2+n)) = evar(1,i)
3252 tens(2,el2fa(nn2+n)) = evar(2,i)
3253 tens(3,el2fa(nn2+n)) = evar(3,i)
3254 tens(4,el2fa(nn2+n)) = evar(4,i)
3255 tens(5,el2fa(nn2+n)) = evar(5,i)
3256 tens(6,el2fa(nn2+n)) = evar(6,i)
3257 ENDIF
3258 ENDDO
3259 ENDIF
3260 isorthg = isorth ! for precaution
3261C-----------------------------------------------
3262 ELSEIF (isph3d == 1.AND.ity == 51) THEN
3263C-----------------------------------------------
3264C TETRAS SPH.
3265C-----------------------------------------------
3266 iprt=ipartsp(1 + nft)
3267 mt1 =ipart(1,iprt)
3268 gbuf => elbuf_tab(ng)%GBUF
3269 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
3270C-----------------------------------------------
3271C STRESS
3272 IF (itens == 1) THEN
3273C-----------------------------------------------
3274 IF(ivisc == 0) THEN
3275 DO i=lft,llt
3276 n = i + nft
3277 IF (el2fa(nn3+n) /= 0) THEN
3278 tens(1,el2fa(nn3+n)) = lbuf%SIG(jj(1) + i)
3279 tens(2,el2fa(nn3+n)) = lbuf%SIG(jj(2) + i)
3280 tens(3,el2fa(nn3+n)) = lbuf%SIG(jj(3) + i)
3281 tens(4,el2fa(nn3+n)) = lbuf%SIG(jj(4) + i)
3282 tens(5,el2fa(nn3+n)) = lbuf%SIG(jj(5) + i)
3283 tens(6,el2fa(nn3+n)) = lbuf%SIG(jj(6) + i)
3284 ENDIF
3285 ENDDO
3286 ELSE
3287 DO i=lft,llt
3288 n = i + nft
3289 IF (el2fa(nn3+n) /= 0) THEN
3290 tens(1,el2fa(nn3+n)) = lbuf%SIG(jj(1)+i) + lbuf%VISC(jj(1)+i)
3291 tens(2,el2fa(nn3+n)) = lbuf%SIG(jj(2)+i) + lbuf%VISC(jj(2)+i)
3292 tens(3,el2fa(nn3+n)) = lbuf%SIG(jj(3)+i) + lbuf%VISC(jj(3)+i)
3293 tens(4,el2fa(nn3+n)) = lbuf%SIG(jj(4)+i) + lbuf%VISC(jj(4)+i)
3294 tens(5,el2fa(nn3+n)) = lbuf%SIG(jj(5)+i) + lbuf%VISC(jj(5)+i)
3295 tens(6,el2fa(nn3+n)) = lbuf%SIG(jj(6)+i) + lbuf%VISC(jj(6)+i)
3296 ENDIF
3297 ENDDO
3298
3299 ENDIF
3300C-----------------------------------------------
3301C CRACKS
3302 ELSEIF(itens == 4.AND.mlw == 24 .AND. nint(pm(56,mt1)) == 1)THEN
3303C-----------------------------------------------
3304 DO i=lft,llt
3305 n = i + nft
3306 IF(el2fa(nn3+n) /= 0)THEN
3307 tens(1,el2fa(nn3+n)) = lbuf%DGLO(jj(1) + i)
3308 tens(2,el2fa(nn3+n)) = lbuf%DGLO(jj(2) + i)
3309 tens(3,el2fa(nn3+n)) = lbuf%DGLO(jj(3) + i)
3310 tens(4,el2fa(nn3+n)) = lbuf%DGLO(jj(4) + i)
3311 tens(5,el2fa(nn3+n)) = lbuf%DGLO(jj(5) + i)
3312 tens(6,el2fa(nn3+n)) = lbuf%DGLO(jj(6) + i)
3313 ENDIF
3314 ENDDO
3315C-----------------------------------------------
3316 ELSE
3317C-----------------------------------------------
3318 DO i=lft,llt
3319 n = i + nft
3320 IF (el2fa(nn3+n) /= 0) THEN
3321 tens(1,el2fa(nn3+n)) = zero
3322 tens(2,el2fa(nn3+n)) = zero
3323 tens(3,el2fa(nn3+n)) = zero
3324 tens(4,el2fa(nn3+n)) = zero
3325 tens(5,el2fa(nn3+n)) = zero
3326 tens(6,el2fa(nn3+n)) = zero
3327 ENDIF
3328 ENDDO
3329 ENDIF
3330C-----------------------------------------------
3331 ELSEIF (ity==101) THEN
3332C ISOGEOMETRIC ELEMENT
3333C-----------------------------------------------
3334 DO i=lft,llt
3335 n = i + nft
3336 evar(1,i) = zero
3337 evar(2,i) = zero
3338 evar(3,i) = zero
3339 evar(4,i) = zero
3340 evar(5,i) = zero
3341 evar(6,i) = zero
3342 ENDDO
3343C-----------------------------------------------
3344 DO i=lft,llt
3345 n = i + nft
3346 IF (el2fa(nn4+n) /= 0) THEN
3347 DO j=1,27
3348 tens(1,el2fa(nn4+n)+j-1) = evar(1,i)
3349 tens(2,el2fa(nn4+n)+j-1) = evar(1,i)
3350 tens(3,el2fa(nn4+n)+j-1) = evar(1,i)
3351 tens(4,el2fa(nn4+n)+j-1) = evar(1,i)
3352 tens(5,el2fa(nn4+n)+j-1) = evar(1,i)
3353 tens(6,el2fa(nn4+n)+j-1) = evar(1,i)
3354 ENDDO
3355 ENDIF
3356 ENDDO
3357C-----------------------------------------------
3358 ENDIF
3359 ENDIF ! mlw /= 13
3360 ENDDO ! next NG
3361
3362C-----------------------------------------------
3363 IF (nspmd == 1)THEN
3364 DO n=1,nbf
3365 r4(1) = tens(1,n)
3366 r4(2) = tens(2,n)
3367 r4(3) = tens(3,n)
3368 r4(4) = tens(4,n)
3369 r4(5) = tens(5,n)
3370 r4(6) = tens(6,n)
3371 CALL write_r_c(r4,6)
3372 ENDDO
3373 ELSE
3374 DO n = 1, nbf
3375 wa(6*n-5) = tens(1,n)
3376 wa(6*n-4) = tens(2,n)
3377 wa(6*n-3) = tens(3,n)
3378 wa(6*n-2) = tens(4,n)
3379 wa(6*n-1) = tens(5,n)
3380 wa(6*n ) = tens(6,n)
3381 ENDDO
3382 IF(ispmd == 0) THEN
3383 buf = numelsg*6 + numels16g*18+numsphg*6
3384 ELSE
3385 buf = 1
3386 ENDIF
3387 CALL spmd_r4get_partn(6,6*nbf,nbpart,iadg,wa,buf)
3388 ENDIF
3389C-----------------------------------------------
3390C-----------
3391 DEALLOCATE(wa)
3392 RETURN
3393 END SUBROUTINE tensors
3394!||====================================================================
3395!|| tensgps1 ../engine/source/output/anim/generate/tensor6.F
3396!||--- called by ------------------------------------------------------
3397!|| genani ../engine/source/output/anim/generate/genani.F
3398!|| h3d_nodal_tensor ../engine/source/output/h3d/h3d_results/h3d_nodal_tensor.F
3399!||--- calls -----------------------------------------------------
3400!|| initbuf ../engine/share/resol/initbuf.F
3401!|| shlrotg ../engine/source/output/anim/generate/tensor6.F
3402!|| srota6 ../engine/source/output/anim/generate/srota6.F
3403!||--- uses -----------------------------------------------------
3404!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
3405!|| element_mod ../common_source/modules/elements/element_mod.F90
3406!|| initbuf_mod ../engine/share/resol/initbuf.F
3407!||====================================================================
3408 SUBROUTINE tensgps1(FUNC1 ,FUNC2 ,IPARG ,GEO ,
3409 . IXS ,IXS10 ,IXS16 ,IXS20 ,IXQ ,
3410 . IXC ,IXTG ,IXT ,IXP ,IXR ,
3411 . X ,ITAGPS ,ELBUF_TAB)
3412C-----------------------------------------------
3413C M o d u l e s
3414C-----------------------------------------------
3415 USE initbuf_mod
3416 USE elbufdef_mod
3417 use element_mod , only : nixs,nixq,nixc,nixtg,nixr,nixt,nixp
3418C-----------------------------------------------
3419C I m p l i c i t T y p e s
3420C-----------------------------------------------
3421#include "implicit_f.inc"
3422C-----------------------------------------------
3423C C o m m o n B l o c k s
3424C-----------------------------------------------
3425#include "vect01_c.inc"
3426#include "mvsiz_p.inc"
3427#include "com01_c.inc"
3428#include "com04_c.inc"
3429#include "param_c.inc"
3430C-----------------------------------------------
3431C D u m m y A r g u m e n t s
3432C-----------------------------------------------
3433C REAL
3434 my_real
3435 . func1(3,*),func2(3,*),geo(npropg,*),x(3,*)
3436 INTEGER IPARG(NPARG,*),
3437 . IXS(NIXS,*),IXQ(NIXQ,*),IXC(NIXC,*),IXTG(NIXTG,*),
3438 . IXT(NIXT,*),IXP(NIXP,*),IXR(NIXR,*),
3439 . IXS10(6,*) ,IXS16(8,*) ,IXS20(12,*) ,ITAGPS(*)
3440 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
3441C-----------------------------------------------
3442C L o c a l V a r i a b l e s
3443C-----------------------------------------------
3444C REAL
3445 my_real
3446 . evar(6,mvsiz),gama(6),
3447 .
3448 . area(mvsiz)
3449 INTEGER I, NG, NEL,KCVT,
3450 . N, J, MLW,
3451 .
3452 . nn1,k,
3453 . isolnod,
3454 . nc(20,mvsiz),nnod,ihbe,
3455 . ivisc,jj(6)
3456 INTEGER MLW2
3457 TYPE(G_BUFEL_) ,POINTER :: GBUF
3458 TYPE(L_BUFEL_) ,POINTER :: LBUF
3459C=======================================================================
3460 DO 900 NG=1,ngroup
3461 gbuf => elbuf_tab(ng)%GBUF
3462 CALL initbuf(iparg ,ng ,
3463 2 mlw ,nel ,nft ,iad ,ity ,
3464 3 npt ,jale ,ismstr ,jeul ,jtur ,
3465 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
3466 5 nvaux ,jpor ,kcvt ,jclose ,jplasol ,
3467 6 irep ,iint ,igtyp ,israt ,isrot ,
3468 7 icsen ,isorth ,isorthg ,ifailure,jsms )
3469 mlw2 = mlw
3470 isolnod = iparg(28,ng)
3471 ivisc = iparg(61,ng)
3472 lft=1
3473 llt=nel
3474 nnod = 0
3475!
3476 DO i=1,6
3477 jj(i) = nel*(i-1)
3478 ENDDO
3479!
3480C-----------------------------------------------
3481C SOLID 8N
3482C-----------------------------------------------
3483 IF (ity == 1) THEN
3484C
3485 nnod = isolnod
3486 DO i=lft,llt
3487 n = i + nft
3488 IF(isolnod == 8)THEN
3489 DO j = 1,isolnod
3490 nc(j,i) = ixs(j+1,n)
3491 ENDDO
3492 ELSEIF(isolnod == 4)THEN
3493 nc(1,i)=ixs(2,n)
3494 nc(2,i)=ixs(4,n)
3495 nc(3,i)=ixs(7,n)
3496 nc(4,i)=ixs(6,n)
3497 ELSEIF(isolnod == 6)THEN
3498 nc(1,i)=ixs(2,n)
3499 nc(2,i)=ixs(3,n)
3500 nc(3,i)=ixs(4,n)
3501 nc(4,i)=ixs(6,n)
3502 nc(5,i)=ixs(7,n)
3503 nc(6,i)=ixs(8,n)
3504 ELSEIF(isolnod == 10)THEN
3505 nc(1,i)=ixs(2,n)
3506 nc(2,i)=ixs(4,n)
3507 nc(3,i)=ixs(7,n)
3508 nc(4,i)=ixs(6,n)
3509 nn1 = n - numels8
3510 DO j=1,6
3511c IF (IXS10(J,NN1)>0) THEN
3512 nc(j+4,i) = ixs10(j,nn1)
3513c ENDIF
3514 ENDDO
3515 ELSEIF(isolnod == 16)THEN
3516 DO j = 1,8
3517 nc(j,i) = ixs(j+1,n)
3518 ENDDO
3519 nn1 = n - (numels8+numels10+numels20)
3520 DO j=1,8
3521 nc(j+8,i) = ixs16(j,nn1)
3522 ENDDO
3523 ELSEIF(isolnod == 20)THEN
3524 DO j = 1,8
3525 nc(j,i) = ixs(j+1,n)
3526 ENDDO
3527 nn1 = n - (numels8+numels10)
3528 DO j=1,12
3529 nc(j+8,i) = ixs20(j,nn1)
3530 ENDDO
3531 ENDIF
3532 ENDDO
3533C----------
3534 IF (kcvt==1.AND.isorth/=0.AND.jhbe/=14
3535 . .AND.jhbe/=17.AND.jhbe/=15) kcvt=2
3536 DO i=lft,llt
3537 n = i + nft
3538 evar(1,i) = gbuf%SIG(jj(1) + i)
3539 evar(2,i) = gbuf%SIG(jj(2) + i)
3540 evar(3,i) = gbuf%SIG(jj(3) + i)
3541 evar(4,i) = gbuf%SIG(jj(4) + i)
3542 evar(5,i) = gbuf%SIG(jj(5) + i)
3543 evar(6,i) = gbuf%SIG(jj(6) + i)
3544 ENDDO
3545 IF(ivisc > 0) THEN
3546 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
3547 DO i=lft,llt
3548 evar(1,i) =evar(1,i)+ lbuf%VISC(jj(1) + i)
3549 evar(2,i) =evar(2,i)+ lbuf%VISC(jj(2) + i)
3550 evar(3,i) =evar(3,i)+ lbuf%VISC(jj(3) + i)
3551 evar(4,i) =evar(4,i)+ lbuf%VISC(jj(4) + i)
3552 evar(5,i) =evar(5,i)+ lbuf%VISC(jj(5) + i)
3553 evar(6,i) =evar(6,i)+ lbuf%VISC(jj(6) + i)
3554 ENDDO
3555 ENDIF
3556 IF (kcvt /= 0) THEN
3557C STRESS TENSOR -> GLOBAL SYSTEM
3558 DO i=lft,llt
3559 n = i + nft
3560 IF(kcvt==2)THEN
3561 gama(1)=gbuf%GAMA(jj(1) + i)
3562 gama(2)=gbuf%GAMA(jj(2) + i)
3563 gama(3)=gbuf%GAMA(jj(3) + i)
3564 gama(4)=gbuf%GAMA(jj(4) + i)
3565 gama(5)=gbuf%GAMA(jj(5) + i)
3566 gama(6)=gbuf%GAMA(jj(6) + i)
3567 ELSE
3568 gama(1)=one
3569 gama(2)=zero
3570 gama(3)=zero
3571 gama(4)=zero
3572 gama(5)=one
3573 gama(6)=zero
3574 END IF
3575 CALL srota6(x, ixs(1,n), kcvt, evar(1,i),gama, jhbe, igtyp, isorth)
3576 ENDDO
3577 ENDIF
3578C-----------------------------------------------
3579C QUAD
3580C-----------------------------------------------
3581 ELSEIF (ity == 2)THEN
3582C-----------------------------------------------
3583C COQUES 3 N 4 N
3584C-----------------------------------------------
3585 ELSEIF(ity == 3.OR.ity == 7)THEN
3586 IF(ity == 7)THEN
3587 nnod=3
3588 DO i=lft,llt
3589 n = i + nft
3590 DO j = 1,nnod
3591 nc(j,i) = ixtg(j+1,n)
3592 ENDDO
3593 ENDDO
3594 ELSEIF(ity == 3)THEN
3595 nnod=4
3596 DO i=lft,llt
3597 n = i + nft
3598 DO j = 1,nnod
3599 nc(j,i) = ixc(j+1,n)
3600 ENDDO
3601 ENDDO
3602 ENDIF
3603C-----------membrane terms only ------
3604 DO i=lft,llt
3605 evar(1,i) = gbuf%FOR(jj(1)+i)
3606 evar(2,i) = gbuf%FOR(jj(2)+i)
3607 evar(3,i) = zero
3608 evar(4,i) = gbuf%FOR(jj(3)+i)
3609 evar(5,i) = gbuf%FOR(jj(4)+i)
3610 evar(6,i) = gbuf%FOR(jj(5)+i)
3611 ENDDO
3612 CALL shlrotg(lft ,llt ,nft ,x ,evar ,
3613 1 ity ,ixc ,ixtg ,ihbe ,area )
3614C-----------------------------------------------
3615C TRUSS
3616C-----------------------------------------------
3617 ELSEIF(ity == 4)THEN
3618C-----------------------
3619C 5. ELEMENTS POUTRES
3620C-----------------------
3621 ELSEIF(ity == 5)THEN
3622 ENDIF
3623C
3624 DO i=lft,llt
3625 DO j = 1,nnod
3626 n = nc(j,i)
3627 IF (n>0)THEN
3628 DO k = 1,3
3629 func1(k,n) = func1(k,n)+evar(k,i)
3630 func2(k,n) = func2(k,n)+evar(k+3,i)
3631 ENDDO
3632 itagps(n) = itagps(n)+1
3633 ENDIF
3634 ENDDO
3635 ENDDO
3636 900 CONTINUE
3637C-----------------------------------------------
3638 RETURN
3639 END SUBROUTINE tensgps1
3640!||====================================================================
3641!|| tensgps2 ../engine/source/output/anim/generate/tensor6.F
3642!||--- called by ------------------------------------------------------
3643!|| genani ../engine/source/output/anim/generate/genani.F
3644!|| h3d_nodal_tensor ../engine/source/output/h3d/h3d_results/h3d_nodal_tensor.F
3645!||--- calls -----------------------------------------------------
3646!|| initbuf ../engine/share/resol/initbuf.F
3647!|| shlrotg ../engine/source/output/anim/generate/tensor6.F
3648!|| srota6 ../engine/source/output/anim/generate/srota6.F
3649!||--- uses -----------------------------------------------------
3650!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
3651!|| element_mod ../common_source/modules/elements/element_mod.F90
3652!|| initbuf_mod ../engine/share/resol/initbuf.F
3653!||====================================================================
3654 SUBROUTINE tensgps2(FUNC1 ,FUNC2 ,IPARG ,GEO ,
3655 . IXS ,IXS10 ,IXS16 ,IXS20 ,IXQ ,
3656 . IXC ,IXTG ,IXT ,IXP ,IXR ,
3657 . X ,VGPS ,ELBUF_TAB)
3658C-----------------------------------------------
3659C M o d u l e s
3660C-----------------------------------------------
3661 USE initbuf_mod
3662 USE elbufdef_mod
3663 use element_mod , only : nixs,nixq,nixc,nixtg,nixr,nixt,nixp
3664C-----------------------------------------------
3665C I m p l i c i t T y p e s
3666C-----------------------------------------------
3667#include "implicit_f.inc"
3668C-----------------------------------------------
3669C C o m m o n B l o c k s
3670C-----------------------------------------------
3671#include "vect01_c.inc"
3672#include "mvsiz_p.inc"
3673#include "com01_c.inc"
3674#include "com04_c.inc"
3675#include "param_c.inc"
3676C-----------------------------------------------
3677C D u m m y A r g u m e n t s
3678C-----------------------------------------------
3679C REAL
3680 my_real
3681 . func1(3,*),func2(3,*),geo(npropg,*),x(3,*),vgps(*)
3682 INTEGER IPARG(NPARG,*),
3683 . IXS(NIXS,*),IXQ(NIXQ,*),IXC(NIXC,*),IXTG(NIXTG,*),
3684 . IXT(NIXT,*),IXP(NIXP,*),IXR(NIXR,*),
3685 . IXS10(6,*) ,IXS16(8,*) ,IXS20(12,*)
3686 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
3687C-----------------------------------------------
3688C L o c a l V a r i a b l e s
3689C-----------------------------------------------
3690C REAL
3691 my_real
3692 . evar(6,mvsiz),gama(6),vol(mvsiz),thk0,
3693 . off,
3694 . area(mvsiz)
3695 INTEGER I, NG, NEL,KCVT,
3696 . N, J, MLW,
3697 .
3698 . NN1,K,
3699 . ISOLNOD,
3700 . nc(20,mvsiz),nnod,ihbe,
3701 . ivisc,jj(6)
3702 INTEGER MLW2
3703 TYPE(G_BUFEL_) ,POINTER :: GBUF
3704 TYPE(l_bufel_) ,POINTER :: LBUF
3705C=======================================================================
3706 DO 900 NG=1,ngroup
3707 CALL initbuf(iparg ,ng ,
3708 2 mlw ,nel ,nft ,iad ,ity ,
3709 3 npt ,jale ,ismstr ,jeul ,jtur ,
3710 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
3711 5 nvaux ,jpor ,kcvt ,jclose ,jplasol ,
3712 6 irep ,iint ,igtyp ,israt ,isrot ,
3713 7 icsen ,isorth ,isorthg ,ifailure,jsms )
3714 mlw2 = mlw
3715 isolnod = iparg(28,ng)
3716 ivisc = iparg(61,ng)
3717 lft=1
3718 llt=nel
3719 nnod = 0
3720!
3721 DO i=1,6
3722 jj(i) = nel*(i-1)
3723 ENDDO
3724!
3725C-----------------------------------------------
3726C SOLID 8N
3727C-----------------------------------------------
3728 IF (ity == 1) THEN
3729 gbuf => elbuf_tab(ng)%GBUF
3730 nnod = isolnod
3731 DO i=lft,llt
3732 n = i + nft
3733 IF(isolnod == 8)THEN
3734 DO j = 1,isolnod
3735 nc(j,i) = ixs(j+1,n)
3736 ENDDO
3737 ELSEIF(isolnod == 4)THEN
3738 nc(1,i)=ixs(2,n)
3739 nc(2,i)=ixs(4,n)
3740 nc(3,i)=ixs(7,n)
3741 nc(4,i)=ixs(6,n)
3742 ELSEIF(isolnod == 6)THEN
3743 nc(1,i)=ixs(2,n)
3744 nc(2,i)=ixs(3,n)
3745 nc(3,i)=ixs(4,n)
3746 nc(4,i)=ixs(6,n)
3747 nc(5,i)=ixs(7,n)
3748 nc(6,i)=ixs(8,n)
3749 ELSEIF(isolnod == 10)THEN
3750 nc(1,i)=ixs(2,n)
3751 nc(2,i)=ixs(4,n)
3752 nc(3,i)=ixs(7,n)
3753 nc(4,i)=ixs(6,n)
3754 nn1 = n - numels8
3755 DO j=1,6
3756c IF (IXS10(J,NN1)>0) THEN
3757 nc(j+4,i) = ixs10(j,nn1)
3758c ENDIF
3759 ENDDO
3760 ELSEIF(isolnod == 16)THEN
3761 DO j = 1,8
3762 nc(j,i) = ixs(j+1,n)
3763 ENDDO
3764 nn1 = n - (numels8+numels10+numels20)
3765 DO j=1,8
3766 nc(j+8,i) = ixs16(j,nn1)
3767 ENDDO
3768 ELSEIF(isolnod == 20)THEN
3769 DO j = 1,8
3770 nc(j,i) = ixs(j+1,n)
3771 ENDDO
3772 nn1 = n - (numels8+numels10)
3773 DO j=1,12
3774 nc(j+8,i) = ixs20(j,nn1)
3775 ENDDO
3776 ENDIF
3777 off = min(gbuf%OFF(i),one)
3778 vol(i) = gbuf%VOL(i)*off
3779 ENDDO
3780C
3781 IF (kcvt==1.AND.isorth/=0.AND.jhbe/=14
3782 . .AND.jhbe/=17.AND.jhbe/=15) kcvt=2
3783 DO i=lft,llt
3784 n = i + nft
3785 evar(1,i) = gbuf%SIG(jj(1) + i)
3786 evar(2,i) = gbuf%SIG(jj(2) + i)
3787 evar(3,i) = gbuf%SIG(jj(3) + i)
3788 evar(4,i) = gbuf%SIG(jj(4) + i)
3789 evar(5,i) = gbuf%SIG(jj(5) + i)
3790 evar(6,i) = gbuf%SIG(jj(6) + i)
3791 ENDDO
3792 IF(ivisc > 0) THEN
3793 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
3794 DO i=lft,llt
3795 evar(1,i) =evar(1,i)+ lbuf%VISC(jj(1) + i)
3796 evar(2,i) =evar(2,i)+ lbuf%VISC(jj(2) + i)
3797 evar(3,i) =evar(3,i)+ lbuf%VISC(jj(3) + i)
3798 evar(4,i) =evar(4,i)+ lbuf%VISC(jj(4) + i)
3799 evar(5,i) =evar(5,i)+ lbuf%VISC(jj(5) + i)
3800 evar(6,i) =evar(6,i)+ lbuf%VISC(jj(6) + i)
3801 ENDDO
3802 ENDIF
3803 IF (kcvt /= 0) THEN
3804C STRESS TENSOR -> GLOBAL SYSTEM
3805 DO i=lft,llt
3806 n = i + nft
3807 IF(kcvt==2)THEN
3808 gama(1) = gbuf%GAMA(jj(1) + i)
3809 gama(2) = gbuf%GAMA(jj(2) + i)
3810 gama(3) = gbuf%GAMA(jj(3) + i)
3811 gama(4) = gbuf%GAMA(jj(4) + i)
3812 gama(5) = gbuf%GAMA(jj(5) + i)
3813 gama(6) = gbuf%GAMA(jj(6) + i)
3814 ELSE
3815 gama(1)=one
3816 gama(2)=zero
3817 gama(3)=zero
3818 gama(4)=zero
3819 gama(5)=one
3820 gama(6)=zero
3821 END IF
3822 CALL srota6(x, ixs(1,n), kcvt, evar(1,i),gama, jhbe, igtyp, isorth)
3823 ENDDO
3824 ENDIF
3825C-----------------------------------------------
3826C QUAD
3827C-----------------------------------------------
3828 ELSEIF(ity == 2)THEN
3829C-----------------------------------------------
3830C COQUES 3 N 4 N
3831C-----------------------------------------------
3832 ELSEIF(ity == 3.OR.ity == 7)THEN
3833 gbuf => elbuf_tab(ng)%GBUF
3834C-----------membrane terms only ------
3835 DO i=lft,llt
3836 evar(1,i) = gbuf%FOR(jj(1)+i)
3837 evar(2,i) = gbuf%FOR(jj(2)+i)
3838 evar(3,i) = zero
3839 evar(4,i) = gbuf%FOR(jj(3)+i)
3840 evar(5,i) = gbuf%FOR(jj(4)+i)
3841 evar(6,i) = gbuf%FOR(jj(5)+i)
3842 ENDDO
3843 CALL shlrotg(lft ,llt ,nft ,x ,evar ,
3844 1 ity ,ixc ,ixtg ,ihbe ,area )
3845 IF(ity == 7)THEN
3846 nnod=3
3847 DO i=lft,llt
3848 n = i + nft
3849 DO j = 1,nnod
3850 nc(j,i) = ixtg(j+1,n)
3851 ENDDO
3852 thk0 = geo(1,ixtg(5,n))
3853 off = min(gbuf%OFF(i),one)
3854 vol(i) = thk0*area(i)*off
3855 ENDDO
3856 ELSEIF(ity == 3)THEN
3857 nnod=4
3858 DO i=lft,llt
3859 n = i + nft
3860 DO j = 1,nnod
3861 nc(j,i) = ixc(j+1,n)
3862 ENDDO
3863 thk0 = geo(1,ixc(6,n))
3864 off = min(gbuf%OFF(i),one)
3865 vol(i) = thk0*area(i)*off
3866 ENDDO
3867 ENDIF
3868C-----------------------------------------------
3869C TRUSS
3870C-----------------------------------------------
3871 ELSEIF(ity == 4)THEN
3872C-----------------------
3873C 5. ELEMENTS POUTRES
3874C-----------------------
3875 ELSEIF(ity == 5)THEN
3876 ENDIF
3877C-----------------------------------------------
3878 DO i=lft,llt
3879 DO j = 1,nnod
3880 n = nc(j,i)
3881 IF (n>0)THEN
3882 DO k = 1,3
3883 func1(k,n) = func1(k,n)+evar(k,i)*vol(i)
3884 func2(k,n) = func2(k,n)+evar(k+3,i)*vol(i)
3885 ENDDO
3886 vgps(n) = vgps(n)+vol(i)
3887 ENDIF
3888 ENDDO
3889 ENDDO
3890 900 CONTINUE
3891C-----------
3892 RETURN
3893 END SUBROUTINE tensgps2
3894!||====================================================================
3895!|| tensgps3 ../engine/source/output/anim/generate/tensor6.F
3896!||--- called by ------------------------------------------------------
3897!|| genani ../engine/source/output/anim/generate/genani.F
3898!|| gps_solid ../engine/source/output/outmaxsubr.F
3899!|| h3d_nodal_tensor ../engine/source/output/h3d/h3d_results/h3d_nodal_tensor.F
3900!||--- calls -----------------------------------------------------
3901!|| initbuf ../engine/share/resol/initbuf.F
3902!|| pre_heph ../engine/source/output/anim/generate/tensor6.F
3903!|| srota6 ../engine/source/output/anim/generate/srota6.F
3904!|| szsigpara ../engine/source/elements/solid/solidez/szsigpara.F
3905!||--- uses -----------------------------------------------------
3906!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
3907!|| element_mod ../common_source/modules/elements/element_mod.F90
3908!|| initbuf_mod ../engine/share/resol/initbuf.F
3909!|| my_alloc_mod ../common_source/tools/memory/my_alloc.F90
3910!|| outmax_mod ../common_source/modules/outmax_mod.F
3911!||====================================================================
3912 SUBROUTINE tensgps3(ELBUF_TAB,FUNC1 ,FUNC2 ,IPARG ,GEO ,
3913 . IXS ,IXS10 ,IXS16 ,IXS20 ,IXQ ,
3914 . IXC ,IXTG ,IXT ,IXP ,IXR ,
3915 . X ,ITAGPS ,PM )
3916C-----------------------------------------------
3917C M o d u l e s
3918C-----------------------------------------------
3919 USE initbuf_mod
3920 USE elbufdef_mod
3921 USE outmax_mod
3922 USE my_alloc_mod
3923 use element_mod , only : nixs,nixq,nixc,nixtg,nixr,nixt,nixp
3924C-----------------------------------------------
3925C I m p l i c i t T y p e s
3926C-----------------------------------------------
3927#include "implicit_f.inc"
3928C-----------------------------------------------
3929C C o m m o n B l o c k s
3930C-----------------------------------------------
3931#include "vect01_c.inc"
3932#include "mvsiz_p.inc"
3933#include "com01_c.inc"
3934#include "com04_c.inc"
3935#include "param_c.inc"
3936C-----------------------------------------------
3937C D u m m y A r g u m e n t s
3938C-----------------------------------------------
3939C REAL
3940 my_real
3941 . func1(3,*),func2(3,*),geo(npropg,*),x(3,*),
3942 . pm(npropm,*)
3943 INTEGER IPARG(NPARG,*),
3944 . IXS(NIXS,*),IXQ(NIXQ,*),IXC(NIXC,*),IXTG(NIXTG,*),
3945 . IXT(NIXT,*),IXP(NIXP,*),IXR(NIXR,*),
3946 . IXS10(6,*) ,IXS16(8,*) ,IXS20(12,*) ,ITAGPS(*)
3947 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
3948C-----------------------------------------------
3949C L o c a l V a r i a b l e s
3950C-----------------------------------------------
3951C REAL
3952 my_real :: gama(6),
3953 .
3954 .
3955 . a_gauss_r,a_gauss_s,a_gauss_t,n1,
3956 . a_gauss_r1,a_gauss_s1,a_gauss_t1,
3957 . a_gauss_p_r,a_gauss_p_s,a_gauss_p_t,
3958 . ksi,eta,zeta
3959 my_real,ALLOCATABLE,DIMENSION(:,:) :: evar
3960 INTEGER I, NG, NEL,KCVT,
3961 . N, J, MLW,
3962 .
3963 . NN1,K,
3964 . isolnod, nptr, npts, nptt,
3965 . is, ir, it,nc(20,mvsiz),nnod,ilay,
3966 . icsig,ivisc,jj(6),mat(mvsiz)
3967 INTEGER MLW2,NLAY
3968 TYPE(G_BUFEL_) ,POINTER :: GBUF
3969 TYPE(L_BUFEL_) ,POINTER :: LBUF
3970 my_real
3971 . a_gauss(9,9),evar_tmp(6),alpha,beta,alpha_1,beta_1,
3972 . jr0(mvsiz),js0(mvsiz),jt0(mvsiz),nu(mvsiz),sig_hour(mvsiz,6),
3973 .
3974 .
3975 .
3976 .
3977 .
3978 .
3979 .
3980 .
3981 .
3982 .
3983 .
3984 . evar_t10(6,10),a_heph(3,8)
3985 INTEGER SOL_NODE(3,8), IPERM1(10),IPERM2(10),NN2,ITSH
3986 DATA IPERM1/0,0,0,0,1,2,3,1,2,3/
3987 DATA IPERM2/0,0,0,0,2,3,1,4,4,4/
3988C=======================================================================
3989 DATA A_GAUSS /
3990 1 0. ,0. ,0. ,
3991 1 0. ,0. ,0. ,
3992 1 0. ,0. ,0. ,
3993 2 -.577350269189626,0.577350269189626,0. ,
3994 2 0. ,0. ,0. ,
3995 2 0. ,0. ,0. ,
3996 3 -.774596669241483,0. ,0.774596669241483,
3997 3 0. ,0. ,0. ,
3998 3 0. ,0. ,0. ,
3999 4 -.861136311594053,-.339981043584856,0.339981043584856,
4000 4 0.861136311594053,0. ,0. ,
4001 4 0. ,0. ,0. ,
4002 5 -.906179845938664,-.538469310105683,0. ,
4003 5 0.538469310105683,0.906179845938664,0. ,
4004 5 0. ,0. ,0. ,
4005 6 -.932469514203152,-.661209386466265,-.238619186083197,
4006 6 0.238619186083197,0.661209386466265,0.932469514203152,
4007 6 0. ,0. ,0. ,
4008 7 -.949107912342759,-.741531185599394,-.405845151377397,
4009 7 0. ,0.405845151377397,0.741531185599394,
4010 7 0.949107912342759,0. ,0. ,
4011 8 -.960289856497536,-.796666477413627,-.525532409916329,
4012 8 -.183434642495650,0.183434642495650,0.525532409916329,
4013 8 0.796666477413627,0.960289856497536,0. ,
4014 9 -.968160239507626,-.836031107326636,-.613371432700590,
4015 9 -.324253423403809,0. ,0.324253423403809,
4016 9 0.613371432700590,0.836031107326636,0.968160239507626/
4017 DATA sol_node /
4018 1 -1 ,-1 ,-1 ,
4019 2 -1 ,-1 , 1 ,
4020 3 1 ,-1 , 1 ,
4021 4 1 ,-1 ,-1 ,
4022 5 -1 , 1 ,-1 ,
4023 6 -1 , 1 , 1 ,
4024 7 1 , 1 , 1 ,
4025 8 1 , 1 ,-1 /
4026C-----Nj : KSI,ETA,ZETA
4027 DATA a_heph /
4028 1 -1 ,-1 ,-1 ,
4029 4 1 ,-1 ,-1 ,
4030 5 -1 , 1 ,-1 ,
4031 8 1 , 1 ,-1 ,
4032 2 -1 ,-1 , 1 ,
4033 3 1 ,-1 , 1 ,
4034 7 1 , 1 , 1 ,
4035 6 -1 , 1 , 1 /
4036C=======================================================================
4037 alpha = zep1381966
4038 beta = zep5854102
4039 CALL my_alloc(evar,6,numnod)
4040 DO i=1,numnod
4041 evar(1,i) = zero
4042 evar(2,i) = zero
4043 evar(3,i) = zero
4044 evar(4,i) = zero
4045 evar(5,i) = zero
4046 evar(6,i) = zero
4047 ENDDO
4048 DO 900 ng=1,ngroup
4049 IF (lmax_nsig >0 .AND. ipart_ok(ng,1)==0) cycle
4050 ivisc = iparg(61,ng)
4051 gbuf => elbuf_tab(ng)%GBUF
4052 CALL initbuf(iparg ,ng ,
4053 2 mlw ,nel ,nft ,iad ,ity ,
4054 3 npt ,jale ,ismstr ,jeul ,jtur ,
4055 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
4056 5 nvaux ,jpor ,kcvt ,jclose ,jplasol ,
4057 6 irep ,iint ,igtyp ,israt ,isrot ,
4058 7 icsen ,isorth ,isorthg ,ifailure,jsms )
4059 mlw2 = mlw
4060 IF (iparg(8,ng)==1.OR.mlw==0.OR.mlw==13) cycle
4061 icsig=iparg(17,ng)
4062 isolnod = iparg(28,ng)
4063 lft=1
4064 llt=nel
4065 nnod = 0
4066!
4067 DO i=1,6
4068 jj(i) = nel*(i-1)
4069 ENDDO
4070!
4071C-----------------------------------------------
4072C SOLID 8N
4073C-----------------------------------------------
4074 IF (ity == 1) THEN
4075 gbuf => elbuf_tab(ng)%GBUF
4076 IF (kcvt==1.AND.isorth/=0) kcvt=2
4077 nnod = isolnod
4078 DO i=lft,llt
4079 n = i + nft
4080 IF(isolnod == 8)THEN
4081 DO j = 1,isolnod
4082 nc(j,i) = ixs(j+1,n)
4083 ENDDO
4084 ELSEIF(isolnod == 4)THEN
4085 nc(1,i)=ixs(2,n)
4086 nc(2,i)=ixs(4,n)
4087 nc(3,i)=ixs(7,n)
4088 nc(4,i)=ixs(6,n)
4089 ELSEIF(isolnod == 6)THEN
4090 nc(1,i)=ixs(2,n)
4091 nc(2,i)=ixs(3,n)
4092 nc(3,i)=ixs(4,n)
4093 nc(4,i)=ixs(6,n)
4094 nc(5,i)=ixs(7,n)
4095 nc(6,i)=ixs(8,n)
4096 ELSEIF(isolnod == 10)THEN
4097 nc(1,i)=ixs(2,n)
4098 nc(2,i)=ixs(4,n)
4099 nc(3,i)=ixs(7,n)
4100 nc(4,i)=ixs(6,n)
4101 nn1 = n - numels8
4102 DO j=1,6
4103 nc(j+4,i) = ixs10(j,nn1)
4104 ENDDO
4105 ELSEIF(isolnod == 16)THEN
4106 DO j = 1,8
4107 nc(j,i) = ixs(j+1,n)
4108 ENDDO
4109 nn1 = n - (numels8+numels10+numels20)
4110 DO j=1,8
4111 nc(j+8,i) = ixs16(j,nn1)
4112 ENDDO
4113 ELSEIF(isolnod == 20)THEN
4114 DO j = 1,8
4115 nc(j,i) = ixs(j+1,n)
4116 ENDDO
4117 nn1 = n - (numels8+numels10)
4118 DO j=1,12
4119 nc(j+8,i) = ixs20(j,nn1)
4120 ENDDO
4121 ENDIF
4122 ENDDO
4123C
4124 nptr = elbuf_tab(ng)%NPTR
4125 npts = elbuf_tab(ng)%NPTS
4126 nptt = elbuf_tab(ng)%NPTT
4127 nlay = elbuf_tab(ng)%NLAY
4128 npt = nptr*npts*nptt
4129 nnod = isolnod
4130 sig_hour = zero
4131 IF (jhbe == 24) THEN
4132 CALL pre_heph(x,ixs,jr0,js0,jt0,pm,mat,nu,nft,nel)
4133 ENDIF
4134 IF(igtyp == 20 .OR. igtyp ==21 .OR. igtyp == 22) THEN
4135 itsh=1
4136 ELSE
4137 itsh=0
4138 ENDIF
4139C----------
4140 IF (isolnod == 8.AND. jhbe<9)THEN
4141c
4142 DO i=lft,llt
4143 n = i + nft
4144 IF (kcvt /= 0) THEN
4145 IF(kcvt==2)THEN
4146 gama(1:6) = gbuf%GAMA(jj(1:6) + i)
4147 ELSE
4148 gama(1)=one
4149 gama(2)=zero
4150 gama(3)=zero
4151 gama(4)=zero
4152 gama(5)=one
4153 gama(6)=zero
4154 END IF
4155 END IF
4156 n1 = one
4157 ilay = 1
4158 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(1,1,1)
4159 evar_tmp(1:6) = gbuf%SIG(jj(1:6) + i)
4160 IF(ivisc > 0) THEN
4161 evar_tmp(1:6) =evar_tmp(1:6)+ lbuf%VISC(jj(1:6) + i)
4162 ENDIF
4163 IF (kcvt /= 0)CALL srota6(x, ixs(1,n),kcvt, evar_tmp,gama, jhbe, igtyp, isorth)
4164 DO j=1,8
4165 evar(1:6,nc(j,i)) = evar(1:6,nc(j,i)) + evar_tmp(1:6)
4166 ENDDO
4167 ENDDO
4168 ELSEIF(isolnod == 6 .OR. isolnod == 8 .OR. isolnod == 16 .OR. isolnod == 20)THEN
4169c
4170! T_SHELL ( JHBE = 15/16 )
4171 IF(itsh>0 .AND. jhbe /= 14) THEN
4172 DO i=lft,llt
4173 n = i + nft
4174 IF (kcvt /= 0) THEN
4175 IF(kcvt==2)THEN
4176 gama(1) = gbuf%GAMA(jj(1) + i)
4177 gama(2) = gbuf%GAMA(jj(2) + i)
4178 gama(3) = gbuf%GAMA(jj(3) + i)
4179 gama(4) = gbuf%GAMA(jj(4) + i)
4180 gama(5) = gbuf%GAMA(jj(5) + i)
4181 gama(6) = gbuf%GAMA(jj(6) + i)
4182 ELSE
4183 gama(1)=one
4184 gama(2)=zero
4185 gama(3)=zero
4186 gama(4)=zero
4187 gama(5)=one
4188 gama(6)=zero
4189 END IF
4190 END IF
4191 npts = nlay
4192C
4193 DO j=1,min(8,isolnod)
4194 DO k=1,min(8,isolnod)
4195 IF(sol_node(2,k) == sol_node(2,j)) THEN
4196c
4197 IF (sol_node(1,k) == -1 .AND. sol_node(1,j) == -1)
4198 . ir = 1
4199 IF (sol_node(1,k) == -1 .AND. sol_node(1,j) == 1)
4200 . ir = max(1,nptr-1)
4201 IF (sol_node(1,k) == 1 .AND. sol_node(1,j) == 1)
4202 . ir = nptr
4203 IF (sol_node(1,k) == 1 .AND. sol_node(1,j) == -1)
4204 . ir = min(nptr,2)
4205 IF (sol_node(2,k) == -1 .AND. sol_node(2,j) == -1)
4206 . is = 1
4207 IF (sol_node(2,k) == -1 .AND. sol_node(2,j) == 1)
4208 . is = max(1,npts-1)
4209 IF (sol_node(2,k) == 1 .AND. sol_node(2,j) == 1)
4210 . is = npts
4211 IF (sol_node(2,k) == 1 .AND. sol_node(2,j) == -1)
4212 . is = min(npts,2)
4213 IF (sol_node(3,k) == -1 .AND. sol_node(3,j) == -1)
4214 . it = 1
4215 IF (sol_node(3,k) == -1 .AND. sol_node(3,j) == 1)
4216 . it = max(1,nptt-1)
4217 IF (sol_node(3,k) == 1 .AND. sol_node(3,j) == 1)
4218 . it = nptt
4219 IF (sol_node(3,k) == 1 .AND. sol_node(3,j) == -1)
4220 . it = min(nptt,2)
4221c
4222 a_gauss_p_r = zero
4223 a_gauss_p_s = zero
4224 a_gauss_p_t = zero
4225c
4226 IF (nptr == 1)THEN
4227 a_gauss_p_r = zero
4228 ELSEIF (sol_node(1,j) == -1 )THEN
4229 a_gauss_r = a_gauss(1,nptr)
4230 a_gauss_r1 = a_gauss(2,nptr)
4231 a_gauss_p_r =
4232 . (-one-half*(a_gauss_r1+a_gauss_r))/
4233 . (half*(a_gauss_r1-a_gauss_r))
4234 ELSEIF(sol_node(1,j) == 1 )THEN
4235 a_gauss_r = a_gauss(nptr-1,nptr)
4236 a_gauss_r1 = a_gauss(nptr,nptr)
4237 a_gauss_p_r =
4238 . (one+half*(a_gauss_r1+a_gauss_r))/
4239 . (half*(a_gauss_r1-a_gauss_r))
4240 ENDIF
4241c
4242 IF (npts == 1)THEN
4243 a_gauss_p_s = zero
4244 ELSEIF (sol_node(2,j) == -1 )THEN
4245 a_gauss_s = a_gauss(1,npts)
4246 a_gauss_s1 = a_gauss(2,npts)
4247 a_gauss_p_s =
4248 . (-one-half*(a_gauss_s1+a_gauss_s))/
4249 . (half*(a_gauss_s1-a_gauss_s))
4250 ELSEIF(sol_node(2,j) == 1 )THEN
4251 a_gauss_s = a_gauss(npts-1,npts)
4252 a_gauss_s1 = a_gauss(npts,npts)
4253 a_gauss_p_s =
4254 . (one+half*(a_gauss_s1+a_gauss_s))/
4255 . (half*(a_gauss_s1-a_gauss_s))
4256 ENDIF
4257c
4258 IF (nptt == 1)THEN
4259 a_gauss_p_t = zero
4260 ELSEIF (sol_node(3,j) == -1 )THEN
4261 a_gauss_t = a_gauss(1,nptt)
4262 a_gauss_t1 = a_gauss(2,nptt)
4263 a_gauss_p_t =
4264 . (-one-half*(a_gauss_t1+a_gauss_t))/
4265 . (half*(a_gauss_t1-a_gauss_t))
4266 ELSEIF(sol_node(3,j) == 1 )THEN
4267 a_gauss_t = a_gauss(nptt-1,nptt)
4268 a_gauss_t1 = a_gauss(nptt,nptt)
4269 a_gauss_p_t =
4270 . (one+half*(a_gauss_t1+a_gauss_t))/
4271 . (half*(a_gauss_t1-a_gauss_t))
4272 ENDIF
4273c
4274 IF (jhbe == 15 .OR. jhbe == 16) THEN
4275 ilay = is
4276 is = 1
4277 n1 = fourth*(
4278 . (one+sol_node(1,k) * a_gauss_p_r) *
4279 . (one+sol_node(3,k) * a_gauss_p_t) )
4280 ENDIF
4281c
4282 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
4283 evar_tmp(1) = lbuf%SIG(jj(1) + i)
4284 evar_tmp(2) = lbuf%SIG(jj(2) + i)
4285 evar_tmp(3) = lbuf%SIG(jj(3) + i)
4286 evar_tmp(4) = lbuf%SIG(jj(4) + i)
4287 evar_tmp(5) = lbuf%SIG(jj(5) + i)
4288 evar_tmp(6) = lbuf%SIG(jj(6) + i)
4289 IF(ivisc > 0) THEN
4290 evar_tmp(1) = evar_tmp(1) + lbuf%VISC(jj(1) + i)
4291 evar_tmp(2) = evar_tmp(2) + lbuf%VISC(jj(2) + i)
4292 evar_tmp(3) = evar_tmp(3) + lbuf%VISC(jj(3) + i)
4293 evar_tmp(4) = evar_tmp(4) + lbuf%VISC(jj(4) + i)
4294 evar_tmp(5) = evar_tmp(5) + lbuf%VISC(jj(5) + i)
4295 evar_tmp(6) = evar_tmp(6) + lbuf%VISC(jj(6) + i)
4296 ENDIF
4297 IF (kcvt /= 0) CALL srota6(x, ixs(1,n),kcvt, evar_tmp,gama, jhbe, igtyp, isorth)
4298 evar(1,nc(j,i)) = evar(1,nc(j,i)) + n1 * evar_tmp(1)
4299 evar(2,nc(j,i)) = evar(2,nc(j,i)) + n1 * evar_tmp(2)
4300 evar(3,nc(j,i)) = evar(3,nc(j,i)) + n1 * evar_tmp(3)
4301 evar(4,nc(j,i)) = evar(4,nc(j,i)) + n1 * evar_tmp(4)
4302 evar(5,nc(j,i)) = evar(5,nc(j,i)) + n1 * evar_tmp(5)
4303 evar(6,nc(j,i)) = evar(6,nc(j,i)) + n1 * evar_tmp(6)
4304 ENDIF
4305 ENDDO
4306 ENDDO
4307 ENDDO
4308 ELSEIF (jhbe == 24) THEN
4309 DO i=lft,llt
4310 n = i + nft
4311 IF (kcvt /= 0) THEN
4312 IF(kcvt==2)THEN
4313 gama(1:6) = gbuf%GAMA(jj(1:6) + i)
4314 ELSE
4315 gama(1)=one
4316 gama(2)=zero
4317 gama(3)=zero
4318 gama(4)=zero
4319 gama(5)=one
4320 gama(6)=zero
4321 END IF
4322 END IF
4323 DO j=1,isolnod
4324 ksi = a_heph(1,j)
4325 eta = a_heph(2,j)
4326 zeta = a_heph(3,j)
4327c
4328 ilay = 1
4329
4330 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(1,1,1)
4331C------ orthotropic laws will be treated later
4332 CALL szsigpara(jr0 ,js0 ,jt0 ,gbuf%HOURG ,gbuf%SIG ,
4333 . sig_hour ,ksi ,eta ,zeta ,nu ,nel , i)
4334 evar_tmp(1:6) = sig_hour(i,1:6)
4335 IF(ivisc > 0) THEN
4336 evar_tmp(1:6) =evar_tmp(1:6)+ lbuf%VISC(jj(1:6) + i)
4337 ENDIF
4338 IF (kcvt /= 0) CALL srota6(x, ixs(1,n),kcvt, evar_tmp,gama, jhbe, igtyp, isorth)
4339 evar(1:6,nc(j,i)) = evar(1:6,nc(j,i)) + evar_tmp(1:6)
4340 ENDDO
4341 ENDDO
4342 ELSE
4343 DO i=lft,llt
4344 n = i + nft
4345 IF (kcvt /= 0) THEN
4346 IF(kcvt==2)THEN
4347 gama(1) = gbuf%GAMA(jj(1) + i)
4348 gama(2) = gbuf%GAMA(jj(2) + i)
4349 gama(3) = gbuf%GAMA(jj(3) + i)
4350 gama(4) = gbuf%GAMA(jj(4) + i)
4351 gama(5) = gbuf%GAMA(jj(5) + i)
4352 gama(6) = gbuf%GAMA(jj(6) + i)
4353 ELSE
4354 gama(1)=one
4355 gama(2)=zero
4356 gama(3)=zero
4357 gama(4)=zero
4358 gama(5)=one
4359 gama(6)=zero
4360 END IF
4361 END IF
4362 IF(itsh>0) nptt = nlay
4363 DO j=1,min(8,isolnod)
4364 DO k=1,min(8,isolnod)
4365 IF (sol_node(1,k) == -1 .AND. sol_node(1,j) == -1)
4366 . is = 1
4367 IF (sol_node(1,k) == -1 .AND. sol_node(1,j) == 1)
4368 . is = max(1,npts-1)
4369 IF (sol_node(1,k) == 1 .AND. sol_node(1,j) == 1)
4370 . is = npts
4371 IF (sol_node(1,k) == 1 .AND. sol_node(1,j) == -1)
4372 . is = min(npts,2)
4373 IF (sol_node(2,k) == -1 .AND. sol_node(2,j) == -1)
4374 . it = 1
4375 IF (sol_node(2,k) == -1 .AND. sol_node(2,j) == 1)
4376 . it = max(1,nptt-1)
4377 IF (sol_node(2,k) == 1 .AND. sol_node(2,j) == 1)
4378 . it = nptt
4379 IF (sol_node(2,k) == 1 .AND. sol_node(2,j) == -1)
4380 . it = min(nptt,2)
4381 IF (sol_node(3,k) == -1 .AND. sol_node(3,j) == -1)
4382 . ir = 1
4383 IF (sol_node(3,k) == -1 .AND. sol_node(3,j) == 1)
4384 . ir = max(1,nptr-1)
4385 IF (sol_node(3,k) == 1 .AND. sol_node(3,j) == 1)
4386 . ir = nptr
4387 IF (sol_node(3,k) == 1 .AND. sol_node(3,j) == -1)
4388 . ir = min(nptr,2)
4389c
4390 a_gauss_p_r = zero
4391 a_gauss_p_s = zero
4392 a_gauss_p_t = zero
4393c
4394 IF (nptr == 1)THEN
4395 a_gauss_p_r = zero
4396 ELSEIF (sol_node(1,j) == -1 )THEN
4397 a_gauss_r = a_gauss(1,nptr)
4398 a_gauss_r1 = a_gauss(2,nptr)
4399 a_gauss_p_r =
4400 . (-one-half*(a_gauss_r1+a_gauss_r))/
4401 . (half*(a_gauss_r1-a_gauss_r))
4402 ELSEIF(sol_node(1,j) == 1 )THEN
4403 a_gauss_r = a_gauss(nptr-1,nptr)
4404 a_gauss_r1 = a_gauss(nptr,nptr)
4405 a_gauss_p_r =
4406 . (one+half*(a_gauss_r1+a_gauss_r))/
4407 . (half*(a_gauss_r1-a_gauss_r))
4408 ENDIF
4409c
4410 IF (npts == 1)THEN
4411 a_gauss_p_s = zero
4412 ELSEIF (sol_node(2,j) == -1 )THEN
4413 a_gauss_s = a_gauss(1,npts)
4414 a_gauss_s1 = a_gauss(2,npts)
4415 a_gauss_p_s =
4416 . (-one-half*(a_gauss_s1+a_gauss_s))/
4417 . (half*(a_gauss_s1-a_gauss_s))
4418 ELSEIF(sol_node(2,j) == 1 )THEN
4419 a_gauss_s = a_gauss(npts-1,npts)
4420 a_gauss_s1 = a_gauss(npts,npts)
4421 a_gauss_p_s =
4422 . (one+half*(a_gauss_s1+a_gauss_s))/
4423 . (half*(a_gauss_s1-a_gauss_s))
4424 ENDIF
4425c
4426 IF (nptt == 1)THEN
4427 a_gauss_p_t = zero
4428 ELSEIF (sol_node(3,j) == -1 )THEN
4429 a_gauss_t = a_gauss(1,nptt)
4430 a_gauss_t1 = a_gauss(2,nptt)
4431 a_gauss_p_t =
4432 . (-one-half*(a_gauss_t1+a_gauss_t))/
4433 . (half*(a_gauss_t1-a_gauss_t))
4434 ELSEIF(sol_node(3,j) == 1 )THEN
4435 a_gauss_t = a_gauss(nptt-1,nptt)
4436 a_gauss_t1 = a_gauss(nptt,nptt)
4437 a_gauss_p_t =
4438 . (one+half*(a_gauss_t1+a_gauss_t))/
4439 . (half*(a_gauss_t1-a_gauss_t))
4440 ENDIF
4441c
4442 n1 = one_over_8*(
4443 . (one+sol_node(1,k) * a_gauss_p_r) *
4444 . (one+sol_node(2,k) * a_gauss_p_s) *
4445 . (one+sol_node(3,k) * a_gauss_p_t) )
4446c
4447 IF (igtyp == 20 .OR. igtyp ==21 .OR. igtyp == 22) THEN
4448 ilay = it
4449 it = 1
4450 ELSE
4451 ilay = 1
4452 ENDIF
4453c
4454 ksi = a_gauss(ir,2)
4455 eta = a_gauss(is,2)
4456 zeta = a_gauss(it,2)
4457
4458 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
4459
4460 evar_tmp(1) = lbuf%SIG(jj(1) + i)
4461 evar_tmp(2) = lbuf%SIG(jj(2) + i)
4462 evar_tmp(3) = lbuf%SIG(jj(3) + i)
4463 evar_tmp(4) = lbuf%SIG(jj(4) + i)
4464 evar_tmp(5) = lbuf%SIG(jj(5) + i)
4465 evar_tmp(6) = lbuf%SIG(jj(6) + i)
4466C
4467 IF(ivisc > 0) THEN
4468 evar_tmp(1) =evar_tmp(1)+ lbuf%VISC(jj(1) + i)
4469 evar_tmp(2) =evar_tmp(2)+ lbuf%VISC(jj(2) + i)
4470 evar_tmp(3) =evar_tmp(3)+ lbuf%VISC(jj(3) + i)
4471 evar_tmp(4) =evar_tmp(4)+ lbuf%VISC(jj(4) + i)
4472 evar_tmp(5) =evar_tmp(5)+ lbuf%VISC(jj(5) + i)
4473 evar_tmp(6) =evar_tmp(6)+ lbuf%VISC(jj(6) + i)
4474 ENDIF
4475 IF (kcvt /= 0)CALL srota6(x, ixs(1,n),kcvt, evar_tmp,gama, jhbe, igtyp, isorth)
4476 evar(1,nc(j,i)) = evar(1,nc(j,i)) + n1 * evar_tmp(1)
4477 evar(2,nc(j,i)) = evar(2,nc(j,i)) + n1 * evar_tmp(2)
4478 evar(3,nc(j,i)) = evar(3,nc(j,i)) + n1 * evar_tmp(3)
4479 evar(4,nc(j,i)) = evar(4,nc(j,i)) + n1 * evar_tmp(4)
4480 evar(5,nc(j,i)) = evar(5,nc(j,i)) + n1 * evar_tmp(5)
4481 evar(6,nc(j,i)) = evar(6,nc(j,i)) + n1 * evar_tmp(6)
4482 ENDDO
4483 ENDDO
4484 ENDDO
4485 ENDIF
4486
4487!----warning, ISROT=ITETRA4
4488 ELSEIF(isolnod == 4 .AND. isrot/=1)THEN
4489
4490 DO i=lft,llt
4491 n = i + nft
4492 IF (kcvt /= 0) THEN
4493 IF(kcvt==2)THEN
4494 gama(1) = gbuf%GAMA(jj(1) + i)
4495 gama(2) = gbuf%GAMA(jj(2) + i)
4496 gama(3) = gbuf%GAMA(jj(3) + i)
4497 gama(4) = gbuf%GAMA(jj(4) + i)
4498 gama(5) = gbuf%GAMA(jj(5) + i)
4499 gama(6) = gbuf%GAMA(jj(6) + i)
4500 ELSE
4501 gama(1)=one
4502 gama(2)=zero
4503 gama(3)=zero
4504 gama(4)=zero
4505 gama(5)=one
4506 gama(6)=zero
4507 END IF
4508 END IF
4509 n1 = one
4510 ilay = 1
4511 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(1,1,1)
4512 evar_tmp(1) = lbuf%SIG(jj(1) + i)
4513 evar_tmp(2) = lbuf%SIG(jj(2) + i)
4514 evar_tmp(3) = lbuf%SIG(jj(3) + i)
4515 evar_tmp(4) = lbuf%SIG(jj(4) + i)
4516 evar_tmp(5) = lbuf%SIG(jj(5) + i)
4517 evar_tmp(6) = lbuf%SIG(jj(6) + i)
4518 IF(ivisc > 0) THEN
4519 evar_tmp(1) =evar_tmp(1)+ lbuf%VISC(jj(1) + i)
4520 evar_tmp(2) =evar_tmp(2)+ lbuf%VISC(jj(2) + i)
4521 evar_tmp(3) =evar_tmp(3)+ lbuf%VISC(jj(3) + i)
4522 evar_tmp(4) =evar_tmp(4)+ lbuf%VISC(jj(4) + i)
4523 evar_tmp(5) =evar_tmp(5)+ lbuf%VISC(jj(5) + i)
4524 evar_tmp(6) =evar_tmp(6)+ lbuf%VISC(jj(6) + i)
4525 ENDIF
4526 IF (kcvt /= 0)CALL srota6(x, ixs(1,n),kcvt, evar_tmp,gama, jhbe, igtyp, isorth)
4527 DO j=1,4
4528 evar(1,nc(j,i)) = evar(1,nc(j,i)) + n1 * evar_tmp(1)
4529 evar(2,nc(j,i)) = evar(2,nc(j,i)) + n1 * evar_tmp(2)
4530 evar(3,nc(j,i)) = evar(3,nc(j,i)) + n1 * evar_tmp(3)
4531 evar(4,nc(j,i)) = evar(4,nc(j,i)) + n1 * evar_tmp(4)
4532 evar(5,nc(j,i)) = evar(5,nc(j,i)) + n1 * evar_tmp(5)
4533 evar(6,nc(j,i)) = evar(6,nc(j,i)) + n1 * evar_tmp(6)
4534 ENDDO
4535 ENDDO
4536 ELSEIF(isolnod == 10 .OR. (isolnod == 4 .AND. isrot==1))THEN
4537c
4538 alpha_1 = -alpha/(beta-alpha)
4539 beta_1 = (one-alpha)/(beta-alpha)
4540 DO i=lft,llt
4541 n = i + nft
4542 IF (kcvt /= 0) THEN
4543 IF(kcvt==2)THEN
4544 gama(1) = gbuf%GAMA(jj(1) + i)
4545 gama(2) = gbuf%GAMA(jj(2) + i)
4546 gama(3) = gbuf%GAMA(jj(3) + i)
4547 gama(4) = gbuf%GAMA(jj(4) + i)
4548 gama(5) = gbuf%GAMA(jj(5) + i)
4549 gama(6) = gbuf%GAMA(jj(6) + i)
4550 ELSE
4551 gama(1)=one
4552 gama(2)=zero
4553 gama(3)=zero
4554 gama(4)=zero
4555 gama(5)=one
4556 gama(6)=zero
4557 END IF
4558 END IF
4559 DO j=1,4
4560 evar_t10(1:6,j)=zero
4561 DO k=1,4
4562 ir = k
4563 is = 1
4564 it = 1
4565C
4566 IF (j==k) THEN
4567 n1 = beta_1
4568 ELSE
4569 n1 = alpha_1
4570 ENDIF
4571 ilay = 1
4572 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
4573 evar_t10(1,j) = evar_t10(1,j)+ n1 *lbuf%SIG(jj(1) + i)
4574 evar_t10(2,j) = evar_t10(2,j)+ n1 *lbuf%SIG(jj(2) + i)
4575 evar_t10(3,j) = evar_t10(3,j)+ n1 *lbuf%SIG(jj(3) + i)
4576 evar_t10(4,j) = evar_t10(4,j)+ n1 *lbuf%SIG(jj(4) + i)
4577 evar_t10(5,j) = evar_t10(5,j)+ n1 *lbuf%SIG(jj(5) + i)
4578 evar_t10(6,j) = evar_t10(6,j)+ n1 *lbuf%SIG(jj(6) + i)
4579 IF(ivisc > 0) THEN
4580 evar_t10(1,j) =evar_t10(1,j)+ n1 *lbuf%VISC(jj(1) + i)
4581 evar_t10(2,j) =evar_t10(2,j)+ n1 *lbuf%VISC(jj(2) + i)
4582 evar_t10(3,j) =evar_t10(3,j)+ n1 *lbuf%VISC(jj(3) + i)
4583 evar_t10(4,j) =evar_t10(4,j)+ n1 *lbuf%VISC(jj(4) + i)
4584 evar_t10(5,j) =evar_t10(5,j)+ n1 *lbuf%VISC(jj(5) + i)
4585 evar_t10(6,j) =evar_t10(6,j)+ n1 *lbuf%VISC(jj(6) + i)
4586 ENDIF
4587 ENDDO
4588 IF (kcvt /= 0) CALL srota6(x, ixs(1,n), kcvt, evar_t10(1,j),gama, jhbe, igtyp, isorth)
4589 END DO !J=1,4
4590 DO j=1,4
4591 evar(1,nc(j,i)) = evar(1,nc(j,i)) + evar_t10(1,j)
4592 evar(2,nc(j,i)) = evar(2,nc(j,i)) + evar_t10(2,j)
4593 evar(3,nc(j,i)) = evar(3,nc(j,i)) + evar_t10(3,j)
4594 evar(4,nc(j,i)) = evar(4,nc(j,i)) + evar_t10(4,j)
4595 evar(5,nc(j,i)) = evar(5,nc(j,i)) + evar_t10(5,j)
4596 evar(6,nc(j,i)) = evar(6,nc(j,i)) + evar_t10(6,j)
4597 ENDDO
4598 IF(isolnod == 10 ) THEN
4599 DO j=5,10
4600 nn1=iperm1(j)
4601 nn2=iperm2(j)
4602 evar_t10(1:6,j) = half*(evar_t10(1:6,nn1)+evar_t10(1:6,nn2))
4603 END DO
4604 DO j=5,10
4605 evar(1,nc(j,i)) = evar(1,nc(j,i)) + evar_t10(1,j)
4606 evar(2,nc(j,i)) = evar(2,nc(j,i)) + evar_t10(2,j)
4607 evar(3,nc(j,i)) = evar(3,nc(j,i)) + evar_t10(3,j)
4608 evar(4,nc(j,i)) = evar(4,nc(j,i)) + evar_t10(4,j)
4609 evar(5,nc(j,i)) = evar(5,nc(j,i)) + evar_t10(5,j)
4610 evar(6,nc(j,i)) = evar(6,nc(j,i)) + evar_t10(6,j)
4611 ENDDO
4612 END IF !(ISOLNOD == 10 ) THEN
4613 ENDDO
4614 ENDIF
4615 DO i=lft,llt
4616 DO j = 1,nnod
4617 n = nc(j,i)
4618 IF (n>0)THEN
4619 DO k = 1,3
4620 func1(k,n) = evar(k,n)
4621 func2(k,n) = evar(k+3,n)
4622 ENDDO
4623 itagps(n) = itagps(n)+1
4624 ENDIF
4625 ENDDO
4626 ENDDO
4627 ENDIF
4628c
4629 900 CONTINUE
4630 DEALLOCATE(evar)
4631C-----------------------------------------------
4632 RETURN
4633 END SUBROUTINE tensgps3
4634!||====================================================================
4635!|| shlrotg ../engine/source/output/anim/generate/tensor6.F
4636!||--- called by ------------------------------------------------------
4637!|| tencgps1 ../engine/source/output/anim/generate/tensorc.F
4638!|| tencgps2 ../engine/source/output/anim/generate/tensorc.F
4639!|| tensgps1 ../engine/source/output/anim/generate/tensor6.F
4640!|| tensgps2 ../engine/source/output/anim/generate/tensor6.F
4641!||--- calls -----------------------------------------------------
4642!|| clskew3 ../engine/source/elements/sh3n/coquedk/cdkcoor3.F
4643!||--- uses -----------------------------------------------------
4644!|| element_mod ../common_source/modules/elements/element_mod.F90
4645!||====================================================================
4646 SUBROUTINE shlrotg(JFT ,JLT ,NFT ,X ,TENS ,
4647 1 ITY ,IXC ,IXTG ,IHBE ,AREA )
4648 use element_mod , only : nixc,nixtg
4649C-----------------------------------------------
4650C I m p l i c i t T y p e s
4651C-----------------------------------------------
4652#include "implicit_f.inc"
4653C-----------------------------------------------
4654C G l o b a l P a r a m e t e r s
4655C-----------------------------------------------
4656#include "mvsiz_p.inc"
4657#include "com01_c.inc"
4658C-----------------------------------------------
4659C D u m m y A r g u m e n t s
4660C-----------------------------------------------
4661 INTEGER JFT, JLT, NFT, IXC(NIXC,*),ITY, IXTG(NIXTG,*),IHBE
4662 my_real X(3,*), TENS(6,*),AREA(*)
4663C-----------------------------------------------
4664C L o c a l V a r i a b l e s
4665C-----------------------------------------------
4666 INTEGER I, N, IREP
4667 my_real
4668 . R11(MVSIZ),R12(MVSIZ),R13(MVSIZ),R21(MVSIZ),R22(MVSIZ),
4669 . R23(MVSIZ),R31(MVSIZ),R32(MVSIZ),R33(MVSIZ),CDET(MVSIZ),
4670 . OFF(MVSIZ),RX(MVSIZ), RY(MVSIZ), RZ(MVSIZ),
4671 . SX(MVSIZ), SY(MVSIZ), SZ(MVSIZ),
4672 . L11,L12,L13,L22,L23,L33,
4673 . S11,S12,S21,S13,S31,S22,S23,S32,S33
4674C-----------------------------------------------
4675 IF(ity == 3)THEN
4676C---------------------
4677C shells 4 nodes
4678C---------------------
4679 DO n=jft,jlt
4680 i=nft+n
4681 rx(n)=x(1,ixc(3,i))+x(1,ixc(4,i))-x(1,ixc(2,i))-x(1,ixc(5,i))
4682 sx(n)=x(1,ixc(4,i))+x(1,ixc(5,i))-x(1,ixc(2,i))-x(1,ixc(3,i))
4683 ry(n)=x(2,ixc(3,i))+x(2,ixc(4,i))-x(2,ixc(2,i))-x(2,ixc(5,i))
4684 sy(n)=x(2,ixc(4,i))+x(2,ixc(5,i))-x(2,ixc(2,i))-x(2,ixc(3,i))
4685 rz(n)=x(3,ixc(3,i))+x(3,ixc(4,i))-x(3,ixc(2,i))-x(3,ixc(5,i))
4686 sz(n)=x(3,ixc(4,i))+x(3,ixc(5,i))-x(3,ixc(2,i))-x(3,ixc(3,i))
4687 ENDDO
4688 irep = 0
4689 IF (ihbe<11) THEN
4690 IF (ishfram == 1) THEN
4691 irep = 2
4692 ELSE
4693 irep = 1
4694 ENDIF
4695 ENDIF
4696 ELSE
4697C---------------------
4698C shells 3 nodes
4699C---------------------
4700 DO n=jft,jlt
4701 i=nft+n
4702 rx(n)=x(1,ixtg(3,i))-x(1,ixtg(2,i))
4703 ry(n)=x(2,ixtg(3,i))-x(2,ixtg(2,i))
4704 rz(n)=x(3,ixtg(3,i))-x(3,ixtg(2,i))
4705 sx(n)=x(1,ixtg(4,i))-x(1,ixtg(2,i))
4706 sy(n)=x(2,ixtg(4,i))-x(2,ixtg(2,i))
4707 sz(n)=x(3,ixtg(4,i))-x(3,ixtg(2,i))
4708 ENDDO
4709 irep = 0
4710 IF (ihbe<11) irep = 1
4711 ENDIF
4712 CALL clskew3(jft,jlt,irep,
4713 . rx, ry, rz,
4714 . sx, sy, sz,
4715 . r11,r12,r13,r21,r22,r23,r31,r32,r33,cdet,off )
4716C--------------------------------------------------
4717 DO i=jft,jlt
4718 l11 =tens(1,i)
4719 l22 =tens(2,i)
4720 l33 =tens(3,i)
4721 l12 =tens(4,i)
4722 l23 =tens(5,i)
4723 l13 =tens(6,i)
4724 s11 =l11*r11(i)+l12*r12(i)+l13*r13(i)
4725 s12 =l11*r21(i)+l12*r22(i)+l13*r23(i)
4726 s13 =l11*r31(i)+l12*r32(i)+l13*r33(i)
4727 s21 =l12*r11(i)+l22*r12(i)+l23*r13(i)
4728 s22 =l12*r21(i)+l22*r22(i)+l23*r23(i)
4729 s23 =l12*r31(i)+l22*r32(i)+l23*r33(i)
4730 s31 =l13*r11(i)+l23*r12(i)+l33*r13(i)
4731 s32 =l13*r21(i)+l23*r22(i)+l33*r23(i)
4732 s33 =l13*r31(i)+l23*r32(i)+l33*r33(i)
4733 tens(1,i)=r11(i)*s11+r12(i)*s21+r13(i)*s31
4734 tens(2,i)=r21(i)*s12+r22(i)*s22+r23(i)*s32
4735 tens(3,i)=r31(i)*s13+r32(i)*s23+r33(i)*s33
4736 tens(4,i)=r11(i)*s12+r12(i)*s22+r13(i)*s32
4737 tens(5,i)=r21(i)*s13+r22(i)*s23+r23(i)*s33
4738 tens(6,i)=r11(i)*s13+r12(i)*s23+r13(i)*s33
4739 area(i) = half*cdet(i)
4740 ENDDO
4741C-----------------------------------------------
4742 RETURN
4743 END SUBROUTINE shlrotg
4744!||====================================================================
4745!|| tensgps_skin ../engine/source/output/anim/generate/tensor6.F
4746!||--- called by ------------------------------------------------------
4747!|| h3d_sol_skin_tensor ../engine/source/output/h3d/h3d_results/h3d_sol_skin_tensor.F
4748!||--- calls -----------------------------------------------------
4749!|| initbuf ../engine/share/resol/initbuf.F
4750!|| pre_heph ../engine/source/output/anim/generate/tensor6.F
4751!|| srota6 ../engine/source/output/anim/generate/srota6.F
4752!|| szsigpara ../engine/source/elements/solid/solidez/szsigpara.F
4753!||--- uses -----------------------------------------------------
4754!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
4755!|| element_mod ../common_source/modules/elements/element_mod.F90
4756!|| initbuf_mod ../engine/share/resol/initbuf.F
4757!|| my_alloc_mod ../common_source/tools/memory/my_alloc.F90
4758!||====================================================================
4759 SUBROUTINE tensgps_skin(ELBUF_TAB,FUNC1 ,FUNC2 ,IPARG ,
4760 . IXS ,IXS10 ,IXS16 ,IXS20 ,X ,
4761 . ITAGPS ,PM ,TAG_SKIN_ND )
4762 use element_mod , only : nixs
4763C-----------------------------------------------
4764C M o d u l e s
4765C-----------------------------------------------
4766 USE initbuf_mod
4767 USE elbufdef_mod
4768 USE my_alloc_mod
4769C-----------------------------------------------
4770C I m p l i c i t T y p e s
4771C-----------------------------------------------
4772#include "implicit_f.inc"
4773C-----------------------------------------------
4774C C o m m o n B l o c k s
4775C-----------------------------------------------
4776#include "vect01_c.inc"
4777#include "mvsiz_p.inc"
4778#include "com01_c.inc"
4779#include "com04_c.inc"
4780#include "param_c.inc"
4781C-----------------------------------------------
4782C D u m m y A r g u m e n t s
4783C-----------------------------------------------
4784C REAL
4785 my_real
4786 . func1(3,*),func2(3,*),x(3,*),
4787 . pm(npropm,*)
4788 INTEGER IPARG(NPARG,*),TAG_SKIN_ND(*),
4789 . IXS(NIXS,*),IXS10(6,*) ,IXS16(8,*) ,IXS20(12,*) ,ITAGPS(*)
4790 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
4791C-----------------------------------------------
4792C L o c a l V a r i a b l e s
4793C-----------------------------------------------
4794 my_real GAMA(6),
4795 .
4796 .
4797 . A_GAUSS_R,A_GAUSS_S,A_GAUSS_T,N1,
4798 . A_GAUSS_R1,A_GAUSS_S1,A_GAUSS_T1,
4799 . A_GAUSS_P_R,A_GAUSS_P_S,A_GAUSS_P_T,
4800 . ksi,eta,zeta
4801 my_real,ALLOCATABLE,DIMENSION(:,:) :: evar
4802 INTEGER I, NG, NEL,KCVT,
4803 . n, j, mlw,
4804 .
4805 . nn1,k,
4806 . isolnod, nptr, npts, nptt,
4807 . is, ir, it,nc(20,mvsiz),nnod,ilay,
4808 . icsig,ivisc,jj(6),mat(mvsiz),iskin(mvsiz)
4809 INTEGER MLW2,NLAY
4810 TYPE(G_BUFEL_) ,POINTER :: GBUF
4811 TYPE(L_BUFEL_) ,POINTER :: LBUF
4812 my_real
4813 . A_GAUSS(9,9),EVAR_TMP(6),ALPHA,BETA,ALPHA_1,BETA_1,
4814 . JR0(MVSIZ),JS0(MVSIZ),JT0(MVSIZ),NU(MVSIZ),SIG_HOUR(MVSIZ,6),
4815 .
4816 .
4817 .
4818 .
4819 .
4820 .
4821 .
4822 .
4823 .
4824 .
4825 .
4826 . evar_t10(6,10),a_heph(3,8)
4827 INTEGER
4828 . SOL_NODE(3,8), IPERM1(10),IPERM2(10),NN2
4829 DATA IPERM1/0,0,0,0,1,2,3,1,2,3/
4830 DATA IPERM2/0,0,0,0,2,3,1,4,4,4/
4831C=======================================================================
4832 DATA A_GAUSS /
4833 1 0. ,0. ,0. ,
4834 1 0. ,0. ,0. ,
4835 1 0. ,0. ,0. ,
4836 2 -.577350269189626,0.577350269189626,0. ,
4837 2 0. ,0. ,0. ,
4838 2 0. ,0. ,0. ,
4839 3 -.774596669241483,0. ,0.774596669241483,
4840 3 0. ,0. ,0. ,
4841 3 0. ,0. ,0. ,
4842 4 -.861136311594053,-.339981043584856,0.339981043584856,
4843 4 0.861136311594053,0. ,0. ,
4844 4 0. ,0. ,0. ,
4845 5 -.906179845938664,-.538469310105683,0. ,
4846 5 0.538469310105683,0.906179845938664,0. ,
4847 5 0. ,0. ,0. ,
4848 6 -.932469514203152,-.661209386466265,-.238619186083197,
4849 6 0.238619186083197,0.661209386466265,0.932469514203152,
4850 6 0. ,0. ,0. ,
4851 7 -.949107912342759,-.741531185599394,-.405845151377397,
4852 7 0. ,0.405845151377397,0.741531185599394,
4853 7 0.949107912342759,0. ,0. ,
4854 8 -.960289856497536,-.796666477413627,-.525532409916329,
4855 8 -.183434642495650,0.183434642495650,0.525532409916329,
4856 8 0.796666477413627,0.960289856497536,0. ,
4857 9 -.968160239507626,-.836031107326636,-.613371432700590,
4858 9 -.324253423403809,0. ,0.324253423403809,
4859 9 0.613371432700590,0.836031107326636,0.968160239507626/
4860 DATA sol_node /
4861 1 -1 ,-1 ,-1 ,
4862 2 -1 ,-1 , 1 ,
4863 3 1 ,-1 , 1 ,
4864 4 1 ,-1 ,-1 ,
4865 5 -1 , 1 ,-1 ,
4866 6 -1 , 1 , 1 ,
4867 7 1 , 1 , 1 ,
4868 8 1 , 1 ,-1 /
4869C-----Nj : KSI,ETA,ZETA
4870 DATA a_heph /
4871 1 -1 ,-1 ,-1 ,
4872 4 1 ,-1 ,-1 ,
4873 5 -1 , 1 ,-1 ,
4874 8 1 , 1 ,-1 ,
4875 2 -1 ,-1 , 1 ,
4876 3 1 ,-1 , 1 ,
4877 7 1 , 1 , 1 ,
4878 6 -1 , 1 , 1 /
4879C=======================================================================
4880 alpha = zep1381966
4881 beta = zep5854102
4882 CALL my_alloc(evar,6,numnod)
4883 DO i=1,numnod
4884 evar(1,i) = zero
4885 evar(2,i) = zero
4886 evar(3,i) = zero
4887 evar(4,i) = zero
4888 evar(5,i) = zero
4889 evar(6,i) = zero
4890 ENDDO
4891 DO 900 ng=1,ngroup
4892 ivisc = iparg(61,ng)
4893 gbuf => elbuf_tab(ng)%GBUF
4894 CALL initbuf(iparg ,ng ,
4895 2 mlw ,nel ,nft ,iad ,ity ,
4896 3 npt ,jale ,ismstr ,jeul ,jtur ,
4897 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
4898 5 nvaux ,jpor ,kcvt ,jclose ,jplasol ,
4899 6 irep ,iint ,igtyp ,israt ,isrot ,
4900 7 icsen ,isorth ,isorthg ,ifailure,jsms )
4901 mlw2 = mlw
4902 icsig=iparg(17,ng)
4903 isolnod = iparg(28,ng)
4904 lft=1
4905 llt=nel
4906 nnod = 0
4907!
4908 DO i=1,6
4909 jj(i) = nel*(i-1)
4910 ENDDO
4911!
4912C-----------------------------------------------
4913C SOLID 8N
4914C-----------------------------------------------
4915 IF (ity == 1.AND.(igtyp==14.OR.igtyp==6)) THEN
4916 gbuf => elbuf_tab(ng)%GBUF
4917 IF (kcvt==1.AND.isorth/=0) kcvt=2
4918 nnod = isolnod
4919 iskin(1:nel) = 0
4920 DO i=lft,llt
4921 n = i + nft
4922 IF(isolnod == 8)THEN
4923 DO j = 1,isolnod
4924 nc(j,i) = ixs(j+1,n)
4925 ENDDO
4926 DO j=1,8
4927 iskin(i) = iskin(i) + tag_skin_nd(nc(j,i))
4928 END DO
4929 ELSEIF(isolnod == 4)THEN
4930 nc(1,i)=ixs(2,n)
4931 nc(2,i)=ixs(4,n)
4932 nc(3,i)=ixs(7,n)
4933 nc(4,i)=ixs(6,n)
4934 DO j=1,4
4935 iskin(i) = iskin(i) + tag_skin_nd(nc(j,i))
4936 END DO
4937 ELSEIF(isolnod == 6)THEN
4938 nc(1,i)=ixs(2,n)
4939 nc(2,i)=ixs(3,n)
4940 nc(3,i)=ixs(4,n)
4941 nc(4,i)=ixs(6,n)
4942 nc(5,i)=ixs(7,n)
4943 nc(6,i)=ixs(8,n)
4944 ELSEIF(isolnod == 10)THEN
4945 nc(1,i)=ixs(2,n)
4946 nc(2,i)=ixs(4,n)
4947 nc(3,i)=ixs(7,n)
4948 nc(4,i)=ixs(6,n)
4949 nn1 = n - numels8
4950 DO j=1,6
4951 nc(j+4,i) = ixs10(j,nn1)
4952 ENDDO
4953 DO j=1,4
4954 iskin(i) = iskin(i) + tag_skin_nd(nc(j,i))
4955 END DO
4956 ELSEIF(isolnod == 16)THEN
4957 DO j = 1,8
4958 nc(j,i) = ixs(j+1,n)
4959 ENDDO
4960 nn1 = n - (numels8+numels10+numels20)
4961 DO j=1,8
4962 nc(j+8,i) = ixs16(j,nn1)
4963 ENDDO
4964 ELSEIF(isolnod == 20)THEN
4965 DO j = 1,8
4966 nc(j,i) = ixs(j+1,n)
4967 ENDDO
4968 nn1 = n - (numels8+numels10)
4969 DO j=1,12
4970 nc(j+8,i) = ixs20(j,nn1)
4971 ENDDO
4972 DO j=1,8
4973 iskin(i) = iskin(i) + tag_skin_nd(nc(j,i))
4974 END DO
4975 ENDIF
4976 ENDDO
4977C
4978 nptr = elbuf_tab(ng)%NPTR
4979 npts = elbuf_tab(ng)%NPTS
4980 nptt = elbuf_tab(ng)%NPTT
4981 nlay = elbuf_tab(ng)%NLAY
4982 npt = nptr*npts*nptt
4983 nnod = isolnod
4984 sig_hour = zero
4985 IF (jhbe == 24) THEN
4986 CALL pre_heph(x,ixs,jr0,js0,jt0,pm,mat,nu,nft,nel)
4987 ENDIF
4988C----------
4989 IF(isolnod == 6 .OR. isolnod == 8 .OR.
4990 . isolnod == 16 .OR. isolnod == 20)THEN
4991c
4992c T_SHELL ( JHBE = 15/16 )
4993 IF(nlay > 1 .AND. jhbe /= 14) THEN
4994 DO i=lft,llt
4995 IF (iskin(i)==0) cycle
4996 n = i + nft
4997 IF (kcvt /= 0) THEN
4998 IF(kcvt==2)THEN
4999 gama(1) = gbuf%GAMA(jj(1) + i)
5000 gama(2) = gbuf%GAMA(jj(2) + i)
5001 gama(3) = gbuf%GAMA(jj(3) + i)
5002 gama(4) = gbuf%GAMA(jj(4) + i)
5003 gama(5) = gbuf%GAMA(jj(5) + i)
5004 gama(6) = gbuf%GAMA(jj(6) + i)
5005 ELSE
5006 gama(1)=one
5007 gama(2)=zero
5008 gama(3)=zero
5009 gama(4)=zero
5010 gama(5)=one
5011 gama(6)=zero
5012 END IF
5013 END IF
5014 npts = nlay
5015C
5016 DO j=1,min(8,isolnod)
5017 DO k=1,min(8,isolnod)
5018 IF(sol_node(2,k) == sol_node(2,j)) THEN
5019c
5020 IF (sol_node(1,k) == -1 .AND. sol_node(1,j) == -1)
5021 . ir = 1
5022 IF (sol_node(1,k) == -1 .AND. sol_node(1,j) == 1)
5023 . ir = max(1,nptr-1)
5024 IF (sol_node(1,k) == 1 .AND. sol_node(1,j) == 1)
5025 . ir = nptr
5026 IF (sol_node(1,k) == 1 .AND. sol_node(1,j) == -1)
5027 . ir = min(nptr,2)
5028 IF (sol_node(2,k) == -1 .AND. sol_node(2,j) == -1)
5029 . is = 1
5030 IF (sol_node(2,k) == -1 .AND. sol_node(2,j) == 1)
5031 . is = max(1,npts-1)
5032 IF (sol_node(2,k) == 1 .AND. sol_node(2,j) == 1)
5033 . is = npts
5034 IF (sol_node(2,k) == 1 .AND. sol_node(2,j) == -1)
5035 . is = min(npts,2)
5036 IF (sol_node(3,k) == -1 .AND. sol_node(3,j) == -1)
5037 . it = 1
5038 IF (sol_node(3,k) == -1 .AND. sol_node(3,j) == 1)
5039 . it = max(1,nptt-1)
5040 IF (sol_node(3,k) == 1 .AND. sol_node(3,j) == 1)
5041 . it = nptt
5042 IF (sol_node(3,k) == 1 .AND. sol_node(3,j) == -1)
5043 . it = min(nptt,2)
5044c
5045 a_gauss_p_r = zero
5046 a_gauss_p_s = zero
5047 a_gauss_p_t = zero
5048c
5049 IF (nptr == 1)THEN
5050 a_gauss_p_r = zero
5051 ELSEIF (sol_node(1,j) == -1 )THEN
5052 a_gauss_r = a_gauss(1,nptr)
5053 a_gauss_r1 = a_gauss(2,nptr)
5054 a_gauss_p_r =
5055 . (-one-half*(a_gauss_r1+a_gauss_r))/
5056 . (half*(a_gauss_r1-a_gauss_r))
5057 ELSEIF(sol_node(1,j) == 1 )THEN
5058 a_gauss_r = a_gauss(nptr-1,nptr)
5059 a_gauss_r1 = a_gauss(nptr,nptr)
5060 a_gauss_p_r =
5061 . (one+half*(a_gauss_r1+a_gauss_r))/
5062 . (half*(a_gauss_r1-a_gauss_r))
5063 ENDIF
5064c
5065 IF (npts == 1)THEN
5066 a_gauss_p_s = zero
5067 ELSEIF (sol_node(2,j) == -1 )THEN
5068 a_gauss_s = a_gauss(1,npts)
5069 a_gauss_s1 = a_gauss(2,npts)
5070 a_gauss_p_s =
5071 . (-one-half*(a_gauss_s1+a_gauss_s))/
5072 . (half*(a_gauss_s1-a_gauss_s))
5073 ELSEIF(sol_node(2,j) == 1 )THEN
5074 a_gauss_s = a_gauss(npts-1,npts)
5075 a_gauss_s1 = a_gauss(npts,npts)
5076 a_gauss_p_s =
5077 . (one+half*(a_gauss_s1+a_gauss_s))/
5078 . (half*(a_gauss_s1-a_gauss_s))
5079 ENDIF
5080c
5081 IF (nptt == 1)THEN
5082 a_gauss_p_t = zero
5083 ELSEIF (sol_node(3,j) == -1 )THEN
5084 a_gauss_t = a_gauss(1,nptt)
5085 a_gauss_t1 = a_gauss(2,nptt)
5086 a_gauss_p_t =
5087 . (-one-half*(a_gauss_t1+a_gauss_t))/
5088 . (half*(a_gauss_t1-a_gauss_t))
5089 ELSEIF(sol_node(3,j) == 1 )THEN
5090 a_gauss_t = a_gauss(nptt-1,nptt)
5091 a_gauss_t1 = a_gauss(nptt,nptt)
5092 a_gauss_p_t =
5093 . (one+half*(a_gauss_t1+a_gauss_t))/
5094 . (half*(a_gauss_t1-a_gauss_t))
5095 ENDIF
5096c
5097 IF (jhbe == 15 .OR. jhbe == 16) THEN
5098 ilay = is
5099 is = 1
5100 n1 = fourth*(
5101 . (one+sol_node(1,k) * a_gauss_p_r) *
5102 . (one+sol_node(3,k) * a_gauss_p_t) )
5103 ENDIF
5104c
5105 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
5106 evar_tmp(1) = lbuf%SIG(jj(1) + i)
5107 evar_tmp(2) = lbuf%SIG(jj(2) + i)
5108 evar_tmp(3) = lbuf%SIG(jj(3) + i)
5109 evar_tmp(4) = lbuf%SIG(jj(4) + i)
5110 evar_tmp(5) = lbuf%SIG(jj(5) + i)
5111 evar_tmp(6) = lbuf%SIG(jj(6) + i)
5112 IF(ivisc > 0) THEN
5113 evar_tmp(1) = evar_tmp(1) + lbuf%VISC(jj(1) + i)
5114 evar_tmp(2) = evar_tmp(2) + lbuf%VISC(jj(2) + i)
5115 evar_tmp(3) = evar_tmp(3) + lbuf%VISC(jj(3) + i)
5116 evar_tmp(4) = evar_tmp(4) + lbuf%VISC(jj(4) + i)
5117 evar_tmp(5) = evar_tmp(5) + lbuf%VISC(jj(5) + i)
5118 evar_tmp(6) = evar_tmp(6) + lbuf%VISC(jj(6) + i)
5119 ENDIF
5120 IF (kcvt /= 0)CALL srota6(x, ixs(1,n),kcvt, evar_tmp,gama, jhbe, igtyp, isorth)
5121 evar(1,nc(j,i)) = evar(1,nc(j,i)) + n1 * evar_tmp(1)
5122 evar(2,nc(j,i)) = evar(2,nc(j,i)) + n1 * evar_tmp(2)
5123 evar(3,nc(j,i)) = evar(3,nc(j,i)) + n1 * evar_tmp(3)
5124 evar(4,nc(j,i)) = evar(4,nc(j,i)) + n1 * evar_tmp(4)
5125 evar(5,nc(j,i)) = evar(5,nc(j,i)) + n1 * evar_tmp(5)
5126 evar(6,nc(j,i)) = evar(6,nc(j,i)) + n1 * evar_tmp(6)
5127 ENDIF
5128 ENDDO
5129 ENDDO
5130 ENDDO
5131 ELSEIF (jhbe == 24) THEN
5132 DO i=lft,llt
5133 IF (iskin(i)==0) cycle
5134 n = i + nft
5135 IF (kcvt /= 0) THEN
5136 IF(kcvt==2)THEN
5137 gama(1:6) = gbuf%GAMA(jj(1:6) + i)
5138 ELSE
5139 gama(1)=one
5140 gama(2)=zero
5141 gama(3)=zero
5142 gama(4)=zero
5143 gama(5)=one
5144 gama(6)=zero
5145 END IF
5146 END IF
5147 DO j=1,8
5148 ksi = a_heph(1,j)
5149 eta = a_heph(2,j)
5150 zeta = a_heph(3,j)
5151c
5152 ilay = 1
5153
5154 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(1,1,1)
5155C------ orthotropic laws will be treated later
5156 CALL szsigpara(jr0 ,js0 ,jt0 ,gbuf%HOURG ,gbuf%SIG ,
5157 . sig_hour ,ksi ,eta ,zeta ,nu ,nel , i)
5158 evar_tmp(1:6) = sig_hour(i,1:6)
5159 IF(ivisc > 0) THEN
5160 evar_tmp(1:6) =evar_tmp(1:6)+ lbuf%VISC(jj(1:6) + i)
5161 ENDIF
5162 IF (kcvt /= 0)CALL srota6(x, ixs(1,n),kcvt, evar_tmp,gama, jhbe, igtyp, isorth)
5163 evar(1:6,nc(j,i)) = evar(1:6,nc(j,i)) + evar_tmp(1:6)
5164 ENDDO
5165 ENDDO
5166 ELSE
5167 DO i=lft,llt
5168 IF (iskin(i)==0) cycle
5169 n = i + nft
5170 IF (kcvt /= 0) THEN
5171 IF(kcvt==2)THEN
5172 gama(1) = gbuf%GAMA(jj(1) + i)
5173 gama(2) = gbuf%GAMA(jj(2) + i)
5174 gama(3) = gbuf%GAMA(jj(3) + i)
5175 gama(4) = gbuf%GAMA(jj(4) + i)
5176 gama(5) = gbuf%GAMA(jj(5) + i)
5177 gama(6) = gbuf%GAMA(jj(6) + i)
5178 ELSE
5179 gama(1)=one
5180 gama(2)=zero
5181 gama(3)=zero
5182 gama(4)=zero
5183 gama(5)=one
5184 gama(6)=zero
5185 END IF
5186 END IF
5187 IF(igtyp == 20 .OR. igtyp ==21 .OR. igtyp == 22) THEN
5188 nptt = nlay
5189 ENDIF
5190 DO j=1,min(8,isolnod)
5191 DO k=1,min(8,isolnod)
5192 IF (sol_node(1,k) == -1 .AND. sol_node(1,j) == -1)
5193 . is = 1
5194 IF (sol_node(1,k) == -1 .AND. sol_node(1,j) == 1)
5195 . is = max(1,npts-1)
5196 IF (sol_node(1,k) == 1 .AND. sol_node(1,j) == 1)
5197 . is = npts
5198 IF (sol_node(1,k) == 1 .AND. sol_node(1,j) == -1)
5199 . is = min(npts,2)
5200 IF (sol_node(2,k) == -1 .AND. sol_node(2,j) == -1)
5201 . it = 1
5202 IF (sol_node(2,k) == -1 .AND. sol_node(2,j) == 1)
5203 . it = max(1,nptt-1)
5204 IF (sol_node(2,k) == 1 .AND. sol_node(2,j) == 1)
5205 . it = nptt
5206 IF (sol_node(2,k) == 1 .AND. sol_node(2,j) == -1)
5207 . it = min(nptt,2)
5208 IF (sol_node(3,k) == -1 .AND. sol_node(3,j) == -1)
5209 . ir = 1
5210 IF (sol_node(3,k) == -1 .AND. sol_node(3,j) == 1)
5211 . ir = max(1,nptr-1)
5212 IF (sol_node(3,k) == 1 .AND. sol_node(3,j) == 1)
5213 . ir = nptr
5214 IF (sol_node(3,k) == 1 .AND. sol_node(3,j) == -1)
5215 . ir = min(nptr,2)
5216c
5217 a_gauss_p_r = zero
5218 a_gauss_p_s = zero
5219 a_gauss_p_t = zero
5220c
5221 IF (nptr == 1)THEN
5222 a_gauss_p_r = zero
5223 ELSEIF (sol_node(1,j) == -1 )THEN
5224 a_gauss_r = a_gauss(1,nptr)
5225 a_gauss_r1 = a_gauss(2,nptr)
5226 a_gauss_p_r =
5227 . (-one-half*(a_gauss_r1+a_gauss_r))/
5228 . (half*(a_gauss_r1-a_gauss_r))
5229 ELSEIF(sol_node(1,j) == 1 )THEN
5230 a_gauss_r = a_gauss(nptr-1,nptr)
5231 a_gauss_r1 = a_gauss(nptr,nptr)
5232 a_gauss_p_r =
5233 . (one+half*(a_gauss_r1+a_gauss_r))/
5234 . (half*(a_gauss_r1-a_gauss_r))
5235 ENDIF
5236c
5237 IF (npts == 1)THEN
5238 a_gauss_p_s = zero
5239 ELSEIF (sol_node(2,j) == -1 )THEN
5240 a_gauss_s = a_gauss(1,npts)
5241 a_gauss_s1 = a_gauss(2,npts)
5242 a_gauss_p_s =
5243 . (-one-half*(a_gauss_s1+a_gauss_s))/
5244 . (half*(a_gauss_s1-a_gauss_s))
5245 ELSEIF(sol_node(2,j) == 1 )THEN
5246 a_gauss_s = a_gauss(npts-1,npts)
5247 a_gauss_s1 = a_gauss(npts,npts)
5248 a_gauss_p_s =
5249 . (one+half*(a_gauss_s1+a_gauss_s))/
5250 . (half*(a_gauss_s1-a_gauss_s))
5251 ENDIF
5252c
5253 IF (nptt == 1)THEN
5254 a_gauss_p_t = zero
5255 ELSEIF (sol_node(3,j) == -1 )THEN
5256 a_gauss_t = a_gauss(1,nptt)
5257 a_gauss_t1 = a_gauss(2,nptt)
5258 a_gauss_p_t =
5259 . (-one-half*(a_gauss_t1+a_gauss_t))/
5260 . (half*(a_gauss_t1-a_gauss_t))
5261 ELSEIF(sol_node(3,j) == 1 )THEN
5262 a_gauss_t = a_gauss(nptt-1,nptt)
5263 a_gauss_t1 = a_gauss(nptt,nptt)
5264 a_gauss_p_t =
5265 . (one+half*(a_gauss_t1+a_gauss_t))/
5266 . (half*(a_gauss_t1-a_gauss_t))
5267 ENDIF
5268c
5269 n1 = one_over_8*(
5270 . (one+sol_node(1,k) * a_gauss_p_r) *
5271 . (one+sol_node(2,k) * a_gauss_p_s) *
5272 . (one+sol_node(3,k) * a_gauss_p_t) )
5273c
5274 IF (igtyp == 20 .OR. igtyp ==21 .OR. igtyp == 22) THEN
5275 ilay = it
5276 it = 1
5277 ELSE
5278 ilay = 1
5279 ENDIF
5280c
5281 ksi = a_gauss(ir,2)
5282 eta = a_gauss(is,2)
5283 zeta = a_gauss(it,2)
5284
5285 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
5286c
5287 evar_tmp(1) = lbuf%SIG(jj(1) + i)
5288 evar_tmp(2) = lbuf%SIG(jj(2) + i)
5289 evar_tmp(3) = lbuf%SIG(jj(3) + i)
5290 evar_tmp(4) = lbuf%SIG(jj(4) + i)
5291 evar_tmp(5) = lbuf%SIG(jj(5) + i)
5292 evar_tmp(6) = lbuf%SIG(jj(6) + i)
5293 IF(ivisc > 0) THEN
5294 evar_tmp(1) =evar_tmp(1)+ lbuf%VISC(jj(1) + i)
5295 evar_tmp(2) =evar_tmp(2)+ lbuf%VISC(jj(2) + i)
5296 evar_tmp(3) =evar_tmp(3)+ lbuf%VISC(jj(3) + i)
5297 evar_tmp(4) =evar_tmp(4)+ lbuf%VISC(jj(4) + i)
5298 evar_tmp(5) =evar_tmp(5)+ lbuf%VISC(jj(5) + i)
5299 evar_tmp(6) =evar_tmp(6)+ lbuf%VISC(jj(6) + i)
5300 ENDIF
5301 IF (kcvt /= 0)CALL srota6(x, ixs(1,n),kcvt, evar_tmp,gama, jhbe, igtyp, isorth)
5302 evar(1,nc(j,i)) = evar(1,nc(j,i)) + n1 * evar_tmp(1)
5303 evar(2,nc(j,i)) = evar(2,nc(j,i)) + n1 * evar_tmp(2)
5304 evar(3,nc(j,i)) = evar(3,nc(j,i)) + n1 * evar_tmp(3)
5305 evar(4,nc(j,i)) = evar(4,nc(j,i)) + n1 * evar_tmp(4)
5306 evar(5,nc(j,i)) = evar(5,nc(j,i)) + n1 * evar_tmp(5)
5307 evar(6,nc(j,i)) = evar(6,nc(j,i)) + n1 * evar_tmp(6)
5308 ENDDO
5309 ENDDO
5310 ENDDO
5311 ENDIF
5312c
5313 ELSEIF(isolnod == 4 )THEN
5314c
5315 DO i=lft,llt
5316 IF (iskin(i)==0) cycle
5317 n = i + nft
5318 IF (kcvt /= 0) THEN
5319 IF(kcvt==2)THEN
5320 gama(1) = gbuf%GAMA(jj(1) + i)
5321 gama(2) = gbuf%GAMA(jj(2) + i)
5322 gama(3) = gbuf%GAMA(jj(3) + i)
5323 gama(4) = gbuf%GAMA(jj(4) + i)
5324 gama(5) = gbuf%GAMA(jj(5) + i)
5325 gama(6) = gbuf%GAMA(jj(6) + i)
5326 ELSE
5327 gama(1)=one
5328 gama(2)=zero
5329 gama(3)=zero
5330 gama(4)=zero
5331 gama(5)=one
5332 gama(6)=zero
5333 END IF
5334 END IF
5335 n1 = fourth
5336 ilay = 1
5337 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(1,1,1)
5338 evar_tmp(1) = lbuf%SIG(jj(1) + i)
5339 evar_tmp(2) = lbuf%SIG(jj(2) + i)
5340 evar_tmp(3) = lbuf%SIG(jj(3) + i)
5341 evar_tmp(4) = lbuf%SIG(jj(4) + i)
5342 evar_tmp(5) = lbuf%SIG(jj(5) + i)
5343 evar_tmp(6) = lbuf%SIG(jj(6) + i)
5344 IF(ivisc > 0) THEN
5345 evar_tmp(1) =evar_tmp(1)+ lbuf%VISC(jj(1) + i)
5346 evar_tmp(2) =evar_tmp(2)+ lbuf%VISC(jj(2) + i)
5347 evar_tmp(3) =evar_tmp(3)+ lbuf%VISC(jj(3) + i)
5348 evar_tmp(4) =evar_tmp(4)+ lbuf%VISC(jj(4) + i)
5349 evar_tmp(5) =evar_tmp(5)+ lbuf%VISC(jj(5) + i)
5350 evar_tmp(6) =evar_tmp(6)+ lbuf%VISC(jj(6) + i)
5351 ENDIF
5352 IF (kcvt /= 0) CALL srota6( x, ixs(1,n),kcvt, evar_tmp,gama, jhbe, igtyp, isorth)
5353 DO j=1,4
5354 evar(1,nc(j,i)) = evar(1,nc(j,i)) + n1 * evar_tmp(1)
5355 evar(2,nc(j,i)) = evar(2,nc(j,i)) + n1 * evar_tmp(2)
5356 evar(3,nc(j,i)) = evar(3,nc(j,i)) + n1 * evar_tmp(3)
5357 evar(4,nc(j,i)) = evar(4,nc(j,i)) + n1 * evar_tmp(4)
5358 evar(5,nc(j,i)) = evar(5,nc(j,i)) + n1 * evar_tmp(5)
5359 evar(6,nc(j,i)) = evar(6,nc(j,i)) + n1 * evar_tmp(6)
5360 ENDDO
5361 ENDDO
5362 ELSEIF(isolnod == 10)THEN
5363c
5364 alpha_1 = -alpha/(beta-alpha)
5365 beta_1 = (one-alpha)/(beta-alpha)
5366 DO i=lft,llt
5367 IF (iskin(i)==0) cycle
5368 n = i + nft
5369 IF (kcvt /= 0) THEN
5370 IF(kcvt==2)THEN
5371 gama(1) = gbuf%GAMA(jj(1) + i)
5372 gama(2) = gbuf%GAMA(jj(2) + i)
5373 gama(3) = gbuf%GAMA(jj(3) + i)
5374 gama(4) = gbuf%GAMA(jj(4) + i)
5375 gama(5) = gbuf%GAMA(jj(5) + i)
5376 gama(6) = gbuf%GAMA(jj(6) + i)
5377 ELSE
5378 gama(1)=one
5379 gama(2)=zero
5380 gama(3)=zero
5381 gama(4)=zero
5382 gama(5)=one
5383 gama(6)=zero
5384 END IF
5385 END IF
5386 DO j=1,4
5387 evar_t10(1:6,j)=zero
5388 DO k=1,4
5389 ir = k
5390 is = 1
5391 it = 1
5392C
5393 IF (j==k) THEN
5394 n1 = beta_1
5395 ELSE
5396 n1 = alpha_1
5397 ENDIF
5398 ilay = 1
5399 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
5400 evar_t10(1,j) = evar_t10(1,j)+ n1 *lbuf%SIG(jj(1) + i)
5401 evar_t10(2,j) = evar_t10(2,j)+ n1 *lbuf%SIG(jj(2) + i)
5402 evar_t10(3,j) = evar_t10(3,j)+ n1 *lbuf%SIG(jj(3) + i)
5403 evar_t10(4,j) = evar_t10(4,j)+ n1 *lbuf%SIG(jj(4) + i)
5404 evar_t10(5,j) = evar_t10(5,j)+ n1 *lbuf%SIG(jj(5) + i)
5405 evar_t10(6,j) = evar_t10(6,j)+ n1 *lbuf%SIG(jj(6) + i)
5406 IF(ivisc > 0) THEN
5407 evar_t10(1,j) =evar_t10(1,j)+ n1 *lbuf%VISC(jj(1) + i)
5408 evar_t10(2,j) =evar_t10(2,j)+ n1 *lbuf%VISC(jj(2) + i)
5409 evar_t10(3,j) =evar_t10(3,j)+ n1 *lbuf%VISC(jj(3) + i)
5410 evar_t10(4,j) =evar_t10(4,j)+ n1 *lbuf%VISC(jj(4) + i)
5411 evar_t10(5,j) =evar_t10(5,j)+ n1 *lbuf%VISC(jj(5) + i)
5412 evar_t10(6,j) =evar_t10(6,j)+ n1 *lbuf%VISC(jj(6) + i)
5413 ENDIF
5414 ENDDO
5415 IF (kcvt /= 0) CALL srota6( x, ixs(1,n), kcvt, evar_t10(1,j), gama, jhbe, igtyp, isorth)
5416 END DO !J=1,4
5417 DO j=5,10
5418 nn1=iperm1(j)
5419 nn2=iperm2(j)
5420 evar_t10(1:6,j) = half*(evar_t10(1:6,nn1)+evar_t10(1:6,nn2))
5421 END DO
5422 DO j=1,10
5423 evar(1,nc(j,i)) = evar(1,nc(j,i)) + evar_t10(1,j)
5424 evar(2,nc(j,i)) = evar(2,nc(j,i)) + evar_t10(2,j)
5425 evar(3,nc(j,i)) = evar(3,nc(j,i)) + evar_t10(3,j)
5426 evar(4,nc(j,i)) = evar(4,nc(j,i)) + evar_t10(4,j)
5427 evar(5,nc(j,i)) = evar(5,nc(j,i)) + evar_t10(5,j)
5428 evar(6,nc(j,i)) = evar(6,nc(j,i)) + evar_t10(6,j)
5429 ENDDO
5430 ENDDO
5431 ENDIF
5432 DO i=lft,llt
5433 IF (iskin(i)==0) cycle
5434 DO j = 1,nnod
5435 n = nc(j,i)
5436 IF (n>0)THEN
5437 DO k = 1,3
5438 func1(k,n) = evar(k,n)
5439 func2(k,n) = evar(k+3,n)
5440 ENDDO
5441 itagps(n) = itagps(n)+1
5442 ENDIF
5443 ENDDO
5444 ENDDO
5445 ENDIF
5446c
5447 900 CONTINUE
5448 DEALLOCATE(evar)
5449C-----------------------------------------------
5450 RETURN
5451 END SUBROUTINE tensgps_skin
5452!||====================================================================
5453!|| pre_heph ../engine/source/output/anim/generate/tensor6.F
5454!||--- called by ------------------------------------------------------
5455!|| strs_tenscor3 ../engine/source/output/h3d/h3d_results/strs_tenscor3.F
5456!|| tensgps3 ../engine/source/output/anim/generate/tensor6.F
5457!|| tensgps_skin ../engine/source/output/anim/generate/tensor6.F
5458!||--- calls -----------------------------------------------------
5459!|| sortho3 ../engine/source/elements/solid/solide/sortho3.F
5460!|| srepisot3 ../engine/source/elements/solid/solide/srepisot3.F
5461!||--- uses -----------------------------------------------------
5462!|| element_mod ../common_source/modules/elements/element_mod.F90
5463!||====================================================================
5464 SUBROUTINE pre_heph(X,IXS,JR0,JS0,JT0,PM,MAT,NU,NFT,NEL)
5465 use element_mod , only : nixs
5466C---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
5467#include "implicit_f.inc"
5468c-----------------------------------------------
5469c g l o b a l p a r a m e t e r s
5470c-----------------------------------------------
5471#include "mvsiz_p.inc"
5472#include "param_c.inc"
5473C-----------------------------------------------
5474C D U M M Y A R G U M E N T S
5475C-----------------------------------------------
5476 my_real
5477 . x(3,*),pm(npropm,*),nu(*),jr0(*),js0(*),jt0(*)
5478 INTEGER IXS(NIXS,*),MAT(*),NEL ,NFT
5479C-----------------------------------------------
5480C L O C A L V A R I A B L E S
5481C-----------------------------------------------
5482 my_real
5483 . xd1(mvsiz), xd2(mvsiz), xd3(mvsiz), xd4(mvsiz), xd5(mvsiz),
5484 . xd6(mvsiz), xd7(mvsiz), xd8(mvsiz),
5485 . yd1(mvsiz), yd2(mvsiz), yd3(mvsiz), yd4(mvsiz), yd5(mvsiz),
5486 . yd6(mvsiz), yd7(mvsiz), yd8(mvsiz),
5487 . zd1(mvsiz), zd2(mvsiz), zd3(mvsiz), zd4(mvsiz), zd5(mvsiz),
5488 . zd6(mvsiz), zd7(mvsiz), zd8(mvsiz),
5489 . r11(mvsiz),r12(mvsiz),r13(mvsiz),
5490 . r21(mvsiz),r22(mvsiz),r23(mvsiz),
5491 . r31(mvsiz),r32(mvsiz),r33(mvsiz),
5492 . rx(mvsiz),ry(mvsiz),rz(mvsiz),sx(mvsiz),sy(mvsiz),sz(mvsiz),
5493 . tx(mvsiz),ty(mvsiz),tz(mvsiz),
5494 . xdl(mvsiz), ydl(mvsiz), zdl(mvsiz)
5495 INTEGER I,J,N,NC(8,MVSIZ)
5496C-----------------------------------------------
5497C- small strain case should use GBUF%SMSTR but we use current x() for all
5498 DO i=1,nel
5499 n = i + nft
5500 DO j = 1,8
5501 nc(j,i) = ixs(j+1,n)
5502 ENDDO
5503 ENDDO
5504 DO i=1,nel
5505 n = i + nft
5506 xd1(i)=x(1,nc(1,i))
5507 yd1(i)=x(2,nc(1,i))
5508 zd1(i)=x(3,nc(1,i))
5509 xd2(i)=x(1,nc(2,i))
5510 yd2(i)=x(2,nc(2,i))
5511 zd2(i)=x(3,nc(2,i))
5512 xd3(i)=x(1,nc(3,i))
5513 yd3(i)=x(2,nc(3,i))
5514 zd3(i)=x(3,nc(3,i))
5515 xd4(i)=x(1,nc(4,i))
5516 yd4(i)=x(2,nc(4,i))
5517 zd4(i)=x(3,nc(4,i))
5518 xd5(i)=x(1,nc(5,i))
5519 yd5(i)=x(2,nc(5,i))
5520 zd5(i)=x(3,nc(5,i))
5521 xd6(i)=x(1,nc(6,i))
5522 yd6(i)=x(2,nc(6,i))
5523 zd6(i)=x(3,nc(6,i))
5524 xd7(i)=x(1,nc(7,i))
5525 yd7(i)=x(2,nc(7,i))
5526 zd7(i)=x(3,nc(7,i))
5527 xd8(i)=x(1,nc(8,i))
5528 yd8(i)=x(2,nc(8,i))
5529 zd8(i)=x(3,nc(8,i))
5530 ENDDO
5531C-----------
5532C convected frame (ITERATIONS).
5533C-----------
5534 CALL srepisot3(
5535 1 xd1, xd2, xd3, xd4,
5536 2 xd5, xd6, xd7, xd8,
5537 3 yd1, yd2, yd3, yd4,
5538 4 yd5, yd6, yd7, yd8,
5539 5 zd1, zd2, zd3, zd4,
5540 6 zd5, zd6, zd7, zd8,
5541 7 rx, ry, rz, sx,
5542 8 sy, sz, tx, ty,
5543 9 tz, nel)
5544C---
5545 CALL sortho3(
5546 1 rx, ry, rz, sx,
5547 2 sy, sz, tx, ty,
5548 3 tz, r12, r13, r11,
5549 4 r22, r23, r21, r32,
5550 5 r33, r31, nel)
5551C---
5552 DO i=1,nel
5553 xdl(i)=r11(i)*xd1(i)+r21(i)*yd1(i)+r31(i)*zd1(i)
5554 ydl(i)=r12(i)*xd1(i)+r22(i)*yd1(i)+r32(i)*zd1(i)
5555 zdl(i)=r13(i)*xd1(i)+r23(i)*yd1(i)+r33(i)*zd1(i)
5556 xd1(i)=xdl(i)
5557 yd1(i)=ydl(i)
5558 zd1(i)=zdl(i)
5559 xdl(i)=r11(i)*xd2(i)+r21(i)*yd2(i)+r31(i)*zd2(i)
5560 ydl(i)=r12(i)*xd2(i)+r22(i)*yd2(i)+r32(i)*zd2(i)
5561 zdl(i)=r13(i)*xd2(i)+r23(i)*yd2(i)+r33(i)*zd2(i)
5562 xd2(i)=xdl(i)
5563 yd2(i)=ydl(i)
5564 zd2(i)=zdl(i)
5565 xdl(i)=r11(i)*xd3(i)+r21(i)*yd3(i)+r31(i)*zd3(i)
5566 ydl(i)=r12(i)*xd3(i)+r22(i)*yd3(i)+r32(i)*zd3(i)
5567 zdl(i)=r13(i)*xd3(i)+r23(i)*yd3(i)+r33(i)*zd3(i)
5568 xd3(i)=xdl(i)
5569 yd3(i)=ydl(i)
5570 zd3(i)=zdl(i)
5571 xdl(i)=r11(i)*xd4(i)+r21(i)*yd4(i)+r31(i)*zd4(i)
5572 ydl(i)=r12(i)*xd4(i)+r22(i)*yd4(i)+r32(i)*zd4(i)
5573 zdl(i)=r13(i)*xd4(i)+r23(i)*yd4(i)+r33(i)*zd4(i)
5574 xd4(i)=xdl(i)
5575 yd4(i)=ydl(i)
5576 zd4(i)=zdl(i)
5577 xdl(i)=r11(i)*xd5(i)+r21(i)*yd5(i)+r31(i)*zd5(i)
5578 ydl(i)=r12(i)*xd5(i)+r22(i)*yd5(i)+r32(i)*zd5(i)
5579 zdl(i)=r13(i)*xd5(i)+r23(i)*yd5(i)+r33(i)*zd5(i)
5580 xd5(i)=xdl(i)
5581 yd5(i)=ydl(i)
5582 zd5(i)=zdl(i)
5583 xdl(i)=r11(i)*xd6(i)+r21(i)*yd6(i)+r31(i)*zd6(i)
5584 ydl(i)=r12(i)*xd6(i)+r22(i)*yd6(i)+r32(i)*zd6(i)
5585 zdl(i)=r13(i)*xd6(i)+r23(i)*yd6(i)+r33(i)*zd6(i)
5586 xd6(i)=xdl(i)
5587 yd6(i)=ydl(i)
5588 zd6(i)=zdl(i)
5589 xdl(i)=r11(i)*xd7(i)+r21(i)*yd7(i)+r31(i)*zd7(i)
5590 ydl(i)=r12(i)*xd7(i)+r22(i)*yd7(i)+r32(i)*zd7(i)
5591 zdl(i)=r13(i)*xd7(i)+r23(i)*yd7(i)+r33(i)*zd7(i)
5592 xd7(i)=xdl(i)
5593 yd7(i)=ydl(i)
5594 zd7(i)=zdl(i)
5595 xdl(i)=r11(i)*xd8(i)+r21(i)*yd8(i)+r31(i)*zd8(i)
5596 ydl(i)=r12(i)*xd8(i)+r22(i)*yd8(i)+r32(i)*zd8(i)
5597 zdl(i)=r13(i)*xd8(i)+r23(i)*yd8(i)+r33(i)*zd8(i)
5598 xd8(i)=xdl(i)
5599 yd8(i)=ydl(i)
5600 zd8(i)=zdl(i)
5601 ENDDO
5602
5603 DO i=1,nel
5604 jr0(i) = -xd1(i)+xd2(i)+xd3(i)-xd4(i)-xd5(i)+xd6(i)+xd7(i)-xd8(i)
5605 js0(i) = -yd1(i)-yd2(i)+yd3(i)+yd4(i)-yd5(i)-yd6(i)+yd7(i)+yd8(i)
5606 jt0(i) = -zd1(i)-zd2(i)-zd3(i)-zd4(i)+zd5(i)+zd6(i)+zd7(i)+zd8(i)
5607 mat(i)=ixs(1,i)
5608 nu(i)=pm(21,mat(i))
5609 ENDDO
5610C-----------------------------------------------
5611 RETURN
5612 END SUBROUTINE pre_heph
clskew3
subroutine clskew3(jft, jlt, irep, rx, ry, rz, sx, sy, sz, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z, det)
Definition clskew.F:34
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
initbuf_mod
Definition initbuf.F:160
initbuf_mod::initbuf
subroutine initbuf(iparg, ng, mtn, llt, nft, iad, ity, npt, jale, ismstr, jeul, jtur, jthe, jlag, jmult, jhbe, jivf, mid, jpor, jcvt, jclose, jpla, irep, iint, igtyp, israt, isrot, icsen, isorth, isorthg, ifailure, jsms)
Definition initbuf.F:261
outmax_mod
Definition outmax_mod.F:52
outmax_mod::ipart_ok
integer, dimension(:,:), allocatable ipart_ok
Definition outmax_mod.F:72
outmax_mod::lmax_nsig
integer lmax_nsig
Definition outmax_mod.F:62
spmd_r4get_partn
subroutine spmd_r4get_partn(size, nbf_l, nbpart, iadg, wal, buf)
Definition spmd_r4get_partn.F:47
srepisot3
subroutine srepisot3(x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, rx, ry, rz, sx, sy, sz, tx, ty, tz, nel)
Definition srepisot3.F:42
srota6_s8s
subroutine srota6_s8s(kcvt, tens, gama, khbe, ityp, frame, iint, isorth)
Definition srota6_s8s.F:33
sortho3
subroutine sortho3(rx, ry, rz, sx, sy, sz, tx, ty, tz, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z)
Definition sortho3.F:33
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
tensgps_skin
subroutine tensgps_skin(elbuf_tab, func1, func2, iparg, ixs, ixs10, ixs16, ixs20, x, itagps, pm, tag_skin_nd)
Definition tensor6.F:4762
tensgps1
subroutine tensgps1(func1, func2, iparg, geo, ixs, ixs10, ixs16, ixs20, ixq, ixc, ixtg, ixt, ixp, ixr, x, itagps, elbuf_tab)
Definition tensor6.F:3412
pre_heph
subroutine pre_heph(x, ixs, jr0, js0, jt0, pm, mat, nu, nft, nel)
Definition tensor6.F:5465
shlrotg
subroutine shlrotg(jft, jlt, nft, x, tens, ity, ixc, ixtg, ihbe, area)
Definition tensor6.F:4648
tensgps3
subroutine tensgps3(elbuf_tab, func1, func2, iparg, geo, ixs, ixs10, ixs16, ixs20, ixq, ixc, ixtg, ixt, ixp, ixr, x, itagps, pm)
Definition tensor6.F:3916
tensgps2
subroutine tensgps2(func1, func2, iparg, geo, ixs, ixs10, ixs16, ixs20, ixq, ixc, ixtg, ixt, ixp, ixr, x, vgps, elbuf_tab)
Definition tensor6.F:3658
tensors
subroutine tensors(elbuf_tab, iparg, itens, ixs, pm, el2fa, nbf, tens, epsdot, nbpart, x, iadg, ipart, ipartsp, isph3d, ipm, igeo)
Definition tensor6.F:43
write_r_c
void write_r_c(float *w, int *len)
Definition write_routines.c:519