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