OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
h3d_solid_tensor_1.F File Reference
#include "implicit_f.inc"
#include "vect01_c.inc"
#include "mvsiz_p.inc"
#include "com01_c.inc"
#include "param_c.inc"
#include "scr17_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine h3d_solid_tensor_1 (elbuf_tab, solid_tensor, iparg, itens, ixs, pm, el2fa, nbf, tens, epsdot, nbpart, x, iadg, ipart, ipartsp, iparts, isph3d, ipm, igeo, id_elem, ity_elem, is_written_solid, layer_input, ir_input, is_input, it_input, h3d_part, info1, keyword, ng, d, solid_tensor_corner, is_corner_data, ixs10, maxnnod, id)
subroutine t4_tstrain (xn, yn, zn, dx, dy, dz, strain, nel)
subroutine s8_tstrain (xn, yn, zn, dx, dy, dz, strain, nel)
subroutine s6_tstrain (xn, yn, zn, dx, dy, dz, strain, nel)
subroutine t4deri3 (x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, px1, px2, px3, px4, py1, py2, py3, py4, pz1, pz2, pz3, pz4, det, nel)
subroutine t8deri3 (x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, px1, px2, px3, px4, py1, py2, py3, py4, pz1, pz2, pz3, pz4, det, nel)
subroutine t6deri3 (x1, x2, x3, x4, x5, x6, y1, y2, y3, y4, y5, y6, z1, z2, z3, z4, z5, z6, px1, px2, px3, px4, py1, py2, py3, py4, pz1, pz2, pz3, pz4, det, nel)
subroutine u_from_f3 (f, strain, nel)

Function/Subroutine Documentation

◆ h3d_solid_tensor_1()

subroutine h3d_solid_tensor_1 ( type (elbuf_struct_), dimension(ngroup), target elbuf_tab,
solid_tensor,
integer, dimension(nparg,*) iparg,
integer itens,
integer, dimension(nixs,*) ixs,
pm,
integer, dimension(*) el2fa,
integer nbf,
tens,
epsdot,
integer nbpart,
x,
integer, dimension(nspmd,*) iadg,
integer, dimension(lipart1,*) ipart,
integer, dimension(*) ipartsp,
integer, dimension(*) iparts,
integer isph3d,
integer, dimension(npropmi,*) ipm,
integer, dimension(npropgi,*) igeo,
integer, dimension(*) id_elem,
integer, dimension(*) ity_elem,
integer, dimension(*) is_written_solid,
integer layer_input,
integer ir_input,
integer is_input,
integer it_input,
integer, dimension(*) h3d_part,
integer info1,
character(ncharline100) keyword,
integer ng,
d,
solid_tensor_corner,
integer is_corner_data,
integer, dimension(6,*) ixs10,
integer maxnnod,
integer id )

Definition at line 44 of file h3d_solid_tensor_1.F.

52C M o d u l e s
53C-----------------------------------------------
54 USE initbuf_mod
55 USE elbufdef_mod
56 USE schlieren_mod
57 USE stack_mod
58 USE names_and_titles_mod, ONLY: ncharline100
59C-----------------------------------------------
60C I m p l i c i t T y p e s
61C-----------------------------------------------
62#include "implicit_f.inc"
63C-----------------------------------------------
64C C o m m o n B l o c k s
65C-----------------------------------------------
66#include "vect01_c.inc"
67#include "mvsiz_p.inc"
68#include "com01_c.inc"
69#include "param_c.inc"
70#include "scr17_c.inc"
71C-----------------------------------------------
72C D u m m y A r g u m e n t s
73C-----------------------------------------------
74C REAL
75 my_real
76 . solid_tensor(6,*), tens(6,*),epsdot(6,*),pm(npropm,*),x(3,*),d(3,*),
77 . solid_tensor_corner(6,*)
78 INTEGER IPARG(NPARG,*),ITENS, MAXNNOD,
79 . IXS(NIXS,*),EL2FA(*),IADG(NSPMD,*),IPM(NPROPMI,*),IXS10(6,*),
80 . NBF,NBPART,IPART(LIPART1,*),IPARTSP(*),IPARTS(*),
81 . ISPH3D,IGEO(NPROPGI,*),IS_WRITTEN_SOLID(*),ID_ELEM(*),ITY_ELEM(*),
82 . H3D_PART(*),INFO1,LAYER_INPUT,IR_INPUT,IS_INPUT,IT_INPUT,NG,IS_CORNER_DATA,ID
83 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
84 CHARACTER(NCHARLINE100) :: KEYWORD
85C-----------------------------------------------
86C L o c a l V a r i a b l e s
87C-----------------------------------------------
88 my_real
89 . evar(6,mvsiz),evar_corner(6,20,mvsiz)
90 my_real
91 . off, p,vonm2,s1,s2,s12,s3,VALUE,dmgmx,fac,
92 . dir1_1,dir1_2,dir2_1,dir2_2,aa,bb,v1,v2,v3,x21,x32,x34,
93 . x41,y21,y32,y34,y41,z21,z32,z34,z41,suma,vr,vs,x31,y31,
94 . z31,e11,e12,e13,e21,e22,e23,sum,area,x2l,var,
95 . e1x,e1y,e1z,e2x,e2y,e2z,e3x,e3y,e3z,rx,ry,rz,sx,sy,sz,
96 . vg(5),vly(5),ve(5),s11,s22,s33,s4,s5,s6,vonm, gama(6),evar_tmp(6),
97 . a1
98 my_real
99 . xn(8*mvsiz) , yn(8*mvsiz) , zn(8*mvsiz),
100 . dxn(8*mvsiz) ,dyn(8*mvsiz) , dzn(8*mvsiz),strain(6,mvsiz)
101 INTEGER I,I1,II,J,NEL,NPTR,NPTS,NPTT,NLAY,L,IFAIL,ILAY,
102 . IR,IS,IT,IL,MLW, NUVAR,IUS,LENF,PTF,PTM,PTS,NFAIL,
103 . N,NN,K,K1,K2,JTURB,MT,IMID,IALEL,IPID,ISH3N,NNI,
104 . NN1,NN2,NN3,NN4,NN5,NN6,NN9,NF,BUF,NVARF,
105 . IHBE,NPTM,NPG, MPT,IPT,IADD,IADR,IPMAT,IFAILT,
106 . IIGEO,IADI,ISUBSTACK,ITHK,
107 . ID_PLY,NB_PLYOFF
108 INTEGER PID(MVSIZ),MAT(MVSIZ),MATLY(MVSIZ*100),FAILG(100,MVSIZ),
109 . PTE(4),PTP(4),PTMAT(4),PTVAR(4),NPT_ALL,IPLY,
110 . ID_ELEM_TMP(MVSIZ),NIX,ISOLNOD,IVISC,NPTG,TSHELL,TSH_ORT,
111 . ISTRAIN,KCVT,IOR_TSH,MT1,ICSIG,PTI,IOK,IPRT,IOK_PART(MVSIZ),
112 . JJ(6),IS_WRITTEN_TENSOR(MVSIZ),KK(8)
113
114 REAL R4
115 TYPE(G_BUFEL_) ,POINTER :: GBUF
116 TYPE(L_BUFEL_) ,POINTER :: LBUF
117 TYPE(BUF_LAY_) ,POINTER :: BUFLY
118 TYPE(BUF_FAIL_) ,POINTER :: FBUF
119 my_real,
120 . DIMENSION(:), POINTER :: uvar
121 TYPE(L_BUFEL_) ,POINTER :: LBUF1,LBUF2,LBUF3,LBUF4
122 gbuf => elbuf_tab(ng)%GBUF
123 istrain = iparg(44,ng)
124 isolnod = iparg(28,ng)
125 ivisc = iparg(61,ng)
126 CALL initbuf(iparg ,ng ,
127 2 mlw ,nel ,nft ,iad ,ity ,
128 3 npt ,jale ,ismstr ,jeul ,jtur ,
129 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
130 5 nvaux ,jpor ,kcvt ,jclose ,jplasol ,
131 6 irep ,iint ,igtyp ,israt ,isrot ,
132 7 icsen ,isorth ,isorthg ,ifailure,jsms )
133!
134 DO i=1,6
135 jj(i) = nel*(i-1)
136 ENDDO
137!
138 IF(mlw /= 13 .AND. mlw /= 0) THEN
139 lft=1
140 llt=nel
141C-----------------------------------------------
142C SOLID 8N
143C-----------------------------------------------
144 IF (ity == 1) THEN
145
146
147 DO i=1,nel
148 id_elem(nft+i) = ixs(nixs,nft+i)
149 ity_elem(nft+i) = 1
150 iok_part(i) = 0
151 IF( h3d_part(iparts(nft+i)) == 1) iok_part(i) = 1
152 is_written_tensor(i) = 0
153 ENDDO
154
155 tshell = 0
156 ior_tsh = 0
157 IF (igtyp==20 .OR. igtyp==21 .OR. igtyp==22) tshell = 1
158 IF (igtyp == 21.OR.igtyp == 22) ior_tsh = 1
159 nlay = elbuf_tab(ng)%NLAY
160 nptr = elbuf_tab(ng)%NPTR
161 npts = elbuf_tab(ng)%NPTS
162 nptt = elbuf_tab(ng)%NPTT
163 nptg = nptt*npts*nptr
164 npt = nptg*nlay
165 pid=ixs(10,1 + nft)
166 mt1=ixs(1,1 + nft)
167C
168 IF (kcvt==1.AND.isorth/=0) kcvt=2
169 nuvar = ipm(8,mt1)
170 IF (igtyp /= 22) THEN
171 IF (isorth > 0) isorthg = 0
172 END IF
173 ilay = layer_input
174 ilay = -1
175 ir = ir_input
176 is = is_input
177 it = it_input
178 IF (ilay == -2) ilay = 1
179 IF (ilay == -3) ilay = nlay
180C-------- LAYER_INPUT not available yet fix in function of JHBE+IJK
181 IF (tshell == 1.AND.(ir_input/=-1.AND.is_input/=-1.AND.it_input/=-1)) THEN
182 IF (jhbe==15 ) THEN
183 ilay = is_input
184 ir = 1
185 is = 1
186 it = 1
187 ELSEIF (jhbe==14 ) THEN
188 icsig = iparg(17,ng)
189 IF (icsig==100) THEN
190 ir = is_input
191 is = it_input
192 ilay = ir_input
193 ELSEIF (icsig==10) THEN
194 ilay = is_input
195 ir = it_input
196 is = ir_input
197 ELSEIF (icsig==1) THEN
198 ilay = it_input
199 END IF
200 it = 1
201 ELSE
202 ilay = is_input
203 is = 1
204 END IF
205 END IF
206! tet10 to have 4 ipt
207 IF(isolnod == 10.OR.(isolnod == 4 .AND. isrot == 1))THEN
208 npts = 2
209 nptt = 2
210 END IF
211C-----------------------------------------------
212 IF (keyword == 'TENS/STRESS') THEN
213C-----------------------------------------------
214c ILAYER=NULL IR=NULL IS=NULL IT=NULL
215 IF( ilay == -1 .AND. ir == -1 .AND. is == -1 .AND. it == -1 )THEN
216 DO i=1,nel
217 ii = 6*(i-1)
218 evar(1,i) = gbuf%SIG(jj(1) + i)
219 evar(2,i) = gbuf%SIG(jj(2) + i)
220 evar(3,i) = gbuf%SIG(jj(3) + i)
221 evar(4,i) = gbuf%SIG(jj(4) + i)
222 evar(5,i) = gbuf%SIG(jj(5) + i)
223 evar(6,i) = gbuf%SIG(jj(6) + i)
224 is_written_tensor(i) = 1
225 ENDDO
226 IF(ivisc > 0) THEN
227 DO i=1,nel
228 DO ir=1,nptr
229 DO is=1,npts
230 DO it=1,nptt
231 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ir,is,it)
232 evar(1,i) =evar(1,i)+ lbuf%VISC(jj(1) + i)/nptg
233 evar(2,i) =evar(2,i)+ lbuf%VISC(jj(2) + i)/nptg
234 evar(3,i) =evar(3,i)+ lbuf%VISC(jj(3) + i)/nptg
235 evar(4,i) =evar(4,i)+ lbuf%VISC(jj(4) + i)/nptg
236 evar(5,i) =evar(5,i)+ lbuf%VISC(jj(5) + i)/nptg
237 evar(6,i) =evar(6,i)+ lbuf%VISC(jj(6) + i)/nptg
238 ENDDO !IT
239 ENDDO !IS
240 ENDDO !IR
241 ENDDO
242 ENDIF
243c
244 IF( nfilsol /= 0 .AND. gbuf%G_FILL /= 0 ) THEN
245 DO i=1,nel
246 evar(1,i) = evar(1,i) * gbuf%FILL(i)
247 evar(2,i) = evar(2,i) * gbuf%FILL(i)
248 evar(3,i) = evar(3,i) * gbuf%FILL(i)
249 evar(4,i) = evar(4,i) * gbuf%FILL(i)
250 evar(5,i) = evar(5,i) * gbuf%FILL(i)
251 evar(6,i) = evar(6,i) * gbuf%FILL(i)
252 ENDDO
253 ENDIF
254c
255 IF (kcvt /= 0 .AND. jhbe /= 16) THEN
256C STRESS TENSOR IN GLOBAL SYSTEM
257 DO i=1,nel
258 n = i + nft
259C pour JHBE=14, valeurs moyennes est dans rep. corota.
260 IF(kcvt==2.AND.jhbe/=14)THEN
261 ii = 6*(i-1)
262 gama(1)=gbuf%GAMA(jj(1) + i)
263 gama(2)=gbuf%GAMA(jj(2) + i)
264 gama(3)=gbuf%GAMA(jj(3) + i)
265 gama(4)=gbuf%GAMA(jj(4) + i)
266 gama(5)=gbuf%GAMA(jj(5) + i)
267 gama(6)=gbuf%GAMA(jj(6) + i)
268 ELSE
269 gama(1)=one
270 gama(2)=zero
271 gama(3)=zero
272 gama(4)=zero
273 gama(5)=one
274 gama(6)=zero
275 END IF
276 CALL srota6(
277 1 x, ixs(1,n), kcvt, evar(1,i),
278 2 gama, jhbe, igtyp, isorth)
279 ENDDO
280 ENDIF !KCVT /=
281 ELSEIF ( ilay == -1 .AND. ir >= 0 .AND. ir <= nptr .AND.
282 . is >= 0 .AND. is <= npts .AND. it >= 0 .AND. it <= nptt) THEN
283c IR= IS= IT=
284c-----------
285 IF (isolnod == 8 .AND. igtyp == 43) THEN
286c-----------
287 DO i=1,nel
288 evar(1,i) = zero
289 evar(2,i) = zero
290 evar(3,i) = zero
291 evar(4,i) = zero
292 evar(5,i) = zero
293 evar(6,i) = zero
294 ENDDO
295 IF(ivisc == 0) THEN
296 DO i=1,nel
297 ii = 6*(i-1)
298 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ir,1,1)
299 evar(3,i) = evar(3,i) + lbuf%SIG(jj(3) + i)
300 evar(2,i) = evar(2,i) + lbuf%SIG(jj(5) + i)
301 evar(1,i) = evar(1,i) + lbuf%SIG(jj(6) + i)
302 is_written_tensor(i) = 1
303 ENDDO
304 ELSE
305 DO i=1,nel
306 ii = 6*(i-1)
307 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ir,1,1)
308 evar(3,i)= evar(3,i)+ lbuf%SIG(jj(3) + i)+ lbuf%VISC(jj(3) + i)
309 evar(2,i)= evar(2,i)+ lbuf%SIG(jj(5) + i)+ lbuf%VISC(jj(5) + i)
310 evar(1,i)= evar(1,i)+ lbuf%SIG(jj(6) + i)+ lbuf%VISC(jj(6) + i)
311 is_written_tensor(i) = 1
312 ENDDO
313 ENDIF
314 DO i=1,nel
315 n = i + nft
316 CALL srota6(
317 1 x, ixs(1,n), kcvt, evar(1,i),
318 2 gama, jhbe, igtyp, isorth)
319 ENDDO
320c-----------
321 ELSEIF (isolnod == 8.AND.npt == 8.AND.
322 . jhbe /= 14.AND.jhbe /= 24.AND.jhbe /= 15) THEN
323c-----------
324 IF (ir == 0 .AND. it == 0)THEN
325 DO i=1,nel
326 evar(1,i) = zero
327 evar(2,i) = zero
328 evar(3,i) = zero
329 evar(4,i) = zero
330 evar(5,i) = zero
331 evar(6,i) = zero
332 ENDDO
333 ELSE
334 ipt = ir + ( (is-1) + (it-1)*npts )*nptr
335 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ir,is,it)
336 IF (ipt <= 8 )THEN
337 DO i=1,nel
338 ii = 6*(i-1)
339 evar(1,i) = lbuf%SIG(jj(1) + i)
340 evar(2,i) = lbuf%SIG(jj(2) + i)
341 evar(3,i) = lbuf%SIG(jj(3) + i)
342 evar(4,i) = lbuf%SIG(jj(4) + i)
343 evar(5,i) = lbuf%SIG(jj(5) + i)
344 evar(6,i) = lbuf%SIG(jj(6) + i)
345 is_written_tensor(i) = 1
346 ENDDO
347 IF(ivisc > 0) THEN
348 DO i=1,nel
349 ii = 6*(i-1)
350 evar(1,i) =evar(1,i)+lbuf%VISC(jj(1) + i)
351 evar(2,i) =evar(2,i)+lbuf%VISC(jj(2) + i)
352 evar(3,i) =evar(3,i)+lbuf%VISC(jj(3) + i)
353 evar(4,i) =evar(4,i)+lbuf%VISC(jj(4) + i)
354 evar(5,i) =evar(5,i)+lbuf%VISC(jj(5) + i)
355 evar(6,i) =evar(6,i)+lbuf%VISC(jj(6) + i)
356 ENDDO
357 ENDIF
358
359 ELSE
360 DO i=1,nel
361 evar(1,i) = zero
362 evar(2,i) = zero
363 evar(3,i) = zero
364 evar(4,i) = zero
365 evar(5,i) = zero
366 evar(6,i) = zero
367 ENDDO
368 ENDIF
369 IF (kcvt /= 0) THEN
370C STRESS TENSOR IN GLOBAL SYSTEM
371 DO i=1,nel
372 n = i + nft
373 IF(kcvt==2)THEN
374 ii = 6*(i-1)
375 gama(1)= gbuf%GAMA(jj(1) + i)
376 gama(2)= gbuf%GAMA(jj(2) + i)
377 gama(3)= gbuf%GAMA(jj(3) + i)
378 gama(4)= gbuf%GAMA(jj(4) + i)
379 gama(5)= gbuf%GAMA(jj(5) + i)
380 gama(6)= gbuf%GAMA(jj(6) + i)
381 ELSE
382 gama(1)=one
383 gama(2)=zero
384 gama(3)=zero
385 gama(4)=zero
386 gama(5)=one
387 gama(6)=zero
388 END IF
389 CALL srota6(
390 1 x, ixs(1,n), kcvt, evar(1,i),
391 2 gama, jhbe, igtyp, isorth)
392 ENDDO
393 ENDIF
394 ENDIF
395c-----------
396 ELSEIF((isolnod == 8.OR.npt == 1) .AND.
397 . jhbe /= 14.AND.jhbe /= 15.AND.jhbe /= 17)THEN
398c-----------
399 nptr= one
400 npts= one
401 nptt= one
402 IF (ir == 0 .AND. it == 0)THEN
403 DO i=1,nel
404 evar(1,i) = zero
405 evar(2,i) = zero
406 evar(3,i) = zero
407 evar(4,i) = zero
408 evar(5,i) = zero
409 evar(6,i) = zero
410 ENDDO
411 ELSE
412 ipt = ir + ( (is-1) + (it-1)*npts )*nptr
413 IF (ipt == 1 )THEN
414 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
415 DO i=1,nel
416 ii = 6*(i-1)
417 evar(1,i) = lbuf%SIG(jj(1) + i)
418 evar(2,i) = lbuf%SIG(jj(2) + i)
419 evar(3,i) = lbuf%SIG(jj(3) + i)
420 evar(4,i) = lbuf%SIG(jj(4) + i)
421 evar(5,i) = lbuf%SIG(jj(5) + i)
422 evar(6,i) = lbuf%SIG(jj(6) + i)
423 is_written_tensor(i) = 1
424 ENDDO
425 IF(ivisc > 0) THEN
426 DO i=1,nel
427 ii = 6*(i-1)
428 evar(1,i) =evar(1,i)+lbuf%VISC(jj(1) + i)
429 evar(2,i) =evar(2,i)+lbuf%VISC(jj(2) + i)
430 evar(3,i) =evar(3,i)+lbuf%VISC(jj(3) + i)
431 evar(4,i) =evar(4,i)+lbuf%VISC(jj(4) + i)
432 evar(5,i) =evar(5,i)+lbuf%VISC(jj(5) + i)
433 evar(6,i) =evar(6,i)+lbuf%VISC(jj(6) + i)
434 ENDDO
435 ENDIF
436 ELSE
437 DO i=1,nel
438 evar(1,i) = zero
439 evar(2,i) = zero
440 evar(3,i) = zero
441 evar(4,i) = zero
442 evar(5,i) = zero
443 evar(6,i) = zero
444 ENDDO
445 ENDIF
446 IF (kcvt /= 0) THEN
447C STRESS TENSOR IN GLOBAL SYSTEM
448 DO i=1,nel
449 n = i + nft
450 IF(kcvt==2)THEN
451 ii = 6*(i-1)
452 gama(1)=gbuf%GAMA(jj(1) + i)
453 gama(2)=gbuf%GAMA(jj(2) + i)
454 gama(3)=gbuf%GAMA(jj(3) + i)
455 gama(4)=gbuf%GAMA(jj(4) + i)
456 gama(5)=gbuf%GAMA(jj(5) + i)
457 gama(6)=gbuf%GAMA(jj(6) + i)
458 ELSE
459 gama(1)=one
460 gama(2)=zero
461 gama(3)=zero
462 gama(4)=zero
463 gama(5)=one
464 gama(6)=zero
465 END IF
466 CALL srota6(
467 1 x, ixs(1,n), kcvt, evar(1,i),
468 2 gama, jhbe, igtyp, isorth)
469 ENDDO
470 ENDIF
471 ENDIF
472c-----------
473 ELSEIF (isolnod == 20 .OR. isolnod == 16) THEN
474c-----------
475 IF (ir == 0 .AND. it == 0)THEN
476 DO i=1,nel
477 evar(1,i) = zero
478 evar(2,i) = zero
479 evar(3,i) = zero
480 evar(4,i) = zero
481 evar(5,i) = zero
482 evar(6,i) = zero
483 ENDDO
484 ELSE
485 ipt = ir + ( (is-1) + (it-1)*npts )*nptr
486 IF (ipt <= nptg .AND. ir <= nptr .AND. is <= npts
487 . .AND. it <= nptt) THEN
488 IF (tshell == 1) THEN
489 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,it)
490 ELSE
491 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ir,is,it)
492 END IF
493 DO i=1,nel
494 ii = 6*(i-1)
495 evar(1,i) = lbuf%SIG(jj(1) + i)
496 evar(2,i) = lbuf%SIG(jj(2) + i)
497 evar(3,i) = lbuf%SIG(jj(3) + i)
498 evar(4,i) = lbuf%SIG(jj(4) + i)
499 evar(5,i) = lbuf%SIG(jj(5) + i)
500 evar(6,i) = lbuf%SIG(jj(6) + i)
501 is_written_tensor(i) = 1
502 ENDDO
503 IF(ivisc > 0) THEN
504 DO i=1,nel
505 ii = 6*(i-1)
506 evar(1,i) =evar(1,i)+lbuf%VISC(jj(1) + i)
507 evar(2,i) =evar(2,i)+lbuf%VISC(jj(2) + i)
508 evar(3,i) =evar(3,i)+lbuf%VISC(jj(3) + i)
509 evar(4,i) =evar(4,i)+lbuf%VISC(jj(4) + i)
510 evar(5,i) =evar(5,i)+lbuf%VISC(jj(5) + i)
511 evar(6,i) =evar(6,i)+lbuf%VISC(jj(6) + i)
512 ENDDO
513 ENDIF
514 ELSE
515 DO i=1,nel
516 evar(1,i) = zero
517 evar(2,i) = zero
518 evar(3,i) = zero
519 evar(4,i) = zero
520 evar(5,i) = zero
521 evar(6,i) = zero
522 ENDDO
523 ENDIF
524 IF (kcvt /= 0 .AND. jhbe /= 16) THEN
525C STRESS TENSOR IN GLOBAL SYSTEM
526 DO i=1,nel
527 n = i + nft
528 IF(kcvt==2)THEN
529 ii = 6*(i-1)
530 gama(1)=gbuf%GAMA(jj(1) + i)
531 gama(2)=gbuf%GAMA(jj(2) + i)
532 gama(3)=gbuf%GAMA(jj(3) + i)
533 gama(4)=gbuf%GAMA(jj(4) + i)
534 gama(5)=gbuf%GAMA(jj(5) + i)
535 gama(6)=gbuf%GAMA(jj(6) + i)
536 ELSE
537 gama(1)=one
538 gama(2)=zero
539 gama(3)=zero
540 gama(4)=zero
541 gama(5)=one
542 gama(6)=zero
543 END IF
544 CALL srota6(
545 1 x, ixs(1,n), kcvt, evar(1,i),
546 2 gama, jhbe, igtyp, isorth)
547 ENDDO
548 ENDIF
549 ENDIF
550c-----------
551 ELSEIF (isolnod == 8 .AND. (jhbe == 14.OR.jhbe == 17) )THEN
552c----------- voir !!!
553 icsig = iparg(17,ng)
554 nptg = nptr * npts * nptt * nlay
555 ipid = ixs(10,1 + nft)
556 IF (ir == 0 .AND. it == 0)THEN
557 DO i=1,nel
558 evar(1,i) = zero
559 evar(2,i) = zero
560 evar(3,i) = zero
561 evar(4,i) = zero
562 evar(5,i) = zero
563 evar(6,i) = zero
564 ENDDO
565 ELSE
566 IF (ior_tsh >0) THEN
567 IF (icsig == 10) THEN
568 ir=it_input
569 is=ir_input
570 it=is_input
571 ELSEIF (icsig == 1) THEN
572 ir=is_input
573 is=it_input
574 it=ir_input
575 ELSE
576 ir=ir_input
577 is=is_input
578 it=it_input
579 ENDIF
580 ENDIF
581 ipt = ir + ( (is-1) + (it-1)*npts )*nptr
582 iok = 0
583 IF(ir <= nptr .AND. is <= npts .AND. it <= nptt) THEN
584 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ir,is,it)
585 iok = 1
586 ENDIF
587 IF ( ipt <= nptg .AND. iok == 1) THEN
588 DO i=1,nel
589 ii = 6*(i-1)
590 evar(1,i) = lbuf%SIG(jj(1) + i)
591 evar(2,i) = lbuf%SIG(jj(2) + i)
592 evar(3,i) = lbuf%SIG(jj(3) + i)
593 evar(4,i) = lbuf%SIG(jj(4) + i)
594 evar(5,i) = lbuf%SIG(jj(5) + i)
595 evar(6,i) = lbuf%SIG(jj(6) + i)
596 is_written_tensor(i) = 1
597 ENDDO
598 IF(ivisc > 0) THEN
599 DO i=1,nel
600 ii = 6*(i-1)
601 evar(1,i) =evar(1,i)+lbuf%VISC(jj(1) + i)
602 evar(2,i) =evar(2,i)+lbuf%VISC(jj(2) + i)
603 evar(3,i) =evar(3,i)+lbuf%VISC(jj(3) + i)
604 evar(4,i) =evar(4,i)+lbuf%VISC(jj(4) + i)
605 evar(5,i) =evar(5,i)+lbuf%VISC(jj(5) + i)
606 evar(6,i) =evar(6,i)+lbuf%VISC(jj(6) + i)
607 ENDDO
608 ENDIF
609 ELSE
610 DO i=1,nel
611 evar(1,i) = zero
612 evar(2,i) = zero
613 evar(3,i) = zero
614 evar(4,i) = zero
615 evar(5,i) = zero
616 evar(6,i) = zero
617 ENDDO
618 ENDIF
619 IF (kcvt /= 0) THEN
620C STRESS TENSOR IN GLOBAL SYSTEM
621C--------------thick shells----only pid21,irep=0--works--------
622 IF (icsig >0) THEN
623 SELECT CASE (icsig)
624 CASE (1)
625 DO i=1,nel
626 n = i + nft
627 IF(kcvt==2)THEN
628 ii = 6*(i-1)
629 gama(1)=zero
630 gama(2)=lbuf%GAMA(jj(1) + i)
631 gama(3)=lbuf%GAMA(jj(2) + i)
632 gama(4)=zero
633 gama(5)=-gama(2)
634 gama(6)=gama(1)
635 ELSE
636 gama(1)=one
637 gama(2)=zero
638 gama(3)=zero
639 gama(4)=zero
640 gama(5)=one
641 gama(6)=zero
642 END IF
643 CALL srota6(
644 1 x, ixs(1,n), kcvt, evar(1,i),
645 2 gama, jhbe, igtyp, isorth)
646 ENDDO
647 CASE (10)
648 DO i=1,nel
649 n = i + nft
650 IF(kcvt==2)THEN
651 ii = 6*(i-1)
652 gama(1)=lbuf%GAMA(jj(1) + i)
653 gama(2)=lbuf%GAMA(jj(2) + i)
654 gama(3)=zero
655 gama(4)=-gama(2)
656 gama(5)=gama(1)
657 gama(6)=zero
658 ELSE
659 gama(1)=one
660 gama(2)=zero
661 gama(3)=zero
662 gama(4)=zero
663 gama(5)=one
664 gama(6)=zero
665 END IF
666 CALL srota6(
667 1 x, ixs(1,n), kcvt, evar(1,i),
668 2 gama, jhbe, igtyp, isorth)
669 ENDDO
670 CASE (100)
671 DO i=1,nel
672 n = i + nft
673 IF(kcvt==2)THEN
674 ii = 6*(i-1)
675 gama(1)=lbuf%GAMA(jj(2) + i)
676 gama(2)=zero
677 gama(3)=lbuf%GAMA(jj(1) + i)
678 gama(4)=gama(3)
679 gama(5)=zero
680 gama(6)=-gama(1)
681 ELSE
682 gama(1)=one
683 gama(2)=zero
684 gama(3)=zero
685 gama(4)=zero
686 gama(5)=one
687 gama(6)=zero
688 END IF
689 CALL srota6(
690 1 x, ixs(1,n), kcvt, evar(1,i),
691 2 gama, jhbe, igtyp, isorth)
692 ENDDO
693 END SELECT
694 ELSE
695 DO i=1,nel
696 n = i + nft
697 IF(kcvt==2)THEN
698 ii = 6*(i-1)
699 gama(1)=gbuf%GAMA(jj(1) + i)
700 gama(2)=gbuf%GAMA(jj(2) + i)
701 gama(3)=gbuf%GAMA(jj(3) + i)
702 gama(4)=gbuf%GAMA(jj(4) + i)
703 gama(5)=gbuf%GAMA(jj(5) + i)
704 gama(6)=gbuf%GAMA(jj(6) + i)
705 ELSE
706 gama(1)=one
707 gama(2)=zero
708 gama(3)=zero
709 gama(4)=zero
710 gama(5)=one
711 gama(6)=zero
712 END IF
713 CALL srota6(
714 1 x, ixs(1,n), kcvt, evar(1,i),
715 2 gama, jhbe, igtyp, isorth)
716 ENDDO
717 ENDIF !(ICSIG >0)
718 ENDIF
719 ENDIF
720c-----------
721 ELSEIF(isolnod == 10.OR.(isolnod == 4 .AND. isrot == 1))THEN
722c-----------
723 IF (ir == 0 .AND. it == 0)THEN
724 DO i=1,nel
725 evar(1,i) = zero
726 evar(2,i) = zero
727 evar(3,i) = zero
728 evar(4,i) = zero
729 evar(5,i) = zero
730 evar(6,i) = zero
731 ENDDO
732 ELSE
733 ipt = 0
734 IF (ir == 1 .AND. is == 1 .AND. it == 1) ipt = 1
735 IF (ir == 2 .AND. is == 1 .AND. it == 1) ipt = 2
736 IF (ir == 1 .AND. is == 2 .AND. it == 1) ipt = 3
737 IF (ir == 1 .AND. is == 1 .AND. it == 2) ipt = 4
738 IF (ipt > 0) THEN
739 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ipt,1,1)
740 DO i=1,nel
741 ii = 6*(i-1)
742 evar(1,i) = lbuf%SIG(jj(1) + i)
743 evar(2,i) = lbuf%SIG(jj(2) + i)
744 evar(3,i) = lbuf%SIG(jj(3) + i)
745 evar(4,i) = lbuf%SIG(jj(4) + i)
746 evar(5,i) = lbuf%SIG(jj(5) + i)
747 evar(6,i) = lbuf%SIG(jj(6) + i)
748 is_written_tensor(i) = 1
749 ENDDO
750 IF(ivisc > 0) THEN
751 DO i=1,nel
752 ii = 6*(i-1)
753 evar(1,i) =evar(1,i)+lbuf%VISC(jj(1) + i)
754 evar(2,i) =evar(2,i)+lbuf%VISC(jj(2) + i)
755 evar(3,i) =evar(3,i)+lbuf%VISC(jj(3) + i)
756 evar(4,i) =evar(4,i)+lbuf%VISC(jj(4) + i)
757 evar(5,i) =evar(5,i)+lbuf%VISC(jj(5) + i)
758 evar(6,i) =evar(6,i)+lbuf%VISC(jj(6) + i)
759 ENDDO
760 ENDIF
761 ELSE
762 DO i=1,nel
763 evar(1,i) = zero
764 evar(2,i) = zero
765 evar(3,i) = zero
766 evar(4,i) = zero
767 evar(5,i) = zero
768 evar(6,i) = zero
769 ENDDO
770 ENDIF
771 IF (kcvt /= 0) THEN
772C STRESS TENSOR IN GLOBAL SYSTEM
773 DO i=1,nel
774 n = i + nft
775 IF(kcvt==2)THEN
776 ii = 6*(i-1)
777 gama(1)=gbuf%GAMA(jj(1) + i)
778 gama(2)=gbuf%GAMA(jj(2) + i)
779 gama(3)=gbuf%GAMA(jj(3) + i)
780 gama(4)=gbuf%GAMA(jj(4) + i)
781 gama(5)=gbuf%GAMA(jj(5) + i)
782 gama(6)=gbuf%GAMA(jj(6) + i)
783 ELSE
784 gama(1)=one
785 gama(2)=zero
786 gama(3)=zero
787 gama(4)=zero
788 gama(5)=one
789 gama(6)=zero
790 END IF
791 CALL srota6(
792 1 x, ixs(1,n), kcvt, evar(1,i),
793 2 gama, jhbe, igtyp, isorth)
794 ENDDO
795 ENDIF
796 ENDIF
797 ENDIF
798
799c-----------
800CiLAY = ir= is=
801c-----------
802 ELSEIF ( ilay >= 0 .AND. ilay <= nlay .AND. ir >= 0 .AND. ir <= nptr .AND.
803 . is >= 0 .AND. is <= npts) THEN
804c-----------
805 IF((isolnod == 6.OR.isolnod == 8).AND.jhbe == 15)THEN
806c-----------
807 ipt = is
808 IF ( ilay <= npt) THEN
809 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(1,1,1)
810 DO i=1,nel
811 evar(1,i) = lbuf%SIG(jj(1) + i)
812 evar(2,i) = lbuf%SIG(jj(2) + i)
813 evar(3,i) = lbuf%SIG(jj(3) + i)
814 evar(4,i) = lbuf%SIG(jj(4) + i)
815 evar(5,i) = lbuf%SIG(jj(5) + i)
816 evar(6,i) = lbuf%SIG(jj(6) + i)
817 is_written_tensor(i) = 1
818 ENDDO
819 IF(ivisc > 0) THEN
820 DO i=1,nel
821 evar(1,i) =evar(1,i)+lbuf%VISC(jj(1) + i)
822 evar(2,i) =evar(2,i)+lbuf%VISC(jj(2) + i)
823 evar(3,i) =evar(3,i)+lbuf%VISC(jj(3) + i)
824 evar(4,i) =evar(4,i)+lbuf%VISC(jj(4) + i)
825 evar(5,i) =evar(5,i)+lbuf%VISC(jj(5) + i)
826 evar(6,i) =evar(6,i)+lbuf%VISC(jj(6) + i)
827 ENDDO
828 ENDIF
829 ELSE
830 DO i=1,nel
831 evar(1,i) = zero
832 evar(2,i) = zero
833 evar(3,i) = zero
834 evar(4,i) = zero
835 evar(5,i) = zero
836 evar(6,i) = zero
837 ENDDO
838 ENDIF
839 IF (kcvt /= 0 .AND. ilay <= npt) THEN
840 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(1,1,1)
841C STRESS TENSOR IN GLOBAL SYSTEM
842 DO i=1,nel
843 n = i + nft
844 IF(kcvt==2)THEN
845 ii = 6*(i-1)
846 gama(1)= gbuf%GAMA(jj(1) + i)
847 gama(2)= gbuf%GAMA(jj(2) + i)
848 gama(3)= zero
849 gama(4)=-gama(2)
850 gama(5)= gama(1)
851 gama(6)= zero
852 ELSE
853 gama(1)=one
854 gama(2)=zero
855 gama(3)=zero
856 gama(4)=zero
857 gama(5)=one
858 gama(6)=zero
859 END IF
860 CALL srota6(
861 1 x, ixs(1,n), kcvt, evar(1,i),
862 2 gama, jhbe, igtyp, isorth)
863 ENDDO
864 ENDIF
865 ELSEIF (isolnod == 16.OR.(isolnod ==8.AND.(jhbe == 14.OR.jhbe == 17)))THEN
866c-----------
867 icsig = iparg(17,ng)
868 nptg = nptr * npts * nptt * nlay
869 ipid = ixs(10,1 + nft)
870 IF (ir == 0 .OR. is == 0 .OR. it == 0)THEN
871 DO i=1,nel
872 evar(1,i) = zero
873 evar(2,i) = zero
874 evar(3,i) = zero
875 evar(4,i) = zero
876 evar(5,i) = zero
877 evar(6,i) = zero
878 ENDDO
879 ELSE
880 IF (tshell == 1 ) THEN
881 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,1)
882 IF (isolnod == 16) lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,1,it)
883 DO i=1,nel
884 evar(1,i) = lbuf%SIG(jj(1) + i)
885 evar(2,i) = lbuf%SIG(jj(2) + i)
886 evar(3,i) = lbuf%SIG(jj(3) + i)
887 evar(4,i) = lbuf%SIG(jj(4) + i)
888 evar(5,i) = lbuf%SIG(jj(5) + i)
889 evar(6,i) = lbuf%SIG(jj(6) + i)
890 is_written_tensor(i) = 1
891 ENDDO
892 IF(ivisc > 0) THEN
893 DO i=1,nel
894 evar(1,i) =evar(1,i)+lbuf%VISC(jj(1) + i)
895 evar(2,i) =evar(2,i)+lbuf%VISC(jj(2) + i)
896 evar(3,i) =evar(3,i)+lbuf%VISC(jj(3) + i)
897 evar(4,i) =evar(4,i)+lbuf%VISC(jj(4) + i)
898 evar(5,i) =evar(5,i)+lbuf%VISC(jj(5) + i)
899 evar(6,i) =evar(6,i)+lbuf%VISC(jj(6) + i)
900 ENDDO
901 ENDIF
902 IF (kcvt /= 0) THEN
903C STRESS TENSOR IN GLOBAL SYSTEM
904C--------------thick shells----only pid21,irep=0--works--------
905 IF (icsig >0) THEN
906 SELECT CASE (icsig)
907 CASE (1)
908 DO i=1,nel
909 n = i + nft
910 IF(kcvt==2.AND.igtyp == 22)THEN
911 gama(1)=zero
912 gama(2)=lbuf%GAMA(jj(1) + i)
913 gama(3)=lbuf%GAMA(jj(2) + i)
914 gama(4)=zero
915 gama(5)=-gama(2)
916 gama(6)=gama(1)
917 ELSEIF(kcvt==2.AND.igtyp == 21)THEN
918 gama(1)=zero
919 gama(2)=gbuf%GAMA(jj(1) + i)
920 gama(3)=gbuf%GAMA(jj(2) + i)
921 gama(4)=zero
922 gama(5)=-gama(2)
923 gama(6)=gama(1)
924 ELSE
925 gama(1)=one
926 gama(2)=zero
927 gama(3)=zero
928 gama(4)=zero
929 gama(5)=one
930 gama(6)=zero
931 END IF
932 CALL srota6(
933 1 x, ixs(1,n), kcvt, evar(1,i),
934 2 gama, jhbe, igtyp, isorth)
935 ENDDO
936 CASE (10)
937 DO i=1,nel
938 n = i + nft
939 IF(kcvt==2.AND.igtyp == 22)THEN
940 gama(1)=lbuf%GAMA(jj(1) + i)
941 gama(2)=lbuf%GAMA(jj(2) + i)
942 gama(3)=zero
943 gama(4)=-gama(2)
944 gama(5)=gama(1)
945 gama(6)=zero
946 ELSEIF(kcvt==2.AND.igtyp == 21)THEN
947 gama(1)=gbuf%GAMA(jj(1) + i)
948 gama(2)=gbuf%GAMA(jj(2) + i)
949 gama(3)=zero
950 gama(4)=-gama(2)
951 gama(5)=gama(1)
952 gama(6)=zero
953 ELSE
954 gama(1)=one
955 gama(2)=zero
956 gama(3)=zero
957 gama(4)=zero
958 gama(5)=one
959 gama(6)=zero
960 END IF
961 CALL srota6(
962 1 x, ixs(1,n), kcvt, evar(1,i),
963 2 gama, jhbe, igtyp, isorth)
964 ENDDO
965 CASE (100)
966 DO i=1,nel
967 n = i + nft
968 IF(kcvt==2.AND.igtyp == 22)THEN
969 gama(1)=lbuf%GAMA(jj(2) + i)
970 gama(2)=zero
971 gama(3)=lbuf%GAMA(jj(1) + i)
972 gama(4)=gama(3)
973 gama(5)=zero
974 gama(6)=-gama(1)
975 ELSEIF(kcvt==2.AND.igtyp == 21)THEN
976 gama(1)=gbuf%GAMA(jj(2) + i)
977 gama(2)=zero
978 gama(3)=gbuf%GAMA(jj(1) + i)
979 gama(4)=gama(3)
980 gama(5)=zero
981 gama(6)=-gama(1)
982 ELSE
983 gama(1)=one
984 gama(2)=zero
985 gama(3)=zero
986 gama(4)=zero
987 gama(5)=one
988 gama(6)=zero
989 END IF
990 CALL srota6(
991 1 x, ixs(1,n), kcvt, evar(1,i),
992 2 gama, jhbe, igtyp, isorth)
993 ENDDO
994 END SELECT
995 ELSE
996 DO i=1,nel
997 n = i + nft
998 IF(kcvt==2)THEN
999 gama(1)=gbuf%GAMA(jj(1) + i)
1000 gama(2)=gbuf%GAMA(jj(2) + i)
1001 gama(3)=gbuf%GAMA(jj(3) + i)
1002 gama(4)=gbuf%GAMA(jj(4) + i)
1003 gama(5)=gbuf%GAMA(jj(5) + i)
1004 gama(6)=gbuf%GAMA(jj(6) + i)
1005 ELSE
1006 gama(1)=one
1007 gama(2)=zero
1008 gama(3)=zero
1009 gama(4)=zero
1010 gama(5)=one
1011 gama(6)=zero
1012 END IF
1013 CALL srota6(
1014 1 x, ixs(1,n), kcvt, evar(1,i),
1015 2 gama, jhbe, igtyp, isorth)
1016 ENDDO
1017 ENDIF !(ICSIG >0)
1018 ENDIF
1019 ENDIF
1020 ENDIF
1021 ENDIF
1022
1023c-----------
1024 ELSEIF ( ilay >= 0 .AND. ilay <= nlay) THEN
1025c ILAY= IS= IT=
1026 evar(1:6,1:nel) = zero
1027c-----------
1028 IF((isolnod == 6.OR.isolnod == 8).AND.jhbe == 15)THEN
1029c-----------
1030 ipt = is
1031 IF ( ilay <= npt) THEN
1032 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(1,1,1)
1033 DO i=1,nel
1034 ii = 6*(i-1)
1035 evar(1,i) = lbuf%SIG(jj(1) + i)
1036 evar(2,i) = lbuf%SIG(jj(2) + i)
1037 evar(3,i) = lbuf%SIG(jj(3) + i)
1038 evar(4,i) = lbuf%SIG(jj(4) + i)
1039 evar(5,i) = lbuf%SIG(jj(5) + i)
1040 evar(6,i) = lbuf%SIG(jj(6) + i)
1041 is_written_tensor(i) = 1
1042 ENDDO
1043 IF(ivisc > 0) THEN
1044 DO i=1,nel
1045 ii = 6*(i-1)
1046 evar(1,i) =evar(1,i)+lbuf%VISC(jj(1) + i)
1047 evar(2,i) =evar(2,i)+lbuf%VISC(jj(2) + i)
1048 evar(3,i) =evar(3,i)+lbuf%VISC(jj(3) + i)
1049 evar(4,i) =evar(4,i)+lbuf%VISC(jj(4) + i)
1050 evar(5,i) =evar(5,i)+lbuf%VISC(jj(5) + i)
1051 evar(6,i) =evar(6,i)+lbuf%VISC(jj(6) + i)
1052 ENDDO
1053 ENDIF
1054 ELSE
1055 DO i=1,nel
1056 evar(1,i) = zero
1057 evar(2,i) = zero
1058 evar(3,i) = zero
1059 evar(4,i) = zero
1060 evar(5,i) = zero
1061 evar(6,i) = zero
1062 ENDDO
1063 ENDIF
1064 IF (kcvt /= 0 .AND. ilay <= npt) THEN
1065 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(1,1,1)
1066C STRESS TENSOR IN GLOBAL SYSTEM
1067 DO i=1,nel
1068 n = i + nft
1069 IF(kcvt==2)THEN
1070 ii = 6*(i-1)
1071 gama(1)= gbuf%GAMA(jj(1) + i)
1072 gama(2)= gbuf%GAMA(jj(2) + i)
1073 gama(3)= zero
1074 gama(4)=-gama(2)
1075 gama(5)= gama(1)
1076 gama(6)= zero
1077 ELSE
1078 gama(1)=one
1079 gama(2)=zero
1080 gama(3)=zero
1081 gama(4)=zero
1082 gama(5)=one
1083 gama(6)=zero
1084 END IF
1085 CALL srota6(
1086 1 x, ixs(1,n), kcvt, evar(1,i),
1087 2 gama, jhbe, igtyp, isorth)
1088 ENDDO
1089 ENDIF
1090 ENDIF
1091 ENDIF
1092c
1093 IF( nfilsol /= 0 .AND. gbuf%G_FILL /= 0 ) THEN
1094 DO i=1,nel
1095 evar(1,i) = evar(1,i) * gbuf%FILL(i)
1096 evar(2,i) = evar(2,i) * gbuf%FILL(i)
1097 evar(3,i) = evar(3,i) * gbuf%FILL(i)
1098 evar(4,i) = evar(4,i) * gbuf%FILL(i)
1099 evar(5,i) = evar(5,i) * gbuf%FILL(i)
1100 evar(6,i) = evar(6,i) * gbuf%FILL(i)
1101 ENDDO
1102 ENDIF
1103C
1104C-----------------------------------------------
1105 ELSEIF (keyword == 'TENS/STRAIN') THEN
1106C-----------------------------------------------
1107c ILAYER=NULL IR=NULL IS=NULL IT=NULL
1108 IF( ilay == -1 .AND. ir == -1 .AND. is == -1 .AND. it == -1 )THEN
1109 DO i=1,nel
1110 evar(1,i) = zero
1111 evar(2,i) = zero
1112 evar(3,i) = zero
1113 evar(4,i) = zero
1114 evar(5,i) = zero
1115 evar(6,i) = zero
1116 ENDDO
1117c-----------
1118 IF (isolnod == 8 .AND. igtyp == 43) THEN
1119c-----------
1120 DO i=1,nel
1121 ii = 3*(i-1)
1122 DO ipt= 1,nptr
1123 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ipt,1,1)
1124 evar(3,i) = evar(3,i) + lbuf%EPE(jj(1) + i)/npt
1125 evar(2,i) = evar(2,i) + lbuf%EPE(jj(2) + i)/npt
1126 evar(1,i) = evar(1,i) + lbuf%EPE(jj(3) + i)/npt
1127 is_written_tensor(i) = 1
1128 ENDDO
1129 ENDDO
1130 DO i=1,nel
1131 n = i + nft
1132 CALL srota6(
1133 1 x, ixs(1,n), kcvt, evar(1,i),
1134 2 gama, jhbe, igtyp, isorth)
1135 ENDDO
1136c-----------
1137 ELSEIF (isolnod == 8 .AND. npt == 8 .AND. jhbe /= 14.AND.
1138 . jhbe /= 24.AND.jhbe /= 15.AND.jhbe /= 17 )THEN
1139c-----------
1140 nvaux =iparg(18,ng)
1141 IF (mlw>=28) THEN
1142 DO i=1,nel
1143 ii = 6*(i-1)
1144 n = i + nft
1145 DO j=1,8
1146 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,j)
1147 evar(1,i) = evar(1,i) + lbuf%STRA(jj(1) + i)*one_over_8
1148 evar(2,i) = evar(2,i) + lbuf%STRA(jj(2) + i)*one_over_8
1149 evar(3,i) = evar(3,i) + lbuf%STRA(jj(3) + i)*one_over_8
1150 evar(4,i) = evar(4,i) + lbuf%STRA(jj(4) + i)*one_over_8
1151 evar(5,i) = evar(5,i) + lbuf%STRA(jj(5) + i)*one_over_8
1152 evar(6,i) = evar(6,i) + lbuf%STRA(jj(6) + i)*one_over_8
1153 is_written_tensor(i) = 1
1154 ENDDO
1155 ENDDO
1156 ENDIF
1157c-----------
1158 ELSEIF ((isolnod==8.OR.(isolnod==4 .AND. (isrot==0.OR.isrot==3))).AND.
1159 . npt==1 .AND. jhbe /= 14 .AND. jhbe /= 15) THEN
1160c-----------
1161 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
1162 IF (isorth > 0) isorthg = 1
1163c
1164 IF (mlw>=28.AND.mlw /= 49) THEN
1165 DO i=1,nel
1166 n = i + nft
1167 ii = 6*(i-1)
1168 evar(1,i) = lbuf%STRA(jj(1) + i)
1169 evar(2,i) = lbuf%STRA(jj(2) + i)
1170 evar(3,i) = lbuf%STRA(jj(3) + i)
1171 evar(4,i) = lbuf%STRA(jj(4) + i)*half
1172 evar(5,i) = lbuf%STRA(jj(5) + i)*half
1173 evar(6,i) = lbuf%STRA(jj(6) + i)*half
1174 is_written_tensor(i) = 1
1175 ENDDO
1176 IF (isorth > 0) kcvt = 2
1177 ELSEIF (mlw == 12 .OR. mlw == 14)THEN
1178 DO i=1,nel
1179 n = i + nft
1180 ii = 3*(i-1)
1181 evar(1,i) = evar(1,i) + lbuf%EPE(jj(1) + i)
1182 evar(2,i) = evar(2,i) + lbuf%EPE(jj(2) + i)
1183 evar(3,i) = evar(3,i) + lbuf%EPE(jj(3) + i)
1184 is_written_tensor(i) = 1
1185 ENDDO
1186 IF (isorth > 0) kcvt = 2
1187 ELSEIF (mlw == 24 .OR. mlw == 25)THEN
1188 DO i=1,nel
1189 n = i + nft
1190 ii = 6*(i-1)
1191 evar(1,i) = lbuf%STRA(jj(1) + i)
1192 evar(2,i) = lbuf%STRA(jj(2) + i)
1193 evar(3,i) = lbuf%STRA(jj(3) + i)
1194 evar(4,i) = lbuf%STRA(jj(4) + i)*half
1195 evar(5,i) = lbuf%STRA(jj(5) + i)*half
1196 evar(6,i) = lbuf%STRA(jj(6) + i)*half
1197 is_written_tensor(i) = 1
1198 ENDDO
1199 IF (isorth > 0) kcvt = 2
1200 ELSEIF (istrain > 0) THEN
1201 IF (mlw /= 14.AND.mlw /= 24.AND.mlw<28.OR.
1202 . mlw == 49) THEN
1203 DO i=1,nel
1204 n = i + nft
1205 ii = 6*(i-1)
1206 evar(1,i) = lbuf%STRA(jj(1) + i)
1207 evar(2,i) = lbuf%STRA(jj(2) + i)
1208 evar(3,i) = lbuf%STRA(jj(3) + i)
1209 evar(4,i) = lbuf%STRA(jj(4) + i)*half
1210 evar(5,i) = lbuf%STRA(jj(5) + i)*half
1211 evar(6,i) = lbuf%STRA(jj(6) + i)*half
1212 is_written_tensor(i) = 1
1213 ENDDO
1214 ENDIF
1215 ENDIF
1216 IF (kcvt /= 0) THEN
1217C STRAIN TENSOR IN GLOBAL SYSTEM
1218 DO i=1,nel
1219 n = i + nft
1220 IF(kcvt==2)THEN
1221 ii = 6*(i-1)
1222 gama(1)=gbuf%GAMA(jj(1) + i)
1223 gama(2)=gbuf%GAMA(jj(2) + i)
1224 gama(3)=gbuf%GAMA(jj(3) + i)
1225 gama(4)=gbuf%GAMA(jj(4) + i)
1226 gama(5)=gbuf%GAMA(jj(5) + i)
1227 gama(6)=gbuf%GAMA(jj(6) + i)
1228 ELSE
1229 gama(1)=one
1230 gama(2)=zero
1231 gama(3)=zero
1232 gama(4)=zero
1233 gama(5)=one
1234 gama(6)=zero
1235 END IF
1236 CALL srota6(
1237 1 x, ixs(1,n), kcvt, evar(1,i),
1238 2 gama, jhbe, igtyp, isorth)
1239 ENDDO
1240 ENDIF
1241c-----------
1242 ELSEIF(isolnod == 16.OR.isolnod == 20 .OR.
1243 . (isolnod == 8.AND.(jhbe == 14.OR.jhbe == 17)))THEN
1244c-----------
1245 IF (mlw>=28.AND.mlw /= 49)THEN
1246 DO i=1,nel
1247 n = i + nft
1248 ii = 6*(i-1)
1249 DO il=1,nlay
1250 DO is=1,npts
1251 DO it=1,nptt
1252 DO ir=1,nptr
1253 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
1254 evar(1,i) = evar(1,i) + lbuf%STRA(jj(1) + i)/npt
1255 evar(2,i) = evar(2,i) + lbuf%STRA(jj(2) + i)/npt
1256 evar(3,i) = evar(3,i) + lbuf%STRA(jj(3) + i)/npt
1257 evar(4,i) = evar(4,i) + lbuf%STRA(jj(4) + i)*half/npt
1258 evar(5,i) = evar(5,i) + lbuf%STRA(jj(5) + i)*half/npt
1259 evar(6,i) = evar(6,i) + lbuf%STRA(jj(6) + i)*half/npt
1260 is_written_tensor(i) = 1
1261 ENDDO
1262 ENDDO
1263 ENDDO
1264 ENDDO
1265 ENDDO
1266 ELSEIF (mlw == 12 .OR. mlw == 14) THEN
1267 DO i=1,nel
1268 n = i + nft
1269 ii = 3*(i-1)
1270 DO il=1,nlay
1271 DO is=1,npts
1272 DO it=1,nptt
1273 DO ir=1,nptr
1274 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
1275 evar(1,i) = evar(1,i) + lbuf%EPE(jj(1) + i)/npt
1276 evar(2,i) = evar(2,i) + lbuf%EPE(jj(2) + i)/npt
1277 evar(3,i) = evar(3,i) + lbuf%EPE(jj(3) + i)/npt
1278 is_written_tensor(i) = 1
1279 ENDDO
1280 ENDDO
1281 ENDDO
1282 ENDDO
1283 ENDDO
1284 ELSEIF(mlw == 24 .OR. mlw == 25)THEN
1285 DO i=1,nel
1286 n = i + nft
1287 ii = 6*(i-1)
1288 DO il=1,nlay
1289 DO is=1,npts
1290 DO it=1,nptt
1291 DO ir=1,nptr
1292 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
1293 IF (elbuf_tab(ng)%BUFLY(il)%L_STRA > 0) THEN
1294 evar_tmp(1) = lbuf%STRA(jj(1) + i)/npt
1295 evar_tmp(2) = lbuf%STRA(jj(2) + i)/npt
1296 evar_tmp(3) = lbuf%STRA(jj(3) + i)/npt
1297 evar_tmp(4) = lbuf%STRA(jj(4) + i)*half/npt
1298 evar_tmp(5) = lbuf%STRA(jj(5) + i)*half/npt
1299 evar_tmp(6) = lbuf%STRA(jj(6) + i)*half/npt
1300 icsig=iparg(17,ng)
1301 IF (kcvt /= 0 .AND.icsig > 0) THEN
1302C STRAIN TENSOR IN GLOBAL SYSTEM
1303 IF (jhbe == 14) THEN
1304 SELECT CASE (icsig)
1305 CASE (1)
1306 IF(kcvt==2 .AND. igtyp ==22)THEN
1307 gama(1)= zero
1308 gama(2)= lbuf%GAMA(jj(1) + i)
1309 gama(3)= lbuf%GAMA(jj(2) + i)
1310 gama(4)= zero
1311 gama(5)=-gama(2)
1312 gama(6)= gama(1)
1313 ELSEIF(kcvt==2 .AND. igtyp ==21)THEN
1314 gama(1)= zero
1315 gama(2)= gbuf%GAMA(jj(1) + i)
1316 gama(3)= gbuf%GAMA(jj(2) + i)
1317 gama(4)= zero
1318 gama(5)=-gama(2)
1319 gama(6)= gama(1)
1320 ELSE
1321 gama(1)=one
1322 gama(2)=zero
1323 gama(3)=zero
1324 gama(4)=zero
1325 gama(5)=one
1326 gama(6)=zero
1327 END IF
1328 CALL srota6(
1329 1 x, ixs(1,n),kcvt, evar_tmp,
1330 2 gama, jhbe, igtyp, isorth)
1331 CASE (10)
1332 IF(kcvt==2 .AND. igtyp ==22)THEN
1333 gama(1)= lbuf%GAMA(jj(1) + i)
1334 gama(2)= lbuf%GAMA(jj(2) + i)
1335 gama(3)= zero
1336 gama(4)=-gama(2)
1337 gama(5)= gama(1)
1338 gama(6)= zero
1339 ELSEIF(kcvt==2 .AND. igtyp ==21)THEN
1340 gama(1)= gbuf%GAMA(jj(1) + i)
1341 gama(2)= gbuf%GAMA(jj(2) + i)
1342 gama(3)= zero
1343 gama(4)=-gama(2)
1344 gama(5)= gama(1)
1345 gama(6)= zero
1346 ELSE
1347 gama(1)=one
1348 gama(2)=zero
1349 gama(3)=zero
1350 gama(4)=zero
1351 gama(5)=one
1352 gama(6)=zero
1353 END IF
1354 CALL srota6(
1355 1 x, ixs(1,n),kcvt, evar_tmp,
1356 2 gama, jhbe, igtyp, isorth)
1357 CASE (100)
1358 IF(kcvt==2 .AND. igtyp ==22)THEN
1359 gama(1)= lbuf%GAMA(jj(2) + i)
1360 gama(2)= zero
1361 gama(3)= lbuf%GAMA(jj(1) + i)
1362 gama(4)= gama(3)
1363 gama(5)= zero
1364 gama(6)=-gama(1)
1365 ELSEIF(kcvt==2 .AND. igtyp ==21)THEN
1366 gama(1)= gbuf%GAMA(jj(2) + i)
1367 gama(2)= zero
1368 gama(3)= gbuf%GAMA(jj(1) + i)
1369 gama(4)= gama(3)
1370 gama(5)= zero
1371 gama(6)=-gama(1)
1372 ELSE
1373 gama(1)=one
1374 gama(2)=zero
1375 gama(3)=zero
1376 gama(4)=zero
1377 gama(5)=one
1378 gama(6)=zero
1379 END IF
1380 CALL srota6(
1381 1 x, ixs(1,n),kcvt, evar_tmp,
1382 2 gama, jhbe, igtyp, isorth)
1383 END SELECT
1384 ENDIF
1385 ENDIF
1386 evar(1,i) = evar(1,i)+evar_tmp(1)
1387 evar(2,i) = evar(2,i)+evar_tmp(2)
1388 evar(3,i) = evar(3,i)+evar_tmp(3)
1389 evar(4,i) = evar(4,i)+evar_tmp(4)
1390 evar(5,i) = evar(5,i)+evar_tmp(5)
1391 evar(6,i) = evar(6,i)+evar_tmp(6)
1392 is_written_tensor(i) = 1
1393 ENDIF
1394 ENDDO
1395 ENDDO
1396 ENDDO
1397 ENDDO
1398 ENDDO
1399 ELSEIF(istrain > 0)THEN
1400 IF (mlw /= 14.AND.mlw /= 24.AND.mlw<28)THEN
1401 DO i=1,nel
1402 n = i + nft
1403 ii = 6*(i-1)
1404 DO il=1,nlay
1405 DO is=1,npts
1406 DO it=1,nptt
1407 DO ir=1,nptr
1408 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
1409 evar_tmp(1) = lbuf%STRA(jj(1) + i)/npt
1410 evar_tmp(2) = lbuf%STRA(jj(2) + i)/npt
1411 evar_tmp(3) = lbuf%STRA(jj(3) + i)/npt
1412 evar_tmp(4) = lbuf%STRA(jj(4) + i)*half/npt
1413 evar_tmp(5) = lbuf%STRA(jj(5) + i)*half/npt
1414 evar_tmp(6) = lbuf%STRA(jj(6) + i)*half/npt
1415c
1416 icsig=iparg(17,ng)
1417 IF (kcvt /= 0 .AND.icsig > 0) THEN
1418C STRAIN TENSOR IN GLOBAL SYSTEM
1419 IF (jhbe == 14) THEN
1420 SELECT CASE (icsig)
1421 CASE (1)
1422 IF(kcvt==2.AND.igtyp == 22)THEN
1423 gama(1)= zero
1424 gama(2)= lbuf%GAMA(jj(1) + i)
1425 gama(3)= lbuf%GAMA(jj(2) + i)
1426 gama(4)= zero
1427 gama(5)=-gama(2)
1428 gama(6)= gama(1)
1429 ELSEIF(kcvt==2.AND.igtyp == 21)THEN
1430 gama(1)= zero
1431 gama(2)= gbuf%GAMA(jj(1) + i)
1432 gama(3)= gbuf%GAMA(jj(2) + i)
1433 gama(4)= zero
1434 gama(5)=-gama(2)
1435 gama(6)= gama(1)
1436 ELSE
1437 gama(1)=one
1438 gama(2)=zero
1439 gama(3)=zero
1440 gama(4)=zero
1441 gama(5)=one
1442 gama(6)=zero
1443 END IF
1444 CALL srota6(
1445 1 x, ixs(1,n),kcvt, evar_tmp,
1446 2 gama, jhbe, igtyp, isorth)
1447 CASE (10)
1448 IF(kcvt==2.AND.igtyp == 22)THEN
1449 gama(1)= lbuf%GAMA(jj(1) + i)
1450 gama(2)= lbuf%GAMA(jj(2) + i)
1451 gama(3)= zero
1452 gama(4)=-gama(2)
1453 gama(5)= gama(1)
1454 gama(6)= zero
1455 ELSEIF(kcvt==2.AND.igtyp == 21)THEN
1456 gama(1)= gbuf%GAMA(jj(1) + i)
1457 gama(2)= gbuf%GAMA(jj(2) + i)
1458 gama(3)= zero
1459 gama(4)=-gama(2)
1460 gama(5)= gama(1)
1461 gama(6)= zero
1462 ELSE
1463 gama(1)=one
1464 gama(2)=zero
1465 gama(3)=zero
1466 gama(4)=zero
1467 gama(5)=one
1468 gama(6)=zero
1469 END IF
1470 CALL srota6(
1471 1 x, ixs(1,n),kcvt, evar_tmp,
1472 2 gama, jhbe, igtyp, isorth)
1473 CASE (100)
1474 IF(kcvt==2.AND.igtyp == 22)THEN
1475 gama(1)= lbuf%GAMA(jj(2) + i)
1476 gama(2)= zero
1477 gama(3)= lbuf%GAMA(jj(1) + i)
1478 gama(4)= gama(3)
1479 gama(5)= zero
1480 gama(6)=-gama(1)
1481 ELSEIF(kcvt==2.AND.igtyp == 21)THEN
1482 gama(1)= gbuf%GAMA(jj(2) + i)
1483 gama(2)= zero
1484 gama(3)= gbuf%GAMA(jj(1) + i)
1485 gama(4)= gama(3)
1486 gama(5)= zero
1487 gama(6)=-gama(1)
1488 ELSE
1489 gama(1)=one
1490 gama(2)=zero
1491 gama(3)=zero
1492 gama(4)=zero
1493 gama(5)=one
1494 gama(6)=zero
1495 END IF
1496 CALL srota6(
1497 1 x, ixs(1,n),kcvt, evar_tmp,
1498 2 gama, jhbe, igtyp, isorth)
1499 END SELECT
1500 ENDIF
1501 ENDIF
1502 evar(1,i) = evar(1,i)+evar_tmp(1)
1503 evar(2,i) = evar(2,i)+evar_tmp(2)
1504 evar(3,i) = evar(3,i)+evar_tmp(3)
1505 evar(4,i) = evar(4,i)+evar_tmp(4)
1506 evar(5,i) = evar(5,i)+evar_tmp(5)
1507 evar(6,i) = evar(6,i)+evar_tmp(6)
1508 is_written_tensor(i) = 1
1509 ENDDO
1510 ENDDO
1511 ENDDO
1512 ENDDO
1513 ENDDO
1514 ENDIF
1515 ENDIF
1516c---
1517 icsig=iparg(17,ng)
1518 IF (jhbe == 17) THEN
1519 IF (mlw == 12 .OR. mlw == 14 .OR. mlw == 24 .OR.
1520 . mlw == 25 .OR.(mlw >= 28 .AND.mlw /= 49)) THEN
1521 IF (isorth > 0) kcvt = 2
1522 ENDIF
1523 ENDIF
1524 IF (kcvt /= 0 .AND.icsig == 0 .AND. jhbe /= 16) THEN
1525C STRAIN TENSOR IN GLOBAL SYSTEM
1526 DO i=1,nel
1527 n = i + nft
1528 IF(kcvt==2)THEN
1529 ii = 6*(i-1)
1530 gama(1)=gbuf%GAMA(jj(1) + i)
1531 gama(2)=gbuf%GAMA(jj(2) + i)
1532 gama(3)=gbuf%GAMA(jj(3) + i)
1533 gama(4)=gbuf%GAMA(jj(4) + i)
1534 gama(5)=gbuf%GAMA(jj(5) + i)
1535 gama(6)=gbuf%GAMA(jj(6) + i)
1536 ELSE
1537 gama(1)=one
1538 gama(2)=zero
1539 gama(3)=zero
1540 gama(4)=zero
1541 gama(5)=one
1542 gama(6)=zero
1543 END IF
1544 CALL srota6(
1545 1 x, ixs(1,n), kcvt, evar(1,i),
1546 2 gama, jhbe, igtyp, isorth)
1547 ENDDO
1548 ENDIF
1549c-----------
1550 ELSEIF (isolnod==10 .OR. (isolnod==4 .AND. isrot==1)) THEN
1551c-----------
1552 IF (mlw>=28.AND.mlw /= 49)THEN
1553 DO i=1,nel
1554 n = i + nft
1555 ii = 6*(i-1)
1556 DO ipt=1,npt
1557 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ipt,1,1)
1558 evar(1,i) = evar(1,i)+lbuf%STRA(jj(1) + i)/npt
1559 evar(2,i) = evar(2,i)+lbuf%STRA(jj(2) + i)/npt
1560 evar(3,i) = evar(3,i)+lbuf%STRA(jj(3) + i)/npt
1561 evar(4,i) = evar(4,i)+lbuf%STRA(jj(4) + i)*half/npt
1562 evar(5,i) = evar(5,i)+lbuf%STRA(jj(5) + i)*half/npt
1563 evar(6,i) = evar(6,i)+lbuf%STRA(jj(6) + i)*half/npt
1564 is_written_tensor(i) = 1
1565 ENDDO
1566 ENDDO
1567 ELSEIF(mlw == 12 .OR. mlw == 14)THEN
1568 DO i=1,nel
1569 n = i + nft
1570 ii = 3*(i-1)
1571 DO ipt=1,npt
1572 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ipt,1,1)
1573 evar(1,i) = evar(1,i) + lbuf%EPE(jj(1) + i)/npt
1574 evar(2,i) = evar(2,i) + lbuf%EPE(jj(2) + i)/npt
1575 evar(3,i) = evar(3,i) + lbuf%EPE(jj(3) + i)/npt
1576 is_written_tensor(i) = 1
1577 ENDDO
1578 ENDDO
1579 ELSEIF ((mlw == 24 .OR. mlw == 25) .and. istrain > 0) THEN
1580 DO i=1,nel
1581 n = i + nft
1582 ii = 6*(i-1)
1583 DO ipt=1,npt
1584 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ipt,1,1)
1585 evar(1,i) = evar(1,i)+lbuf%STRA(jj(1) + i)/npt
1586 evar(2,i) = evar(2,i)+lbuf%STRA(jj(2) + i)/npt
1587 evar(3,i) = evar(3,i)+lbuf%STRA(jj(3) + i)/npt
1588 evar(4,i) = evar(4,i)+lbuf%STRA(jj(4) + i)*half/npt
1589 evar(5,i) = evar(5,i)+lbuf%STRA(jj(5) + i)*half/npt
1590 evar(6,i) = evar(6,i)+lbuf%STRA(jj(6) + i)*half/npt
1591 is_written_tensor(i) = 1
1592 ENDDO
1593 ENDDO
1594 ELSEIF(istrain > 0)THEN
1595 IF (mlw /= 14.AND.mlw /= 24.AND.mlw<28) THEN
1596 DO i=1,nel
1597 n = i + nft
1598 ii = 6*(i-1)
1599 DO ipt=1,npt
1600 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ipt,1,1)
1601 evar(1,i) = evar(1,i)+lbuf%STRA(jj(1) + i)/npt
1602 evar(2,i) = evar(2,i)+lbuf%STRA(jj(2) + i)/npt
1603 evar(3,i) = evar(3,i)+lbuf%STRA(jj(3) + i)/npt
1604 evar(4,i) = evar(4,i)+lbuf%STRA(jj(4) + i)*half/npt
1605 evar(5,i) = evar(5,i)+lbuf%STRA(jj(5) + i)*half/npt
1606 evar(6,i) = evar(6,i)+lbuf%STRA(jj(6) + i)*half/npt
1607 is_written_tensor(i) = 1
1608 ENDDO
1609 ENDDO
1610 ENDIF
1611 ENDIF
1612 IF (kcvt /= 0) THEN
1613C STRAIN TENSOR IN GLOBAL SYSTEM
1614 DO i=1,nel
1615 n = i + nft
1616 IF (kcvt==2) THEN
1617 ii = 6*(i-1)
1618 gama(1)=gbuf%GAMA(jj(1) + i)
1619 gama(2)=gbuf%GAMA(jj(2) + i)
1620 gama(3)=gbuf%GAMA(jj(3) + i)
1621 gama(4)=gbuf%GAMA(jj(4) + i)
1622 gama(5)=gbuf%GAMA(jj(5) + i)
1623 gama(6)=gbuf%GAMA(jj(6) + i)
1624 ELSE
1625 gama(1)=one
1626 gama(2)=zero
1627 gama(3)=zero
1628 gama(4)=zero
1629 gama(5)=one
1630 gama(6)=zero
1631 ENDIF
1632 CALL srota6(
1633 1 x, ixs(1,n), kcvt, evar(1,i),
1634 2 gama, jhbe, igtyp, isorth)
1635 ENDDO
1636 ENDIF
1637c-----------
1638 ELSEIF((isolnod == 6.OR.isolnod == 8).AND.jhbe == 15)THEN
1639c-----------
1640 IF (mlw>=28.AND.mlw /= 49.AND.istrain > 0) THEN
1641 DO i=1,nel
1642 n = i + nft
1643 ii = 6*(i-1)
1644 DO il= 1,nlay
1645 DO ipt=1,nptg
1646 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ipt,1,1)
1647 evar(1,i) = evar(1,i)+lbuf%STRA(jj(1) + i)/(nptg*nlay)
1648 evar(2,i) = evar(2,i)+lbuf%STRA(jj(2) + i)/(nptg*nlay)
1649 evar(3,i) = evar(3,i)+lbuf%STRA(jj(3) + i)/(nptg*nlay)
1650 evar(4,i) = evar(4,i)+lbuf%STRA(jj(4) + i)*
1651 . half/(nptg*nlay)
1652 evar(5,i) = evar(5,i)+lbuf%STRA(jj(5) + i)*
1653 . half/(nptg*nlay)
1654 evar(6,i) = evar(6,i)+lbuf%STRA(jj(6) + i)*
1655 . half/(nptg*nlay)
1656 is_written_tensor(i) = 1
1657 ENDDO
1658 ENDDO
1659 ENDDO
1660 ELSEIF(mlw == 12 .OR. mlw == 14)THEN
1661 DO i=1,nel
1662 ii = 3*(i-1)
1663 DO il= 1,nlay
1664 DO ipt=1,nptg
1665 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ipt,1,1)
1666 evar(1,i) = evar(1,i) + lbuf%EPE(jj(1) + i)/(nptg*nlay)
1667 evar(2,i) = evar(2,i) + lbuf%EPE(jj(2) + i)/(nptg*nlay)
1668 evar(3,i) = evar(3,i) + lbuf%EPE(jj(3) + i)/(nptg*nlay)
1669 is_written_tensor(i) = 1
1670 ENDDO
1671 ENDDO
1672 ENDDO
1673 ELSEIF ((mlw == 24 .OR. mlw == 25) .and. istrain > 0)THEN
1674 DO i=1,nel
1675 n = i + nft
1676 ii = 6*(i-1)
1677 DO il= 1,nlay
1678 DO ipt=1,nptg
1679 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ipt,1,1)
1680 evar(1,i) = evar(1,i)+lbuf%STRA(jj(1) + i)/(nptg*nlay)
1681 evar(2,i) = evar(2,i)+lbuf%STRA(jj(2) + i)/(nptg*nlay)
1682 evar(3,i) = evar(3,i)+lbuf%STRA(jj(3) + i)/(nptg*nlay)
1683 evar(4,i) = evar(4,i)+lbuf%STRA(jj(4) + i)*
1684 . half/(nptg*nlay)
1685 evar(5,i) = evar(5,i)+lbuf%STRA(jj(5) + i)*
1686 . half/(nptg*nlay)
1687 evar(6,i) = evar(6,i)+lbuf%STRA(jj(6) + i)*
1688 . half/(nptg*nlay)
1689 is_written_tensor(i) = 1
1690 ENDDO
1691 ENDDO
1692 ENDDO
1693 ELSEIF (istrain > 0) THEN
1694 IF(mlw /= 14.AND.mlw /= 24.AND.mlw<28) THEN
1695 DO i=1,nel
1696 n = i + nft
1697 ii = 6*(i-1)
1698 DO il= 1,nlay
1699 DO ipt=1,nptg
1700 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ipt,1,1)
1701 evar(1,i) = evar(1,i)+lbuf%STRA(jj(1) + i)/(nptg*nlay)
1702 evar(2,i) = evar(2,i)+lbuf%STRA(jj(2) + i)/(nptg*nlay)
1703 evar(3,i) = evar(3,i)+lbuf%STRA(jj(3) + i)/(nptg*nlay)
1704 evar(4,i) = evar(4,i)+lbuf%STRA(jj(4) + i)*
1705 . half/(nptg*nlay)
1706 evar(5,i) = evar(5,i)+lbuf%STRA(jj(5) + i)*
1707 . half/(nptg*nlay)
1708 evar(6,i) = evar(6,i)+lbuf%STRA(jj(6) + i)*
1709 . half/(nptg*nlay)
1710 is_written_tensor(i) = 1
1711 ENDDO
1712 ENDDO
1713 ENDDO
1714 ENDIF
1715 ENDIF
1716 IF (kcvt /= 0) THEN
1717C STRAIN TENSOR IN GLOBAL SYSTEM
1718 DO i=1,nel
1719 n = i + nft
1720 IF (kcvt==2)THEN
1721 ii = 6*(i-1)
1722 gama(1)= gbuf%GAMA(jj(1) + i)
1723 gama(2)= gbuf%GAMA(jj(2) + i)
1724 gama(3)= zero
1725 gama(4)=-gama(2)
1726 gama(5)= gama(1)
1727 gama(6)= zero
1728 ELSE
1729 gama(1)=one
1730 gama(2)=zero
1731 gama(3)=zero
1732 gama(4)=zero
1733 gama(5)=one
1734 gama(6)=zero
1735 END IF
1736 CALL srota6(
1737 1 x, ixs(1,n), kcvt, evar(1,i),
1738 2 gama, jhbe, igtyp, isorth)
1739 ENDDO
1740 ENDIF
1741c-----------
1742 ENDIF ! ISOLNOD & ......
1743
1744 ELSEIF ( ilay == -1 .AND. ir >= 0 .AND. ir <= nptr .AND.
1745 . is >= 0 .AND. is <= npts .AND. it >= 0 .AND. it <= nptt) THEN
1746c IR= IS= IT=
1747
1748C-----------------------------------------------
1749 DO i=1,nel
1750 evar(1,i) = zero
1751 evar(2,i) = zero
1752 evar(3,i) = zero
1753 evar(4,i) = zero
1754 evar(5,i) = zero
1755 evar(6,i) = zero
1756 ENDDO
1757c-----------
1758 IF (isolnod == 8.AND.npt == 8 .AND.
1759 . jhbe /= 14.AND.jhbe /= 24.AND.jhbe /= 15.AND.jhbe /= 17) THEN
1760c-----------
1761 ipt = ir + ( (is-1) + (it-1)*npts )*nptr
1762 IF (ipt <= 8) THEN
1763 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ir,is,it)
1764 IF (mlw >= 28) THEN
1765 DO i=1,nel
1766 evar(1,i) = evar(1,i) + lbuf%STRA(jj(1) + i)
1767 evar(2,i) = evar(2,i) + lbuf%STRA(jj(2) + i)
1768 evar(3,i) = evar(3,i) + lbuf%STRA(jj(3) + i)
1769 evar(4,i) = evar(4,i) + lbuf%STRA(jj(4) + i)
1770 evar(5,i) = evar(5,i) + lbuf%STRA(jj(5) + i)
1771 evar(6,i) = evar(6,i) + lbuf%STRA(jj(6) + i)
1772 is_written_tensor(i) = 1
1773 ENDDO
1774 ENDIF
1775 ENDIF
1776 IF (kcvt /= 0) THEN
1777C STRAIN TENSOR IN GLOBAL SYSTEM
1778 DO i=1,nel
1779 n = i + nft
1780 IF(kcvt==2)THEN
1781 gama(1)=gbuf%GAMA(jj(1) + i)
1782 gama(2)=gbuf%GAMA(jj(2) + i)
1783 gama(3)=gbuf%GAMA(jj(3) + i)
1784 gama(4)=gbuf%GAMA(jj(4) + i)
1785 gama(5)=gbuf%GAMA(jj(5) + i)
1786 gama(6)=gbuf%GAMA(jj(6) + i)
1787 ELSE
1788 gama(1)=one
1789 gama(2)=zero
1790 gama(3)=zero
1791 gama(4)=zero
1792 gama(5)=one
1793 gama(6)=zero
1794 END IF
1795 CALL srota6(
1796 1 x, ixs(1,n), kcvt, evar(1,i),
1797 2 gama, jhbe, igtyp, isorth)
1798 ENDDO
1799 ENDIF
1800c-----------
1801 ELSEIF ((isolnod == 8 .OR.npt == 1 .OR.
1802 . (isolnod == 4 .AND. isrot == 0)) .AND.
1803 . jhbe /= 14.AND.jhbe /= 15.AND.jhbe /= 17) THEN
1804c-----------
1805 ipt = ir + ( (is-1) + (it-1)*npts )*nptr
1806 IF (ipt == 1 ) THEN
1807 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
1808 IF (mlw>=28.AND.mlw /= 49 .OR. mlw == 24) THEN
1809 DO i=1,nel
1810 evar(1,i) = evar(1,i) + lbuf%STRA(jj(1) + i)
1811 evar(2,i) = evar(2,i) + lbuf%STRA(jj(2) + i)
1812 evar(3,i) = evar(3,i) + lbuf%STRA(jj(3) + i)
1813 evar(4,i) = evar(4,i) + lbuf%STRA(jj(4) + i)*half
1814 evar(5,i) = evar(5,i) + lbuf%STRA(jj(5) + i)*half
1815 evar(6,i) = evar(6,i) + lbuf%STRA(jj(6) + i)*half
1816 is_written_tensor(i) = 1
1817 END DO
1818 ELSEIF(mlw == 12 .OR. mlw == 14) THEN
1819 DO i=1,nel
1820 evar(1,i) = evar(1,i) + lbuf%EPE(jj(1) + i)
1821 evar(2,i) = evar(2,i) + lbuf%EPE(jj(2) + i)
1822 evar(3,i) = evar(3,i) + lbuf%EPE(jj(3) + i)
1823 is_written_tensor(i) = 1
1824 ENDDO
1825 ELSEIF (istrain > 0)THEN
1826 IF (mlw /= 14.AND.mlw /= 24.AND.mlw<28.OR.
1827 . mlw == 49) THEN
1828 DO i=1,nel
1829 evar(1,i) = evar(1,i) + lbuf%STRA(jj(1) + i)
1830 evar(2,i) = evar(2,i) + lbuf%STRA(jj(2) + i)
1831 evar(3,i) = evar(3,i) + lbuf%STRA(jj(3) + i)
1832 evar(4,i) = evar(4,i) + lbuf%STRA(jj(4) + i)*half
1833 evar(5,i) = evar(5,i) + lbuf%STRA(jj(5) + i)*half
1834 evar(6,i) = evar(6,i) + lbuf%STRA(jj(6) + i)*half
1835 is_written_tensor(i) = 1
1836 ENDDO
1837 ENDIF
1838 ENDIF
1839 ENDIF
1840C
1841 IF (kcvt /= 0) THEN
1842C STRAIN TENSOR IN GLOBAL SYSTEM
1843 DO i=1,nel
1844 n = i + nft
1845 IF(kcvt==2)THEN
1846 gama(1)=gbuf%GAMA(jj(1) + i)
1847 gama(2)=gbuf%GAMA(jj(2) + i)
1848 gama(3)=gbuf%GAMA(jj(3) + i)
1849 gama(4)=gbuf%GAMA(jj(4) + i)
1850 gama(5)=gbuf%GAMA(jj(5) + i)
1851 gama(6)=gbuf%GAMA(jj(6) + i)
1852 ELSE
1853 gama(1)=one
1854 gama(2)=zero
1855 gama(3)=zero
1856 gama(4)=zero
1857 gama(5)=one
1858 gama(6)=zero
1859 END IF
1860 CALL srota6(
1861 1 x, ixs(1,n), kcvt, evar(1,i),
1862 2 gama, jhbe, igtyp, isorth)
1863 ENDDO
1864 ENDIF
1865c-----------
1866 ELSEIF (isolnod == 16.OR.isolnod == 20.OR.(isolnod == 8.AND.
1867 . (jhbe == 14 .OR. jhbe == 17))) THEN
1868c-----------
1869 icsig = iparg(17,ng)
1870 IF (ior_tsh >0) THEN
1871 IF (icsig == 10) THEN
1872 ir=it_input
1873 is=ir_input
1874 it=is_input
1875 ELSEIF (icsig == 1) THEN
1876 ir=is_input
1877 is=it_input
1878 it=ir_input
1879 ELSE
1880 ir=ir_input
1881 is=is_input
1882 it=it_input
1883 ENDIF
1884 ENDIF
1885 ipt = ir + ( (is-1) + (it-1)*npts )*nptr
1886 IF (ipt <= nptg .AND. ir <= nptr .AND. is <= npts
1887 . .AND. it <= nptt .AND. ir*is*it >= 1) THEN
1888 IF (tshell == 1) THEN
1889 IF (isolnod == 16) THEN
1890 lbuf => elbuf_tab(ng)%BUFLY(is)%LBUF(ir,1,it)
1891 ELSE
1892 lbuf => elbuf_tab(ng)%BUFLY(it)%LBUF(ir,is,1)
1893 END IF
1894 ELSE
1895 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ir,is,it)
1896 ENDIF
1897 IF(mlw>=28.AND.mlw /= 49)THEN
1898 DO i=1,nel
1899C 3*9*3 points d'integration (r*s*t)
1900 evar(1,i) = lbuf%STRA(jj(1) + i)
1901 evar(2,i) = lbuf%STRA(jj(2) + i)
1902 evar(3,i) = lbuf%STRA(jj(3) + i)
1903 evar(4,i) = lbuf%STRA(jj(4) + i)*half
1904 evar(5,i) = lbuf%STRA(jj(5) + i)*half
1905 evar(6,i) = lbuf%STRA(jj(6) + i)*half
1906 is_written_tensor(i) = 1
1907 ENDDO
1908 ELSEIF(mlw == 12 .OR. mlw == 14)THEN
1909 DO i=1,nel
1910C 3*9*3 points d'integration (r*s*t)
1911 evar(1,i) = lbuf%EPE(jj(1) + i)
1912 evar(2,i) = lbuf%EPE(jj(2) + i)
1913 evar(3,i) = lbuf%EPE(jj(3) + i)
1914 is_written_tensor(i) = 1
1915 ENDDO
1916 ELSEIF(mlw == 24 .OR. mlw == 25)THEN
1917 DO i=1,nel
1918C 3*9*3 points d'integration (r*s*t)
1919 evar(1,i) = lbuf%STRA(jj(1) + i)
1920 evar(2,i) = lbuf%STRA(jj(2) + i)
1921 evar(3,i) = lbuf%STRA(jj(3) + i)
1922 evar(4,i) = lbuf%STRA(jj(4) + i) * half
1923 evar(5,i) = lbuf%STRA(jj(5) + i) * half
1924 evar(6,i) = lbuf%STRA(jj(6) + i) * half
1925 is_written_tensor(i) = 1
1926 ENDDO
1927 ELSEIF (mlw == 25) THEN
1928 DO i=1,nel
1929 evar(1,i) = lbuf%STRA(jj(1) + i)
1930 evar(2,i) = lbuf%STRA(jj(2) + i)
1931 evar(3,i) = lbuf%STRA(jj(3) + i)
1932 evar(4,i) = lbuf%STRA(jj(4) + i) * half
1933 evar(5,i) = lbuf%STRA(jj(5) + i) * half
1934 evar(6,i) = lbuf%STRA(jj(6) + i) * half
1935 is_written_tensor(i) = 1
1936 ENDDO
1937 ELSEIF(istrain > 0)THEN
1938 IF(mlw /= 14.AND.mlw /= 24.AND.mlw<28)THEN
1939 DO i=1,nel
1940C 3*9*3 points d'integration (r*s*t)
1941 evar(1,i) = lbuf%STRA(jj(1) + i)
1942 evar(2,i) = lbuf%STRA(jj(2) + i)
1943 evar(3,i) = lbuf%STRA(jj(3) + i)
1944 evar(4,i) = lbuf%STRA(jj(4) + i) * half
1945 evar(5,i) = lbuf%STRA(jj(5) + i) * half
1946 evar(6,i) = lbuf%STRA(jj(6) + i) * half
1947 is_written_tensor(i) = 1
1948 ENDDO
1949 ENDIF
1950 ENDIF
1951C
1952 IF (kcvt /= 0 .AND. jhbe /= 16) THEN
1953C STRAIN TENSOR IN GLOBAL SYSTEM
1954 icsig=iparg(17,ng)
1955 IF (jhbe == 14.AND.icsig > 0) THEN
1956 SELECT CASE (icsig)
1957 CASE (1)
1958 DO i=1,nel
1959 n = i + nft
1960 IF(kcvt==2.AND.igtyp == 22)THEN
1961 gama(1)=zero
1962 gama(2)=lbuf%GAMA(jj(1) + i)
1963 gama(3)=lbuf%GAMA(jj(2) + i)
1964 gama(4)=zero
1965 gama(5)=-gama(2)
1966 gama(6)=gama(1)
1967 ELSEIF(kcvt==2.AND.igtyp == 21)THEN
1968 gama(1)=zero
1969 gama(2)=gbuf%GAMA(jj(1) + i)
1970 gama(3)=gbuf%GAMA(jj(2) + i)
1971 gama(4)=zero
1972 gama(5)=-gama(2)
1973 gama(6)=gama(1)
1974 ELSE
1975 gama(1)=one
1976 gama(2)=zero
1977 gama(3)=zero
1978 gama(4)=zero
1979 gama(5)=one
1980 gama(6)=zero
1981 END IF
1982 CALL srota6(
1983 1 x, ixs(1,n), kcvt, evar(1,i),
1984 2 gama, jhbe, igtyp, isorth)
1985 ENDDO
1986 CASE (10)
1987 DO i=1,nel
1988 n = i + nft
1989 IF(kcvt==2.AND.igtyp == 22)THEN
1990 gama(1)=lbuf%GAMA(jj(1) + i)
1991 gama(2)=lbuf%GAMA(jj(2) + i)
1992 gama(3)=zero
1993 gama(4)=-gama(2)
1994 gama(5)=gama(1)
1995 gama(6)=zero
1996 ELSEIF(kcvt==2.AND.igtyp == 21)THEN
1997 gama(1)=gbuf%GAMA(jj(1) + i)
1998 gama(2)=gbuf%GAMA(jj(2) + i)
1999 gama(3)=zero
2000 gama(4)=-gama(2)
2001 gama(5)=gama(1)
2002 gama(6)=zero
2003 ELSE
2004 gama(1)=one
2005 gama(2)=zero
2006 gama(3)=zero
2007 gama(4)=zero
2008 gama(5)=one
2009 gama(6)=zero
2010 END IF
2011 CALL srota6(
2012 1 x, ixs(1,n), kcvt, evar(1,i),
2013 2 gama, jhbe, igtyp, isorth)
2014 ENDDO
2015 CASE (100)
2016 DO i=1,nel
2017 n = i + nft
2018 IF(kcvt==2.AND.igtyp == 22)THEN
2019 gama(1)=lbuf%GAMA(jj(2) + i)
2020 gama(2)=zero
2021 gama(3)=lbuf%GAMA(jj(1) + i)
2022 gama(4)=gama(3)
2023 gama(5)=zero
2024 gama(6)=-gama(1)
2025 ELSEIF(kcvt==2.AND.igtyp == 21)THEN
2026 gama(1)=gbuf%GAMA(jj(2) + i)
2027 gama(2)=zero
2028 gama(3)=gbuf%GAMA(jj(1) + i)
2029 gama(4)=gama(3)
2030 gama(5)=zero
2031 gama(6)=-gama(1)
2032 ELSE
2033 gama(1)=one
2034 gama(2)=zero
2035 gama(3)=zero
2036 gama(4)=zero
2037 gama(5)=one
2038 gama(6)=zero
2039 END IF
2040 CALL srota6(
2041 1 x, ixs(1,n), kcvt, evar(1,i),
2042 2 gama, jhbe, igtyp, isorth)
2043 ENDDO
2044 END SELECT
2045 ELSE
2046 DO i=1,nel
2047 n = i + nft
2048 IF(kcvt==2)THEN
2049 gama(1)=gbuf%GAMA(jj(1) + i)
2050 gama(2)=gbuf%GAMA(jj(2) + i)
2051 gama(3)=gbuf%GAMA(jj(3) + i)
2052 gama(4)=gbuf%GAMA(jj(4) + i)
2053 gama(5)=gbuf%GAMA(jj(5) + i)
2054 gama(6)=gbuf%GAMA(jj(6) + i)
2055 ELSE
2056 gama(1)=one
2057 gama(2)=zero
2058 gama(3)=zero
2059 gama(4)=zero
2060 gama(5)=one
2061 gama(6)=zero
2062 END IF
2063 CALL srota6(
2064 1 x, ixs(1,n), kcvt, evar(1,i),
2065 2 gama, jhbe, igtyp, isorth)
2066 ENDDO
2067 ENDIF !(JHBE == 14.AND.ICSIG > 0)
2068 ENDIF
2069 ENDIF
2070
2071c-----------
2072 ELSEIF (isolnod==10 .OR. (isolnod==4 .AND. isrot==1)) THEN
2073c-----------
2074 ipt = ir
2075c IF (IR == 1 .AND. IS == 1 .AND. IT == 1) IPT = 1
2076c IF (IR == 2 .AND. IS == 1 .AND. IT == 1) IPT = 2
2077c IF (IR == 1 .AND. IS == 2 .AND. IT == 1) IPT = 3
2078c IF (IR == 1 .AND. IS == 1 .AND. IT == 2) IPT = 4
2079 IF ( ipt > 0) THEN
2080 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ipt,1,1)
2081 IF (mlw>=28.AND.mlw /= 49 .OR. mlw == 24) THEN
2082 DO i=1,nel
2083 evar(1,i) = evar(1,i) + lbuf%STRA(jj(1) + i)
2084 evar(2,i) = evar(2,i) + lbuf%STRA(jj(2) + i)
2085 evar(3,i) = evar(3,i) + lbuf%STRA(jj(3) + i)
2086 evar(4,i) = evar(4,i) + lbuf%STRA(jj(4) + i)*half
2087 evar(5,i) = evar(5,i) + lbuf%STRA(jj(5) + i)*half
2088 evar(6,i) = evar(6,i) + lbuf%STRA(jj(6) + i)*half
2089 is_written_tensor(i) = 1
2090 ENDDO
2091 ELSEIF (mlw == 12 .OR. mlw == 14) THEN
2092 DO i=1,nel
2093 evar(1,i) = evar(1,i) + lbuf%EPE(jj(1) + i)
2094 evar(2,i) = evar(2,i) + lbuf%EPE(jj(2) + i)
2095 evar(3,i) = evar(3,i) + lbuf%EPE(jj(3) + i)
2096 is_written_tensor(i) = 1
2097 ENDDO
2098 ELSEIF (istrain > 0) THEN
2099 IF (mlw /= 14.AND.mlw /= 24.AND.mlw<28) THEN
2100 DO i=1,nel
2101 evar(1,i) = evar(1,i) + lbuf%STRA(jj(1) + i)
2102 evar(2,i) = evar(2,i) + lbuf%STRA(jj(2) + i)
2103 evar(3,i) = evar(3,i) + lbuf%STRA(jj(3) + i)
2104 evar(4,i) = evar(4,i) + lbuf%STRA(jj(4) + i)*half
2105 evar(5,i) = evar(5,i) + lbuf%STRA(jj(5) + i)*half
2106 evar(6,i) = evar(6,i) + lbuf%STRA(jj(6) + i)*half
2107 is_written_tensor(i) = 1
2108 ENDDO
2109 ENDIF
2110 ENDIF
2111 ENDIF
2112c
2113 IF (kcvt /= 0) THEN
2114 DO i=1,nel
2115 n = i + nft
2116 IF(kcvt==2)THEN
2117 gama(1)=gbuf%GAMA(jj(1) + i)
2118 gama(2)=gbuf%GAMA(jj(2) + i)
2119 gama(3)=gbuf%GAMA(jj(3) + i)
2120 gama(4)=gbuf%GAMA(jj(4) + i)
2121 gama(5)=gbuf%GAMA(jj(5) + i)
2122 gama(6)=gbuf%GAMA(jj(6) + i)
2123 ELSE
2124 gama(1)=one
2125 gama(2)=zero
2126 gama(3)=zero
2127 gama(4)=zero
2128 gama(5)=one
2129 gama(6)=zero
2130 END IF
2131 CALL srota6(
2132 1 x, ixs(1,n), kcvt, evar(1,i),
2133 2 gama, jhbe, igtyp, isorth)
2134 ENDDO
2135 ENDIF
2136
2137 ENDIF
2138c-----------
2139 ELSEIF ( ilay >= 0 .AND. ilay <= nlay .AND. ir >= 0 .AND. ir <= nptr .AND.
2140 . is >= 0 .AND. is <= npts) THEN
2141
2142 evar(1:6,1:nel) = zero
2143 IF ((isolnod == 6.OR.isolnod == 8).AND.jhbe == 15) THEN
2144c-----------
2145 IF ( ilay <= npt ) THEN
2146 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(1,1,1)
2147 IF (mlw>=28.AND.mlw /= 49 .OR. mlw == 24) THEN
2148 DO i=1,nel
2149 evar(1,i) = lbuf%STRA(jj(1) + i)
2150 evar(2,i) = lbuf%STRA(jj(2) + i)
2151 evar(3,i) = lbuf%STRA(jj(3) + i)
2152 evar(4,i) = lbuf%STRA(jj(4) + i)*half
2153 evar(5,i) = lbuf%STRA(jj(5) + i)*half
2154 evar(6,i) = lbuf%STRA(jj(6) + i)*half
2155 is_written_tensor(i) = 1
2156 ENDDO
2157 ELSEIF(mlw == 12 .OR. mlw == 14)THEN
2158 DO i=1,nel
2159 n = i + nft
2160 evar(1,i) = evar(1,i) + lbuf%EPE(jj(1) + i)
2161 evar(2,i) = evar(2,i) + lbuf%EPE(jj(2) + i)
2162 evar(3,i) = evar(3,i) + lbuf%EPE(jj(3) + i)
2163 is_written_tensor(i) = 1
2164 ENDDO
2165 ELSEIF (istrain > 0) THEN
2166 IF (mlw /= 14.AND.mlw /= 24.AND.mlw<28) THEN
2167 DO i=1,nel
2168 evar(1,i) = evar(1,i) + lbuf%STRA(jj(1) + i)
2169 evar(2,i) = evar(2,i) + lbuf%STRA(jj(2) + i)
2170 evar(3,i) = evar(3,i) + lbuf%STRA(jj(3) + i)
2171 evar(4,i) = evar(4,i) + lbuf%STRA(jj(4) + i)*half
2172 evar(5,i) = evar(5,i) + lbuf%STRA(jj(5) + i)*half
2173 evar(6,i) = evar(6,i) + lbuf%STRA(jj(6) + i)*half
2174 is_written_tensor(i) = 1
2175 ENDDO
2176 ENDIF
2177 ENDIF
2178 ENDIF
2179 IF (kcvt /= 0 .AND. is <= npt) THEN
2180C STRAIN TENSOR IN GLOBAL SYSTEM
2181c LBUF => ELBUF_TAB(NG)%BUFLY(IS)%LBUF(1,1,1)
2182 DO i=1,nel
2183 n = i + nft
2184 IF(kcvt==2)THEN
2185 gama(1)= gbuf%GAMA(jj(1) + i)
2186 gama(2)= gbuf%GAMA(jj(2) + i)
2187 gama(3)= zero
2188 gama(4)=-gama(2)
2189 gama(5)= gama(1)
2190 gama(6)= zero
2191 ELSE
2192 gama(1)=one
2193 gama(2)=zero
2194 gama(3)=zero
2195 gama(4)=zero
2196 gama(5)=one
2197 gama(6)=zero
2198 END IF
2199 CALL srota6(
2200 1 x, ixs(1,n), kcvt, evar(1,i),
2201 2 gama, jhbe, igtyp, isorth)
2202 ENDDO
2203 ENDIF
2204 ELSEIF (isolnod == 16.OR.isolnod == 20.OR.(isolnod == 8.AND.
2205 . (jhbe == 14 .OR. jhbe == 17))) THEN
2206c-----------
2207 IF (tshell == 1.AND.ir > 0 .AND. is > 0 .AND. it > 0) THEN
2208 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,1)
2209 IF (isolnod == 16) lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,1,it)
2210 IF(mlw>=28.AND.mlw /= 49)THEN
2211 DO i=1,nel
2212C 3*9*3 points d'integration (r*s*t)
2213 evar(1,i) = lbuf%STRA(jj(1) + i)
2214 evar(2,i) = lbuf%STRA(jj(2) + i)
2215 evar(3,i) = lbuf%STRA(jj(3) + i)
2216 evar(4,i) = lbuf%STRA(jj(4) + i)*half
2217 evar(5,i) = lbuf%STRA(jj(5) + i)*half
2218 evar(6,i) = lbuf%STRA(jj(6) + i)*half
2219 is_written_tensor(i) = 1
2220 ENDDO
2221 ELSEIF(mlw == 12 .OR. mlw == 14)THEN
2222 DO i=1,nel
2223C 3*9*3 points d'integration (r*s*t)
2224 evar(1,i) = lbuf%EPE(jj(1) + i)
2225 evar(2,i) = lbuf%EPE(jj(2) + i)
2226 evar(3,i) = lbuf%EPE(jj(3) + i)
2227 is_written_tensor(i) = 1
2228 ENDDO
2229 ELSEIF(mlw == 24 .OR. mlw == 25)THEN
2230 DO i=1,nel
2231C 3*9*3 points d'integration (r*s*t)
2232 evar(1,i) = lbuf%STRA(jj(1) + i)
2233 evar(2,i) = lbuf%STRA(jj(2) + i)
2234 evar(3,i) = lbuf%STRA(jj(3) + i)
2235 evar(4,i) = lbuf%STRA(jj(4) + i) * half
2236 evar(5,i) = lbuf%STRA(jj(5) + i) * half
2237 evar(6,i) = lbuf%STRA(jj(6) + i) * half
2238 is_written_tensor(i) = 1
2239 ENDDO
2240 ELSEIF (mlw == 25) THEN
2241 DO i=1,nel
2242 evar(1,i) = lbuf%STRA(jj(1) + i)
2243 evar(2,i) = lbuf%STRA(jj(2) + i)
2244 evar(3,i) = lbuf%STRA(jj(3) + i)
2245 evar(4,i) = lbuf%STRA(jj(4) + i) * half
2246 evar(5,i) = lbuf%STRA(jj(5) + i) * half
2247 evar(6,i) = lbuf%STRA(jj(6) + i) * half
2248 is_written_tensor(i) = 1
2249 ENDDO
2250 ELSEIF(istrain > 0)THEN
2251 IF(mlw /= 14.AND.mlw /= 24.AND.mlw<28)THEN
2252 DO i=1,nel
2253C 3*9*3 points d'integration (r*s*t)
2254 evar(1,i) = lbuf%STRA(jj(1) + i)
2255 evar(2,i) = lbuf%STRA(jj(2) + i)
2256 evar(3,i) = lbuf%STRA(jj(3) + i)
2257 evar(4,i) = lbuf%STRA(jj(4) + i) * half
2258 evar(5,i) = lbuf%STRA(jj(5) + i) * half
2259 evar(6,i) = lbuf%STRA(jj(6) + i) * half
2260 is_written_tensor(i) = 1
2261 ENDDO
2262 ENDIF
2263 ENDIF
2264C
2265 IF (kcvt /= 0 .AND. jhbe /= 16) THEN
2266C STRAIN TENSOR IN GLOBAL SYSTEM
2267 icsig=iparg(17,ng)
2268 IF (jhbe == 14.AND.icsig > 0) THEN
2269 SELECT CASE (icsig)
2270 CASE (1)
2271 DO i=1,nel
2272 n = i + nft
2273 IF(kcvt==2 .AND. igtyp ==22)THEN
2274 gama(1)=zero
2275 gama(2)=lbuf%GAMA(jj(1) + i)
2276 gama(3)=lbuf%GAMA(jj(2) + i)
2277 gama(4)=zero
2278 gama(5)=-gama(2)
2279 gama(6)=gama(1)
2280 ELSEIF(kcvt==2 .AND. igtyp ==21)THEN
2281 gama(1)=zero
2282 gama(2)=gbuf%GAMA(jj(1) + i)
2283 gama(3)=gbuf%GAMA(jj(2) + i)
2284 gama(4)=zero
2285 gama(5)=-gama(2)
2286 gama(6)=gama(1)
2287 ELSE
2288 gama(1)=one
2289 gama(2)=zero
2290 gama(3)=zero
2291 gama(4)=zero
2292 gama(5)=one
2293 gama(6)=zero
2294 END IF
2295 CALL srota6(
2296 1 x, ixs(1,n), kcvt, evar(1,i),
2297 2 gama, jhbe, igtyp, isorth)
2298 ENDDO
2299 CASE (10)
2300 DO i=1,nel
2301 n = i + nft
2302 IF(kcvt==2 .AND. igtyp ==22)THEN
2303 gama(1)=lbuf%GAMA(jj(1) + i)
2304 gama(2)=lbuf%GAMA(jj(2) + i)
2305 gama(3)=zero
2306 gama(4)=-gama(2)
2307 gama(5)=gama(1)
2308 gama(6)=zero
2309 ELSEIF(kcvt==2 .AND. igtyp ==21)THEN
2310 gama(1)=gbuf%GAMA(jj(1) + i)
2311 gama(2)=gbuf%GAMA(jj(2) + i)
2312 gama(3)=zero
2313 gama(4)=-gama(2)
2314 gama(5)=gama(1)
2315 gama(6)=zero
2316 ELSE
2317 gama(1)=one
2318 gama(2)=zero
2319 gama(3)=zero
2320 gama(4)=zero
2321 gama(5)=one
2322 gama(6)=zero
2323 END IF
2324 CALL srota6(
2325 1 x, ixs(1,n), kcvt, evar(1,i),
2326 2 gama, jhbe, igtyp, isorth)
2327 ENDDO
2328 CASE (100)
2329 DO i=1,nel
2330 n = i + nft
2331 IF(kcvt==2 .AND. igtyp ==22)THEN
2332 gama(1)=lbuf%GAMA(jj(2) + i)
2333 gama(2)=zero
2334 gama(3)=lbuf%GAMA(jj(1) + i)
2335 gama(4)=gama(3)
2336 gama(5)=zero
2337 gama(6)=-gama(1)
2338 ELSEIF(kcvt==2 .AND. igtyp ==21)THEN
2339 gama(1)=gbuf%GAMA(jj(2) + i)
2340 gama(2)=zero
2341 gama(3)=gbuf%GAMA(jj(1) + i)
2342 gama(4)=gama(3)
2343 gama(5)=zero
2344 gama(6)=-gama(1)
2345 ELSE
2346 gama(1)=one
2347 gama(2)=zero
2348 gama(3)=zero
2349 gama(4)=zero
2350 gama(5)=one
2351 gama(6)=zero
2352 END IF
2353 CALL srota6(
2354 1 x, ixs(1,n), kcvt, evar(1,i),
2355 2 gama, jhbe, igtyp, isorth)
2356 ENDDO
2357 END SELECT
2358 ELSE
2359 DO i=1,nel
2360 n = i + nft
2361 IF(kcvt==2)THEN
2362 gama(1)=gbuf%GAMA(jj(1) + i)
2363 gama(2)=gbuf%GAMA(jj(2) + i)
2364 gama(3)=gbuf%GAMA(jj(3) + i)
2365 gama(4)=gbuf%GAMA(jj(4) + i)
2366 gama(5)=gbuf%GAMA(jj(5) + i)
2367 gama(6)=gbuf%GAMA(jj(6) + i)
2368 ELSE
2369 gama(1)=one
2370 gama(2)=zero
2371 gama(3)=zero
2372 gama(4)=zero
2373 gama(5)=one
2374 gama(6)=zero
2375 END IF
2376 CALL srota6(
2377 1 x, ixs(1,n), kcvt, evar(1,i),
2378 2 gama, jhbe, igtyp, isorth)
2379 ENDDO
2380 ENDIF !(JHBE == 14.AND.ICSIG > 0)
2381 ENDIF
2382 END IF ! (TSHELL == 1.AND.IR
2383 ENDIF
2384
2385 ELSEIF ( ilay >= 0 .AND. ilay <= nlay) THEN
2386c ILAY= IS= IT=
2387 evar(1:6,1:nel) = zero
2388 IF ((isolnod == 6.OR.isolnod == 8).AND.jhbe == 15) THEN
2389c-----------
2390 IF ( ilay <= npt ) THEN
2391 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(1,1,1)
2392 IF (mlw>=28.AND.mlw /= 49 .OR. mlw == 24) THEN
2393 DO i=1,nel
2394 evar(1,i) = evar(1,i) + lbuf%STRA(jj(1) + i)
2395 evar(2,i) = evar(2,i) + lbuf%STRA(jj(2) + i)
2396 evar(3,i) = evar(3,i) + lbuf%STRA(jj(3) + i)
2397 evar(4,i) = evar(4,i) + lbuf%STRA(jj(4) + i)*half
2398 evar(5,i) = evar(5,i) + lbuf%STRA(jj(5) + i)*half
2399 evar(6,i) = evar(6,i) + lbuf%STRA(jj(6) + i)*half
2400 is_written_tensor(i) = 1
2401 ENDDO
2402 ELSEIF(mlw == 12 .OR. mlw == 14)THEN
2403 DO i=1,nel
2404 n = i + nft
2405 evar(1,i) = evar(1,i) + lbuf%EPE(jj(1) + i)
2406 evar(2,i) = evar(2,i) + lbuf%EPE(jj(2) + i)
2407 evar(3,i) = evar(3,i) + lbuf%EPE(jj(3) + i)
2408 is_written_tensor(i) = 1
2409 ENDDO
2410 ELSEIF (istrain > 0) THEN
2411 IF (mlw /= 14.AND.mlw /= 24.AND.mlw<28) THEN
2412 DO i=1,nel
2413 evar(1,i) = evar(1,i) + lbuf%STRA(jj(1) + i)
2414 evar(2,i) = evar(2,i) + lbuf%STRA(jj(2) + i)
2415 evar(3,i) = evar(3,i) + lbuf%STRA(jj(3) + i)
2416 evar(4,i) = evar(4,i) + lbuf%STRA(jj(4) + i)*half
2417 evar(5,i) = evar(5,i) + lbuf%STRA(jj(5) + i)*half
2418 evar(6,i) = evar(6,i) + lbuf%STRA(jj(6) + i)*half
2419 is_written_tensor(i) = 1
2420 ENDDO
2421 ENDIF
2422 ENDIF
2423 ENDIF
2424 IF (kcvt /= 0 .AND. is <= npt) THEN
2425C STRAIN TENSOR IN GLOBAL SYSTEM
2426 lbuf => elbuf_tab(ng)%BUFLY(is)%LBUF(1,1,1)
2427 DO i=1,nel
2428 n = i + nft
2429 IF(kcvt==2)THEN
2430 gama(1)= gbuf%GAMA(jj(1) + i)
2431 gama(2)= gbuf%GAMA(jj(2) + i)
2432 gama(3)= zero
2433 gama(4)=-gama(2)
2434 gama(5)= gama(1)
2435 gama(6)= zero
2436 ELSE
2437 gama(1)=one
2438 gama(2)=zero
2439 gama(3)=zero
2440 gama(4)=zero
2441 gama(5)=one
2442 gama(6)=zero
2443 END IF
2444 CALL srota6(
2445 1 x, ixs(1,n), kcvt, evar(1,i),
2446 2 gama, jhbe, igtyp, isorth)
2447 ENDDO
2448 ENDIF
2449 ENDIF
2450 ENDIF
2451
2452 IF( nfilsol /= 0 .AND. gbuf%G_FILL /= 0 ) THEN
2453 DO i=1,nel
2454 evar(1,i) = evar(1,i) * gbuf%FILL(i)
2455 evar(2,i) = evar(2,i) * gbuf%FILL(i)
2456 evar(3,i) = evar(3,i) * gbuf%FILL(i)
2457 evar(4,i) = evar(4,i) * gbuf%FILL(i)
2458 evar(5,i) = evar(5,i) * gbuf%FILL(i)
2459 evar(6,i) = evar(6,i) * gbuf%FILL(i)
2460 ENDDO
2461 ENDIF
2462C-----------------------------------------------
2463 ELSEIF (keyword == 'TENS/STRAIN_ENG') THEN
2464C-----------------------------------------------
2465c ILAYER=NULL IR=NULL IS=NULL IT=NULL average value at elem center only
2466 IF( ilay == -1 .AND. ir == -1 .AND. is == -1 .AND. it == -1 )THEN
2467 evar(1:6,1:nel) = zero
2468 DO i=1,8
2469 kk(i) = nel*(i-1)
2470 END DO
2471 IF (isolnod == 4 .OR. isolnod == 10) THEN
2472 is_written_tensor(1:nel) = 1
2473 DO i=1,nel
2474 n = i + nft
2475 nni = ixs(2,n)
2476 j = i
2477 xn(j)=x(1,nni)
2478 yn(j)=x(2,nni)
2479 zn(j)=x(3,nni)
2480 dxn(j)=d(1,nni)
2481 dyn(j)=d(2,nni)
2482 dzn(j)=d(3,nni)
2483 nni = ixs(4,n)
2484 j = kk(2)+i
2485 xn(j)=x(1,nni)
2486 yn(j)=x(2,nni)
2487 zn(j)=x(3,nni)
2488 dxn(j)=d(1,nni)
2489 dyn(j)=d(2,nni)
2490 dzn(j)=d(3,nni)
2491 nni = ixs(7,n)
2492 j = kk(3)+i
2493 xn(j)=x(1,nni)
2494 yn(j)=x(2,nni)
2495 zn(j)=x(3,nni)
2496 dxn(j)=d(1,nni)
2497 dyn(j)=d(2,nni)
2498 dzn(j)=d(3,nni)
2499 nni = ixs(6,n)
2500 j = kk(4)+i
2501 xn(j)=x(1,nni)
2502 yn(j)=x(2,nni)
2503 zn(j)=x(3,nni)
2504 dxn(j)=d(1,nni)
2505 dyn(j)=d(2,nni)
2506 dzn(j)=d(3,nni)
2507 END DO
2508 CALL t4_tstrain(xn,yn,zn,dxn,dyn,dzn,evar,nel)
2509c-----------
2510 ELSE IF (isolnod == 8 .OR. isolnod == 16 .OR. isolnod == 20) THEN
2511c-----------
2512 is_written_tensor(1:nel) = 1
2513 DO i=1,nel
2514 n = i + nft
2515 DO ii = 1, 8
2516 nni = ixs(ii+1,n)
2517 jj = kk(ii)+i
2518 xn(jj)=x(1,nni)
2519 yn(jj)=x(2,nni)
2520 zn(jj)=x(3,nni)
2521 dxn(jj)=d(1,nni)
2522 dyn(jj)=d(2,nni)
2523 dzn(jj)=d(3,nni)
2524 END DO
2525 END DO
2526 CALL s8_tstrain(xn,yn,zn,dxn,dyn,dzn,evar,nel)
2527c-----------
2528 ELSE IF (isolnod == 6 )THEN
2529 is_written_tensor(1:nel) = 1
2530 DO i=1,nel
2531 n = i + nft
2532 DO ii = 1, 3
2533 nni = ixs(ii+1,n)
2534 jj = kk(ii)+i
2535 xn(jj)=x(1,nni)
2536 yn(jj)=x(2,nni)
2537 zn(jj)=x(3,nni)
2538 dxn(jj)=d(1,nni)
2539 dyn(jj)=d(2,nni)
2540 dzn(jj)=d(3,nni)
2541 nni = ixs(ii+5,n)
2542 jj = kk(ii+3)+i
2543 xn(jj)=x(1,nni)
2544 yn(jj)=x(2,nni)
2545 zn(jj)=x(3,nni)
2546 dxn(jj)=d(1,nni)
2547 dyn(jj)=d(2,nni)
2548 dzn(jj)=d(3,nni)
2549 END DO
2550 END DO
2551 CALL s6_tstrain(xn,yn,zn,dxn,dyn,dzn,evar,nel)
2552c-----------
2553 END IF
2554 END IF
2555C-----------------------------------------------
2556 ELSEIF (keyword == 'TENS/DAMA') THEN
2557C-----------------------------------------------
2558C CRACKS
2559C-----------------------------------------------
2560 IF (mlw == 24 .AND. nint(pm(56,mt1)) == 1) THEN
2561c-----------
2562 DO i=1,nel
2563 evar(1,i) = zero
2564 evar(2,i) = zero
2565 evar(3,i) = zero
2566 evar(4,i) = zero
2567 evar(5,i) = zero
2568 evar(6,i) = zero
2569 ENDDO
2570c----------- not work for the moment
2571 IF (isolnod == 8 .AND.(jhbe == 14 .OR. jhbe == 15)) THEN
2572c-----------
2573 IF (tshell == 1 ) THEN
2574 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,1)
2575 DO i=1,nel
2576 evar(1,i) = lbuf%DGLO(jj(1) + i)
2577 evar(2,i) = lbuf%DGLO(jj(2) + i)
2578 evar(3,i) = lbuf%DGLO(jj(3) + i)
2579 evar(4,i) = lbuf%DGLO(jj(4) + i)
2580 evar(5,i) = lbuf%DGLO(jj(5) + i)
2581 evar(6,i) = lbuf%DGLO(jj(6) + i)
2582 is_written_tensor(i) = 1
2583 ENDDO
2584 ELSE
2585c----------- avoid crash
2586c DO IPT=1,NPTG
2587c LBUF => ELBUF_TAB(NG)%BUFLY(1)c%LBUF(IPT,1,1)
2588c DO I=1,NEL
2589c EVAR(1,I) = EVAR(1,I)+LBUF%DGLO(JJ(1) + I)/NPTG
2590c EVAR(2,I) = EVAR(2,I)+LBUF%DGLO(JJ(2) + I)/NPTG
2591c EVAR(3,I) = EVAR(3,I)+LBUF%DGLO(JJ(3) + I)/NPTG
2592c EVAR(4,I) = EVAR(4,I)+LBUF%DGLO(JJ(4) + I)/NPTG
2593c EVAR(5,I) = EVAR(5,I)+LBUF%DGLO(JJ(5) + I)/NPTG
2594c EVAR(6,I) = EVAR(6,I)+LBUF%DGLO(JJ(6) + I)/NPTG
2595c IS_WRITTEN_TENSOR(I) = 1
2596c ENDDO
2597c ENDDO
2598 END IF !(TSHELL == 1 ) THEN
2599 ELSE
2600 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
2601 DO i=1,nel
2602 evar(1,i) = evar(1,i)+lbuf%DGLO(jj(1) + i)
2603 evar(2,i) = evar(2,i)+lbuf%DGLO(jj(2) + i)
2604 evar(3,i) = evar(3,i)+lbuf%DGLO(jj(3) + i)
2605 evar(4,i) = evar(4,i)+lbuf%DGLO(jj(4) + i)
2606 evar(5,i) = evar(5,i)+lbuf%DGLO(jj(5) + i)
2607 evar(6,i) = evar(6,i)+lbuf%DGLO(jj(6) + i)
2608 is_written_tensor(i) = 1
2609 ENDDO
2610 ENDIF
2611 IF (kcvt /= 0) THEN
2612C DAMAGE IN GLOBAL SYSTEM
2613 DO i=1,nel
2614 n = i + nft
2615 IF (kcvt==2) THEN
2616 ii = 6*(i-1)
2617 gama(1)= gbuf%GAMA(jj(1) + i)
2618 gama(2)= gbuf%GAMA(jj(2) + i)
2619 gama(3)= zero
2620 gama(4)=-gama(2)
2621 gama(5)= gama(1)
2622 gama(6)= zero
2623 ELSE
2624 gama(1)=one
2625 gama(2)=zero
2626 gama(3)=zero
2627 gama(4)=zero
2628 gama(5)=one
2629 gama(6)=zero
2630 END IF
2631 CALL srota6(
2632 1 x, ixs(1,n), kcvt, evar(1,i),
2633 2 gama, jhbe, igtyp, isorth)
2634 ENDDO
2635 ENDIF
2636 ELSE
2637 DO i=1,nel
2638 evar(1,i) = zero
2639 evar(2,i) = zero
2640 evar(3,i) = zero
2641 evar(4,i) = zero
2642 evar(5,i) = zero
2643 evar(6,i) = zero
2644 ENDDO
2645 ENDIF
2646
2647 IF( nfilsol /= 0 .AND. gbuf%G_FILL /= 0 ) THEN
2648 DO i=1,nel
2649 evar(1,i) = evar(1,i) * gbuf%FILL(i)
2650 evar(2,i) = evar(2,i) * gbuf%FILL(i)
2651 evar(3,i) = evar(3,i) * gbuf%FILL(i)
2652 evar(4,i) = evar(4,i) * gbuf%FILL(i)
2653 evar(5,i) = evar(5,i) * gbuf%FILL(i)
2654 evar(6,i) = evar(6,i) * gbuf%FILL(i)
2655 ENDDO
2656 ENDIF
2657C-----------------------------------------------
2658 ELSEIF (keyword == 'TENS/EPSP') THEN
2659C-----------------------------------------------
2660c ILAYER=NULL IR=NULL IS=NULL IT=NULL
2661 IF( ilay == -1 .AND. ir == -1 .AND. is == -1 .AND. it == -1 )THEN
2662 DO i=1,nel
2663 evar(1,i) = zero
2664 evar(2,i) = zero
2665 evar(3,i) = zero
2666 evar(4,i) = zero
2667 evar(5,i) = zero
2668 evar(6,i) = zero
2669 ENDDO
2670c-----------
2671 IF ((isolnod==8.OR.(isolnod==4 .AND. (isrot==0.OR.isrot==3))).AND.
2672 . npt==1 .AND. jhbe /= 14 .AND. jhbe /= 15) THEN
2673c-----------
2674 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
2675 IF (isorth > 0) isorthg = 1
2676!
2677 IF (mlw == 24) THEN
2678 DO i=1,nel
2679 evar(1,i) = lbuf%PLA(jj(1) + i + nel)
2680 evar(2,i) = lbuf%PLA(jj(2) + i + nel)
2681 evar(3,i) = lbuf%PLA(jj(3) + i + nel)
2682 evar(4,i) = lbuf%PLA(jj(4) + i + nel)*half
2683 evar(5,i) = lbuf%PLA(jj(5) + i + nel)*half
2684 evar(6,i) = lbuf%PLA(jj(6) + i + nel)*half
2685 is_written_tensor(i) = 1
2686 ENDDO
2687 ENDIF ! IF (MLW == 24)
2688!
2689 IF (kcvt /= 0) THEN
2690C PLASTIC STRAIN TENSOR IN GLOBAL SYSTEM
2691 DO i=1,nel
2692 n = i + nft
2693 IF (kcvt == 2) THEN
2694 gama(1)=gbuf%GAMA(jj(1) + i)
2695 gama(2)=gbuf%GAMA(jj(2) + i)
2696 gama(3)=gbuf%GAMA(jj(3) + i)
2697 gama(4)=gbuf%GAMA(jj(4) + i)
2698 gama(5)=gbuf%GAMA(jj(5) + i)
2699 gama(6)=gbuf%GAMA(jj(6) + i)
2700 ELSE
2701 gama(1)=one
2702 gama(2)=zero
2703 gama(3)=zero
2704 gama(4)=zero
2705 gama(5)=one
2706 gama(6)=zero
2707 END IF
2708 CALL srota6(
2709 1 x, ixs(1,n), kcvt, evar(1,i),
2710 2 gama, jhbe, igtyp, isorth)
2711 ENDDO
2712 ENDIF
2713c-----------
2714 ELSEIF(isolnod == 16.OR.isolnod == 20 .OR.
2715 . (isolnod == 8.AND.(jhbe == 14.OR.jhbe == 17)))THEN
2716c-----------
2717 IF (mlw == 24) THEN
2718 DO i=1,nel
2719 n = i + nft
2720 DO il=1,nlay
2721 DO is=1,npts
2722 DO it=1,nptt
2723 DO ir=1,nptr
2724 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
2725 IF (elbuf_tab(ng)%BUFLY(il)%L_PLA > 0) THEN
2726 evar_tmp(1) = lbuf%PLA(jj(1) + i + nel)/npt
2727 evar_tmp(2) = lbuf%PLA(jj(2) + i + nel)/npt
2728 evar_tmp(3) = lbuf%PLA(jj(3) + i + nel)/npt
2729 evar_tmp(4) = lbuf%PLA(jj(4) + i + nel)*half/npt
2730 evar_tmp(5) = lbuf%PLA(jj(5) + i + nel)*half/npt
2731 evar_tmp(6) = lbuf%PLA(jj(6) + i + nel)*half/npt
2732 icsig=iparg(17,ng)
2733 IF (kcvt /= 0 .AND.icsig > 0) THEN
2734C PLASTIC STRAIN TENSOR IN GLOBAL SYSTEM
2735 IF (jhbe == 14) THEN
2736 SELECT CASE (icsig)
2737 CASE (1)
2738 IF (kcvt == 2.AND.igtyp == 22) THEN
2739 gama(1)= zero
2740 gama(2)= lbuf%GAMA(jj(1) + i)
2741 gama(3)= lbuf%GAMA(jj(2) + i)
2742 gama(4)= zero
2743 gama(5)=-gama(2)
2744 gama(6)= gama(1)
2745 ELSEIF (kcvt == 2.AND.igtyp == 21) THEN
2746 gama(1)= zero
2747 gama(2)= gbuf%GAMA(jj(1) + i)
2748 gama(3)= gbuf%GAMA(jj(2) + i)
2749 gama(4)= zero
2750 gama(5)=-gama(2)
2751 gama(6)= gama(1)
2752 ELSE
2753 gama(1)=one
2754 gama(2)=zero
2755 gama(3)=zero
2756 gama(4)=zero
2757 gama(5)=one
2758 gama(6)=zero
2759 END IF
2760 CALL srota6(
2761 1 x, ixs(1,n),kcvt, evar_tmp,
2762 2 gama, jhbe, igtyp, isorth)
2763 CASE (10)
2764 IF (kcvt == 2.AND.igtyp == 22) THEN
2765 gama(1)= lbuf%GAMA(jj(1) + i)
2766 gama(2)= lbuf%GAMA(jj(2) + i)
2767 gama(3)= zero
2768 gama(4)=-gama(2)
2769 gama(5)= gama(1)
2770 gama(6)= zero
2771 ELSEIF (kcvt == 2.AND.igtyp == 21) THEN
2772 gama(1)= gbuf%GAMA(jj(1) + i)
2773 gama(2)= gbuf%GAMA(jj(2) + i)
2774 gama(3)= zero
2775 gama(4)=-gama(2)
2776 gama(5)= gama(1)
2777 gama(6)= zero
2778 ELSE
2779 gama(1)=one
2780 gama(2)=zero
2781 gama(3)=zero
2782 gama(4)=zero
2783 gama(5)=one
2784 gama(6)=zero
2785 END IF
2786 CALL srota6(
2787 1 x, ixs(1,n),kcvt, evar_tmp,
2788 2 gama, jhbe, igtyp, isorth)
2789 CASE (100)
2790 IF (kcvt == 2.AND.igtyp == 22) THEN
2791 gama(1)= lbuf%GAMA(jj(2) + i)
2792 gama(2)= zero
2793 gama(3)= lbuf%GAMA(jj(1) + i)
2794 gama(4)= gama(3)
2795 gama(5)= zero
2796 gama(6)=-gama(1)
2797 ELSEIF (kcvt == 2.AND.igtyp == 21) THEN
2798 gama(1)= gbuf%GAMA(jj(2) + i)
2799 gama(2)= zero
2800 gama(3)= gbuf%GAMA(jj(1) + i)
2801 gama(4)= gama(3)
2802 gama(5)= zero
2803 gama(6)=-gama(1)
2804 ELSE
2805 gama(1)=one
2806 gama(2)=zero
2807 gama(3)=zero
2808 gama(4)=zero
2809 gama(5)=one
2810 gama(6)=zero
2811 END IF
2812 CALL srota6(
2813 1 x, ixs(1,n),kcvt, evar_tmp,
2814 2 gama, jhbe, igtyp, isorth)
2815 END SELECT
2816 ENDIF
2817 ENDIF
2818 evar(1,i) = evar(1,i)+evar_tmp(1)
2819 evar(2,i) = evar(2,i)+evar_tmp(2)
2820 evar(3,i) = evar(3,i)+evar_tmp(3)
2821 evar(4,i) = evar(4,i)+evar_tmp(4)
2822 evar(5,i) = evar(5,i)+evar_tmp(5)
2823 evar(6,i) = evar(6,i)+evar_tmp(6)
2824 is_written_tensor(i) = 1
2825 ENDIF
2826 ENDDO
2827 ENDDO
2828 ENDDO
2829 ENDDO
2830 ENDDO
2831 ENDIF ! IF (MLW == 24)
2832c---
2833 icsig=iparg(17,ng)
2834 IF (kcvt /= 0 .AND.icsig == 0 .AND. jhbe /= 16) THEN
2835C PLASTIC STRAIN TENSOR IN GLOBAL SYSTEM
2836 DO i=1,nel
2837 n = i + nft
2838 IF (kcvt == 2) THEN
2839 gama(1)=gbuf%GAMA(jj(1) + i)
2840 gama(2)=gbuf%GAMA(jj(2) + i)
2841 gama(3)=gbuf%GAMA(jj(3) + i)
2842 gama(4)=gbuf%GAMA(jj(4) + i)
2843 gama(5)=gbuf%GAMA(jj(5) + i)
2844 gama(6)=gbuf%GAMA(jj(6) + i)
2845 ELSE
2846 gama(1)=one
2847 gama(2)=zero
2848 gama(3)=zero
2849 gama(4)=zero
2850 gama(5)=one
2851 gama(6)=zero
2852 END IF
2853 CALL srota6(
2854 1 x, ixs(1,n), kcvt, evar(1,i),
2855 2 gama, jhbe, igtyp, isorth)
2856 ENDDO
2857 ENDIF
2858c-----------
2859 ELSEIF (isolnod==10 .OR. (isolnod==4 .AND. isrot==1)) THEN
2860c-----------
2861 IF (mlw == 24 .and. istrain > 0) THEN
2862 DO i=1,nel
2863 DO ipt=1,npt
2864 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ipt,1,1)
2865 evar(1,i) = evar(1,i)+lbuf%PLA(jj(1) + i + nel)/npt
2866 evar(2,i) = evar(2,i)+lbuf%PLA(jj(2) + i + nel)/npt
2867 evar(3,i) = evar(3,i)+lbuf%PLA(jj(3) + i + nel)/npt
2868 evar(4,i) = evar(4,i)+lbuf%PLA(jj(4) + i + nel)*half/npt
2869 evar(5,i) = evar(5,i)+lbuf%PLA(jj(5) + i + nel)*half/npt
2870 evar(6,i) = evar(6,i)+lbuf%PLA(jj(6) + i + nel)*half/npt
2871 is_written_tensor(i) = 1
2872 ENDDO
2873 ENDDO
2874 ENDIF ! IF (MLW == 24 .and. ISTRAIN > 0)
2875 IF (kcvt /= 0) THEN
2876C PLASTIC STRAIN TENSOR IN GLOBAL SYSTEM
2877 DO i=1,nel
2878 n = i + nft
2879 IF (kcvt == 2) THEN
2880 gama(1)=gbuf%GAMA(jj(1) + i)
2881 gama(2)=gbuf%GAMA(jj(2) + i)
2882 gama(3)=gbuf%GAMA(jj(3) + i)
2883 gama(4)=gbuf%GAMA(jj(4) + i)
2884 gama(5)=gbuf%GAMA(jj(5) + i)
2885 gama(6)=gbuf%GAMA(jj(6) + i)
2886 ELSE
2887 gama(1)=one
2888 gama(2)=zero
2889 gama(3)=zero
2890 gama(4)=zero
2891 gama(5)=one
2892 gama(6)=zero
2893 ENDIF
2894 CALL srota6(
2895 1 x, ixs(1,n), kcvt, evar(1,i),
2896 2 gama, jhbe, igtyp, isorth)
2897 ENDDO
2898 ENDIF
2899c-----------
2900 ELSEIF((isolnod == 6.OR.isolnod == 8).AND.jhbe == 15)THEN
2901c-----------
2902 IF (mlw == 24 .and. istrain > 0) THEN
2903 DO i=1,nel
2904 DO il= 1,nlay
2905 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(1,1,1)
2906 evar(1,i) = evar(1,i)+lbuf%PLA(jj(1) + i + nel)/nlay
2907 evar(2,i) = evar(2,i)+lbuf%PLA(jj(2) + i + nel)/nlay
2908 evar(3,i) = evar(3,i)+lbuf%PLA(jj(3) + i + nel)/nlay
2909 evar(4,i) = evar(4,i)+lbuf%PLA(jj(4) + i + nel)*half/nlay
2910 evar(5,i) = evar(5,i)+lbuf%PLA(jj(5) + i + nel)*half/nlay
2911 evar(6,i) = evar(6,i)+lbuf%PLA(jj(6) + i + nel)*half/nlay
2912 is_written_tensor(i) = 1
2913 ENDDO
2914 ENDDO
2915 ENDIF ! IF (MLW == 24 .and. ISTRAIN > 0)
2916 IF (kcvt /= 0) THEN
2917C PLASTIC STRAIN TENSOR IN GLOBAL SYSTEM
2918 DO i=1,nel
2919 n = i + nft
2920 IF (kcvt == 2) THEN
2921 gama(1)= gbuf%GAMA(jj(1) + i)
2922 gama(2)= gbuf%GAMA(jj(2) + i)
2923 gama(3)= zero
2924 gama(4)=-gama(2)
2925 gama(5)= gama(1)
2926 gama(6)= zero
2927 ELSE
2928 gama(1)=one
2929 gama(2)=zero
2930 gama(3)=zero
2931 gama(4)=zero
2932 gama(5)=one
2933 gama(6)=zero
2934 END IF
2935 CALL srota6(
2936 1 x, ixs(1,n), kcvt, evar(1,i),
2937 2 gama, jhbe, igtyp, isorth)
2938 ENDDO
2939 ENDIF
2940c-----------
2941 ENDIF ! ISOLNOD & ......
2942
2943 ELSEIF ( ilay == -1 .AND. ir >= 0 .AND. ir <= nptr .AND.
2944 . is >= 0 .AND. is <= npts .AND. it >= 0 .AND. it <= nptt) THEN
2945c IR= IS= IT=
2946
2947C-----------------------------------------------
2948 DO i=1,nel
2949 evar(1,i) = zero
2950 evar(2,i) = zero
2951 evar(3,i) = zero
2952 evar(4,i) = zero
2953 evar(5,i) = zero
2954 evar(6,i) = zero
2955 ENDDO
2956c-----------
2957 IF ((isolnod == 8 .OR.npt == 1 .OR.
2958 . (isolnod == 4 .AND. isrot == 0)) .AND.
2959 . jhbe /= 14.AND.jhbe /= 15.AND.jhbe /= 17) THEN
2960c-----------
2961 ipt = ir + ( (is-1) + (it-1)*npts )*nptr
2962 IF (ipt == 1 ) THEN
2963 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
2964 IF (mlw == 24) THEN
2965 DO i=1,nel
2966 evar(1,i) = evar(1,i) + lbuf%PLA(jj(1) + i + nel)
2967 evar(2,i) = evar(2,i) + lbuf%PLA(jj(2) + i + nel)
2968 evar(3,i) = evar(3,i) + lbuf%PLA(jj(3) + i + nel)
2969 evar(4,i) = evar(4,i) + lbuf%PLA(jj(4) + i + nel)*half
2970 evar(5,i) = evar(5,i) + lbuf%PLA(jj(5) + i + nel)*half
2971 evar(6,i) = evar(6,i) + lbuf%PLA(jj(6) + i + nel)*half
2972 is_written_tensor(i) = 1
2973 END DO
2974 ENDIF ! IF (MLW == 24)
2975 ENDIF ! IF (IPT == 1 )
2976C
2977 IF (kcvt /= 0) THEN
2978C PLASTIC STRAIN TENSOR IN GLOBAL SYSTEM
2979 DO i=1,nel
2980 n = i + nft
2981 IF(kcvt==2)THEN
2982 gama(1)=gbuf%GAMA(jj(1) + i)
2983 gama(2)=gbuf%GAMA(jj(2) + i)
2984 gama(3)=gbuf%GAMA(jj(3) + i)
2985 gama(4)=gbuf%GAMA(jj(4) + i)
2986 gama(5)=gbuf%GAMA(jj(5) + i)
2987 gama(6)=gbuf%GAMA(jj(6) + i)
2988 ELSE
2989 gama(1)=one
2990 gama(2)=zero
2991 gama(3)=zero
2992 gama(4)=zero
2993 gama(5)=one
2994 gama(6)=zero
2995 END IF
2996 CALL srota6(
2997 1 x, ixs(1,n), kcvt, evar(1,i),
2998 2 gama, jhbe, igtyp, isorth)
2999 ENDDO
3000 ENDIF
3001c-----------
3002 ELSEIF (isolnod == 16.OR.isolnod == 20.OR.(isolnod == 8.AND.
3003 . (jhbe == 14 .OR. jhbe == 17))) THEN
3004c-----------
3005 icsig = iparg(17,ng)
3006 IF (ior_tsh >0) THEN
3007 IF (icsig == 10) THEN
3008 ir=it_input
3009 is=ir_input
3010 it=is_input
3011 ELSEIF (icsig == 1) THEN
3012 ir=is_input
3013 is=it_input
3014 it=ir_input
3015 ELSE
3016 ir=ir_input
3017 is=is_input
3018 it=it_input
3019 ENDIF
3020 ENDIF
3021 ipt = ir + ( (is-1) + (it-1)*npts )*nptr
3022 IF (ipt <= nptg .AND. ir <= nptr .AND. is <= npts
3023 . .AND. it <= nptt .AND. ir*is*it >= 1) THEN
3024 IF (tshell == 1) THEN
3025 lbuf => elbuf_tab(ng)%BUFLY(it)%LBUF(ir,is,1)
3026 ELSE
3027 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ir,is,it)
3028 ENDIF
3029 IF (mlw == 24) THEN
3030 DO i=1,nel
3031C 3*9*3 points d'integration (r*s*t)
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 is_written_tensor(i) = 1
3039 ENDDO
3040 ENDIF ! IF (MLW == 24)
3041C
3042 IF (kcvt /= 0 .AND. jhbe /= 16) THEN
3043C PLASTIC STRAIN TENSOR IN GLOBAL SYSTEM
3044 icsig=iparg(17,ng)
3045 IF (jhbe == 14.AND.icsig > 0) THEN
3046 SELECT CASE (icsig)
3047 CASE (1)
3048 DO i=1,nel
3049 n = i + nft
3050 IF (kcvt == 2.AND.igtyp == 22) THEN
3051 gama(1)=zero
3052 gama(2)=lbuf%GAMA(jj(1) + i)
3053 gama(3)=lbuf%GAMA(jj(2) + i)
3054 gama(4)=zero
3055 gama(5)=-gama(2)
3056 gama(6)=gama(1)
3057 ELSEIF (kcvt == 2.AND.igtyp == 21) THEN
3058 gama(1)=zero
3059 gama(2)=gbuf%GAMA(jj(1) + i)
3060 gama(3)=gbuf%GAMA(jj(2) + i)
3061 gama(4)=zero
3062 gama(5)=-gama(2)
3063 gama(6)=gama(1)
3064 ELSE
3065 gama(1)=one
3066 gama(2)=zero
3067 gama(3)=zero
3068 gama(4)=zero
3069 gama(5)=one
3070 gama(6)=zero
3071 END IF
3072 CALL srota6(
3073 1 x, ixs(1,n), kcvt, evar(1,i),
3074 2 gama, jhbe, igtyp, isorth)
3075 ENDDO
3076 CASE (10)
3077 DO i=1,nel
3078 n = i + nft
3079 IF (kcvt == 2.AND.igtyp == 22) THEN
3080 gama(1)=lbuf%GAMA(jj(1) + i)
3081 gama(2)=lbuf%GAMA(jj(2) + i)
3082 gama(3)=zero
3083 gama(4)=-gama(2)
3084 gama(5)=gama(1)
3085 gama(6)=zero
3086 ELSEIF (kcvt == 2.AND.igtyp == 21) THEN
3087 gama(1)=gbuf%GAMA(jj(1) + i)
3088 gama(2)=gbuf%GAMA(jj(2) + i)
3089 gama(3)=zero
3090 gama(4)=-gama(2)
3091 gama(5)=gama(1)
3092 gama(6)=zero
3093 ELSE
3094 gama(1)=one
3095 gama(2)=zero
3096 gama(3)=zero
3097 gama(4)=zero
3098 gama(5)=one
3099 gama(6)=zero
3100 END IF
3101 CALL srota6(
3102 1 x, ixs(1,n), kcvt, evar(1,i),
3103 2 gama, jhbe, igtyp, isorth)
3104 ENDDO
3105 CASE (100)
3106 DO i=1,nel
3107 n = i + nft
3108 IF (kcvt == 2.AND.igtyp == 22) THEN
3109 gama(1)=lbuf%GAMA(jj(2) + i)
3110 gama(2)=zero
3111 gama(3)=lbuf%GAMA(jj(1) + i)
3112 gama(4)=gama(3)
3113 gama(5)=zero
3114 gama(6)=-gama(1)
3115 ELSEIF (kcvt == 2.AND.igtyp == 21) THEN
3116 gama(1)=gbuf%GAMA(jj(2) + i)
3117 gama(2)=zero
3118 gama(3)=gbuf%GAMA(jj(1) + i)
3119 gama(4)=gama(3)
3120 gama(5)=zero
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 END IF
3130 CALL srota6(
3131 1 x, ixs(1,n), kcvt, evar(1,i),
3132 2 gama, jhbe, igtyp, isorth)
3133 ENDDO
3134 END SELECT
3135 ELSE
3136 DO i=1,nel
3137 n = i + nft
3138 IF (kcvt == 2) THEN
3139 gama(1)=gbuf%GAMA(jj(1) + i)
3140 gama(2)=gbuf%GAMA(jj(2) + i)
3141 gama(3)=gbuf%GAMA(jj(3) + i)
3142 gama(4)=gbuf%GAMA(jj(4) + i)
3143 gama(5)=gbuf%GAMA(jj(5) + i)
3144 gama(6)=gbuf%GAMA(jj(6) + i)
3145 ELSE
3146 gama(1)=one
3147 gama(2)=zero
3148 gama(3)=zero
3149 gama(4)=zero
3150 gama(5)=one
3151 gama(6)=zero
3152 END IF
3153 CALL srota6(
3154 1 x, ixs(1,n), kcvt, evar(1,i),
3155 2 gama, jhbe, igtyp, isorth)
3156 ENDDO
3157 ENDIF !(JHBE == 14.AND.ICSIG > 0)
3158 ENDIF ! IF (KCVT /= 0 .AND. JHBE /= 16)
3159 ENDIF
3160
3161c-----------
3162 ELSEIF (isolnod==10 .OR. (isolnod==4 .AND. isrot==1)) THEN
3163c-----------
3164 ipt = 0
3165 IF (ir == 1 .AND. is == 1 .AND. it == 1) ipt = 1
3166 IF (ir == 2 .AND. is == 1 .AND. it == 1) ipt = 2
3167 IF (ir == 1 .AND. is == 2 .AND. it == 1) ipt = 3
3168 IF (ir == 1 .AND. is == 1 .AND. it == 2) ipt = 4
3169 IF ( ipt > 0) THEN
3170 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ipt,1,1)
3171 IF (mlw == 24) THEN
3172 DO i=1,nel
3173 evar(1,i) = evar(1,i) + lbuf%PLA(jj(1) + i + nel)
3174 evar(2,i) = evar(2,i) + lbuf%PLA(jj(2) + i + nel)
3175 evar(3,i) = evar(3,i) + lbuf%PLA(jj(3) + i + nel)
3176 evar(4,i) = evar(4,i) + lbuf%PLA(jj(4) + i + nel)*half
3177 evar(5,i) = evar(5,i) + lbuf%PLA(jj(5) + i + nel)*half
3178 evar(6,i) = evar(6,i) + lbuf%PLA(jj(6) + i + nel)*half
3179 is_written_tensor(i) = 1
3180 ENDDO
3181 ENDIF ! IF (MLW == 24)
3182 ENDIF ! IF ( IPT > 0)
3183c
3184 IF (kcvt /= 0) THEN
3185 DO i=1,nel
3186 n = i + nft
3187 IF (kcvt == 2) THEN
3188 gama(1)=gbuf%GAMA(jj(1) + i)
3189 gama(2)=gbuf%GAMA(jj(2) + i)
3190 gama(3)=gbuf%GAMA(jj(3) + i)
3191 gama(4)=gbuf%GAMA(jj(4) + i)
3192 gama(5)=gbuf%GAMA(jj(5) + i)
3193 gama(6)=gbuf%GAMA(jj(6) + i)
3194 ELSE
3195 gama(1)=one
3196 gama(2)=zero
3197 gama(3)=zero
3198 gama(4)=zero
3199 gama(5)=one
3200 gama(6)=zero
3201 END IF
3202 CALL srota6(
3203 1 x, ixs(1,n), kcvt, evar(1,i),
3204 2 gama, jhbe, igtyp, isorth)
3205 ENDDO
3206 ENDIF
3207
3208 ENDIF
3209c-----------
3210 ELSEIF ( ilay >= 0 .AND. ilay <= nlay .AND. ir >= 0 .AND. ir <= nptr .AND.
3211 . is >= 0 .AND. is <= npts) THEN
3212 evar(1:6,1:nel)=zero
3213 IF ((isolnod == 6.OR.isolnod == 8).AND.jhbe == 15) THEN
3214c-----------
3215 IF ( ilay <= npt ) THEN
3216 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(1,1,1)
3217 IF (mlw == 24) THEN
3218 DO i=1,nel
3219 evar(1,i) = evar(1,i) + lbuf%PLA(jj(1) + i + nel)
3220 evar(2,i) = evar(2,i) + lbuf%PLA(jj(2) + i + nel)
3221 evar(3,i) = evar(3,i) + lbuf%PLA(jj(3) + i + nel)
3222 evar(4,i) = evar(4,i) + lbuf%PLA(jj(4) + i + nel)*half
3223 evar(5,i) = evar(5,i) + lbuf%PLA(jj(5) + i + nel)*half
3224 evar(6,i) = evar(6,i) + lbuf%PLA(jj(6) + i + nel)*half
3225 is_written_tensor(i) = 1
3226 ENDDO
3227 ENDIF ! IF (MLW == 24)
3228 ENDIF ! IF ( ILAY <= NPT )
3229 IF (kcvt /= 0 .AND. is <= npt) THEN
3230C PLASTIC STRAIN TENSOR IN GLOBAL SYSTEM
3231 lbuf => elbuf_tab(ng)%BUFLY(is)%LBUF(1,1,1)
3232 DO i=1,nel
3233 n = i + nft
3234 IF (kcvt == 2) THEN
3235 gama(1)= gbuf%GAMA(jj(1) + i)
3236 gama(2)= gbuf%GAMA(jj(2) + i)
3237 gama(3)= zero
3238 gama(4)=-gama(2)
3239 gama(5)= gama(1)
3240 gama(6)= zero
3241 ELSE
3242 gama(1)=one
3243 gama(2)=zero
3244 gama(3)=zero
3245 gama(4)=zero
3246 gama(5)=one
3247 gama(6)=zero
3248 END IF
3249 CALL srota6(
3250 1 x, ixs(1,n), kcvt, evar(1,i),
3251 2 gama, jhbe, igtyp, isorth)
3252 ENDDO
3253 ENDIF
3254 ELSEIF (isolnod == 16.OR.isolnod == 20.OR.(isolnod == 8.AND.
3255 . (jhbe == 14 .OR. jhbe == 17))) THEN
3256c-----------
3257 icsig = iparg(17,ng)
3258c IF (IOR_TSH >0) THEN
3259c IF (ICSIG == 10) THEN
3260c IR=IT_INPUT
3261c IS=IR_INPUT
3262c IT=IS_INPUT
3263c ELSEIF (ICSIG == 1) THEN
3264c IR=IS_INPUT
3265c IS=IT_INPUT
3266c IT=IR_INPUT
3267c ELSE
3268c IR=IR_INPUT
3269c IS=IS_INPUT
3270c IT=IT_INPUT
3271c ENDIF
3272c ENDIF
3273 IF (tshell == 1) THEN
3274 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,1)
3275 ENDIF
3276 IF (mlw == 24) THEN
3277 DO i=1,nel
3278C 3*9*3 points d'integration (r*s*t)
3279 evar(1,i) = lbuf%PLA(jj(1) + i + nel)
3280 evar(2,i) = lbuf%PLA(jj(2) + i + nel)
3281 evar(3,i) = lbuf%PLA(jj(3) + i + nel)
3282 evar(4,i) = lbuf%PLA(jj(4) + i + nel) * half
3283 evar(5,i) = lbuf%PLA(jj(5) + i + nel) * half
3284 evar(6,i) = lbuf%PLA(jj(6) + i + nel) * half
3285 is_written_tensor(i) = 1
3286 ENDDO
3287 ENDIF ! IF (MLW == 24)
3288C
3289 IF (kcvt /= 0 .AND. jhbe /= 16) THEN
3290C PLASTIC STRAIN TENSOR IN GLOBAL SYSTEM
3291 icsig=iparg(17,ng)
3292 IF (jhbe == 14.AND.icsig > 0) THEN
3293 SELECT CASE (icsig)
3294 CASE (1)
3295 DO i=1,nel
3296 n = i + nft
3297 IF (kcvt == 2.AND. igtyp==22) THEN
3298 gama(1)=zero
3299 gama(2)=lbuf%GAMA(jj(1) + i)
3300 gama(3)=lbuf%GAMA(jj(2) + i)
3301 gama(4)=zero
3302 gama(5)=-gama(2)
3303 gama(6)=gama(1)
3304 ELSEIF (kcvt == 2.AND. igtyp==21) THEN
3305 gama(1)=zero
3306 gama(2)=gbuf%GAMA(jj(1) + i)
3307 gama(3)=gbuf%GAMA(jj(2) + i)
3308 gama(4)=zero
3309 gama(5)=-gama(2)
3310 gama(6)=gama(1)
3311 ELSE
3312 gama(1)=one
3313 gama(2)=zero
3314 gama(3)=zero
3315 gama(4)=zero
3316 gama(5)=one
3317 gama(6)=zero
3318 END IF
3319 CALL srota6(
3320 1 x, ixs(1,n), kcvt, evar(1,i),
3321 2 gama, jhbe, igtyp, isorth)
3322 ENDDO
3323 CASE (10)
3324 DO i=1,nel
3325 n = i + nft
3326 IF (kcvt == 2.AND. igtyp==22) THEN
3327 gama(1)=lbuf%GAMA(jj(1) + i)
3328 gama(2)=lbuf%GAMA(jj(2) + i)
3329 gama(3)=zero
3330 gama(4)=-gama(2)
3331 gama(5)=gama(1)
3332 gama(6)=zero
3333 ELSEIF (kcvt == 2.AND. igtyp==21) THEN
3334 gama(1)=gbuf%GAMA(jj(1) + i)
3335 gama(2)=gbuf%GAMA(jj(2) + i)
3336 gama(3)=zero
3337 gama(4)=-gama(2)
3338 gama(5)=gama(1)
3339 gama(6)=zero
3340 ELSE
3341 gama(1)=one
3342 gama(2)=zero
3343 gama(3)=zero
3344 gama(4)=zero
3345 gama(5)=one
3346 gama(6)=zero
3347 END IF
3348 CALL srota6(
3349 1 x, ixs(1,n), kcvt, evar(1,i),
3350 2 gama, jhbe, igtyp, isorth)
3351 ENDDO
3352 CASE (100)
3353 DO i=1,nel
3354 n = i + nft
3355 IF (kcvt == 2.AND. igtyp==22) THEN
3356 gama(1)=lbuf%GAMA(jj(2) + i)
3357 gama(2)=zero
3358 gama(3)=lbuf%GAMA(jj(1) + i)
3359 gama(4)=gama(3)
3360 gama(5)=zero
3361 gama(6)=-gama(1)
3362 ELSEIF (kcvt == 2.AND. igtyp==21) THEN
3363 gama(1)=gbuf%GAMA(jj(2) + i)
3364 gama(2)=zero
3365 gama(3)=gbuf%GAMA(jj(1) + i)
3366 gama(4)=gama(3)
3367 gama(5)=zero
3368 gama(6)=-gama(1)
3369 ELSE
3370 gama(1)=one
3371 gama(2)=zero
3372 gama(3)=zero
3373 gama(4)=zero
3374 gama(5)=one
3375 gama(6)=zero
3376 END IF
3377 CALL srota6(
3378 1 x, ixs(1,n), kcvt, evar(1,i),
3379 2 gama, jhbe, igtyp, isorth)
3380 ENDDO
3381 END SELECT
3382 ELSE
3383 DO i=1,nel
3384 n = i + nft
3385 IF (kcvt == 2) THEN
3386 gama(1)=gbuf%GAMA(jj(1) + i)
3387 gama(2)=gbuf%GAMA(jj(2) + i)
3388 gama(3)=gbuf%GAMA(jj(3) + i)
3389 gama(4)=gbuf%GAMA(jj(4) + i)
3390 gama(5)=gbuf%GAMA(jj(5) + i)
3391 gama(6)=gbuf%GAMA(jj(6) + i)
3392 ELSE
3393 gama(1)=one
3394 gama(2)=zero
3395 gama(3)=zero
3396 gama(4)=zero
3397 gama(5)=one
3398 gama(6)=zero
3399 END IF
3400 CALL srota6(
3401 1 x, ixs(1,n), kcvt, evar(1,i),
3402 2 gama, jhbe, igtyp, isorth)
3403 ENDDO
3404 ENDIF !(JHBE == 14.AND.ICSIG > 0)
3405 ENDIF
3406 ENDIF
3407
3408 ELSEIF ( ilay >= 0 .AND. ilay <= nlay) THEN
3409c ILAY= IS= IT=
3410 evar(1:6,1:nel)=zero
3411 IF ((isolnod == 6.OR.isolnod == 8).AND.jhbe == 15) THEN
3412c-----------
3413 IF ( ilay <= npt ) THEN
3414 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(1,1,1)
3415 IF (mlw == 24) THEN
3416 DO i=1,nel
3417 evar(1,i) = evar(1,i) + lbuf%PLA(jj(1) + i + nel)
3418 evar(2,i) = evar(2,i) + lbuf%PLA(jj(2) + i + nel)
3419 evar(3,i) = evar(3,i) + lbuf%PLA(jj(3) + i + nel)
3420 evar(4,i) = evar(4,i) + lbuf%PLA(jj(4) + i + nel)*half
3421 evar(5,i) = evar(5,i) + lbuf%PLA(jj(5) + i + nel)*half
3422 evar(6,i) = evar(6,i) + lbuf%PLA(jj(6) + i + nel)*half
3423 is_written_tensor(i) = 1
3424 ENDDO
3425 ENDIF ! IF (MLW == 24)
3426 ENDIF ! IF ( ILAY <= NPT )
3427 IF (kcvt /= 0 .AND. is <= npt) THEN
3428C PLASTIC STRAIN TENSOR IN GLOBAL SYSTEM
3429 lbuf => elbuf_tab(ng)%BUFLY(is)%LBUF(1,1,1)
3430 DO i=1,nel
3431 n = i + nft
3432 IF (kcvt == 2) THEN
3433 gama(1)= gbuf%GAMA(jj(1) + i)
3434 gama(2)= gbuf%GAMA(jj(2) + i)
3435 gama(3)= zero
3436 gama(4)=-gama(2)
3437 gama(5)= gama(1)
3438 gama(6)= zero
3439 ELSE
3440 gama(1)=one
3441 gama(2)=zero
3442 gama(3)=zero
3443 gama(4)=zero
3444 gama(5)=one
3445 gama(6)=zero
3446 END IF
3447 CALL srota6(
3448 1 x, ixs(1,n), kcvt, evar(1,i),
3449 2 gama, jhbe, igtyp, isorth)
3450 ENDDO
3451 ENDIF
3452 ENDIF
3453 ENDIF
3454C-----------------------------------------------
3455 ELSEIF (keyword == 'TENS/STRESS/CORNER_DATA') THEN
3456C-----------------------------------------------
3457c ELEMENT DATA
3458 DO i=1,nel
3459 ii = 6*(i-1)
3460 evar(1,i) = gbuf%SIG(jj(1) + i)
3461 evar(2,i) = gbuf%SIG(jj(2) + i)
3462 evar(3,i) = gbuf%SIG(jj(3) + i)
3463 evar(4,i) = gbuf%SIG(jj(4) + i)
3464 evar(5,i) = gbuf%SIG(jj(5) + i)
3465 evar(6,i) = gbuf%SIG(jj(6) + i)
3466 is_written_tensor(i) = 1
3467 ENDDO
3468 IF(ivisc > 0) THEN
3469 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
3470 DO i=1,nel
3471 ii = 6*(i-1)
3472 evar(1,i) =evar(1,i)+ lbuf%VISC(jj(1) + i)
3473 evar(2,i) =evar(2,i)+ lbuf%VISC(jj(2) + i)
3474 evar(3,i) =evar(3,i)+ lbuf%VISC(jj(3) + i)
3475 evar(4,i) =evar(4,i)+ lbuf%VISC(jj(4) + i)
3476 evar(5,i) =evar(5,i)+ lbuf%VISC(jj(5) + i)
3477 evar(6,i) =evar(6,i)+ lbuf%VISC(jj(6) + i)
3478 ENDDO
3479 ENDIF
3480c
3481 IF (kcvt /= 0 .AND. jhbe /= 16) THEN
3482C STRESS TENSOR IN GLOBAL SYSTEM
3483 DO i=1,nel
3484 n = i + nft
3485C pour JHBE=14, valeurs moyennes est dans rep. corota.
3486 IF(kcvt==2.AND.jhbe/=14)THEN
3487 ii = 6*(i-1)
3488 gama(1)=gbuf%GAMA(jj(1) + i)
3489 gama(2)=gbuf%GAMA(jj(2) + i)
3490 gama(3)=gbuf%GAMA(jj(3) + i)
3491 gama(4)=gbuf%GAMA(jj(4) + i)
3492 gama(5)=gbuf%GAMA(jj(5) + i)
3493 gama(6)=gbuf%GAMA(jj(6) + i)
3494 ELSE
3495 gama(1)=one
3496 gama(2)=zero
3497 gama(3)=zero
3498 gama(4)=zero
3499 gama(5)=one
3500 gama(6)=zero
3501 END IF
3502 CALL srota6(
3503 1 x, ixs(1,n), kcvt, evar(1,i),
3504 2 gama, jhbe, igtyp, isorth)
3505 ENDDO
3506 ENDIF
3507c
3508 IF( nfilsol /= 0 .AND. gbuf%G_FILL /= 0 ) THEN
3509 DO i=1,nel
3510 evar(1,i) = evar(1,i) * gbuf%FILL(i)
3511 evar(2,i) = evar(2,i) * gbuf%FILL(i)
3512 evar(3,i) = evar(3,i) * gbuf%FILL(i)
3513 evar(4,i) = evar(4,i) * gbuf%FILL(i)
3514 evar(5,i) = evar(5,i) * gbuf%FILL(i)
3515 evar(6,i) = evar(6,i) * gbuf%FILL(i)
3516 ENDDO
3517 ENDIF
3518c CORNER DATA
3519 CALL strs_tenscor3(elbuf_tab(ng),iparg(1,ng),ixs ,ixs10 ,x ,
3520 . pm ,kcvt ,nel ,evar_corner )
3521 IF (isolnod <= 10) is_written_tensor(1:nel) = 1
3522C-----------------------------------------------
3523 ELSEIF (keyword == 'TENS/STRAIN/CORNER_DATA') THEN
3524C-----------------------------------------------
3525 evar(1:6,1:nel)=zero
3526C---- Element Data first
3527 IF (isolnod == 8 .AND. igtyp == 43) THEN
3528c-----------
3529 DO i=1,nel
3530 ii = 3*(i-1)
3531 DO ipt= 1,nptr
3532 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ipt,1,1)
3533 evar(3,i) = evar(3,i) + lbuf%EPE(jj(1) + i)/npt
3534 evar(2,i) = evar(2,i) + lbuf%EPE(jj(2) + i)/npt
3535 evar(1,i) = evar(1,i) + lbuf%EPE(jj(3) + i)/npt
3536 is_written_tensor(i) = 1
3537 ENDDO
3538 ENDDO
3539 DO i=1,nel
3540 n = i + nft
3541 CALL srota6(
3542 1 x, ixs(1,n), kcvt, evar(1,i),
3543 2 gama, jhbe, igtyp, isorth)
3544 ENDDO
3545c-----------
3546 ELSEIF (isolnod == 8 .AND. npt == 8 .AND. jhbe /= 14.AND.
3547 . jhbe /= 24.AND.jhbe /= 15.AND.jhbe /= 17 )THEN
3548c-----------
3549 nvaux =iparg(18,ng)
3550 IF (mlw>=28) THEN
3551 DO i=1,nel
3552 ii = 6*(i-1)
3553 n = i + nft
3554 DO j=1,8
3555 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,j)
3556 evar(1,i) = evar(1,i) + lbuf%STRA(jj(1) + i)*one_over_8
3557 evar(2,i) = evar(2,i) + lbuf%STRA(jj(2) + i)*one_over_8
3558 evar(3,i) = evar(3,i) + lbuf%STRA(jj(3) + i)*one_over_8
3559 evar(4,i) = evar(4,i) + lbuf%STRA(jj(4) + i)*one_over_8
3560 evar(5,i) = evar(5,i) + lbuf%STRA(jj(5) + i)*one_over_8
3561 evar(6,i) = evar(6,i) + lbuf%STRA(jj(6) + i)*one_over_8
3562 is_written_tensor(i) = 1
3563 ENDDO
3564 ENDDO
3565 ENDIF
3566c-----------
3567 ELSEIF ((isolnod==8.OR.(isolnod==4 .AND. (isrot==0.OR.isrot==3))).AND.
3568 . npt==1 .AND. jhbe /= 14 .AND. jhbe /= 15) THEN
3569c-----------
3570 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
3571 IF (isorth > 0) isorthg = 1
3572c
3573 IF (mlw>=28.AND.mlw /= 49) THEN
3574 DO i=1,nel
3575 n = i + nft
3576 ii = 6*(i-1)
3577 evar(1,i) = lbuf%STRA(jj(1) + i)
3578 evar(2,i) = lbuf%STRA(jj(2) + i)
3579 evar(3,i) = lbuf%STRA(jj(3) + i)
3580 evar(4,i) = lbuf%STRA(jj(4) + i)*half
3581 evar(5,i) = lbuf%STRA(jj(5) + i)*half
3582 evar(6,i) = lbuf%STRA(jj(6) + i)*half
3583 is_written_tensor(i) = 1
3584 ENDDO
3585 IF (isorth > 0) THEN
3586C STRAIN TENSOR IN GLOBAL SYSTEM
3587 kcvt = 2
3588 DO i=1,nel
3589 n = i + nft
3590 ii = 3*(i-1)
3591 gama(1) = gbuf%GAMA(jj(1) + i)
3592 gama(2) = gbuf%GAMA(jj(2) + i)
3593 gama(3) = gbuf%GAMA(jj(3) + i)
3594 gama(4) = gbuf%GAMA(jj(4) + i)
3595 gama(5) = gbuf%GAMA(jj(5) + i)
3596 gama(6) = gbuf%GAMA(jj(6) + i)
3597 CALL srota6(
3598 1 x, ixs(1,n), kcvt, evar(1,i),
3599 2 gama, jhbe, igtyp, isorth)
3600 ENDDO
3601 ENDIF
3602 ELSEIF (mlw == 12 .OR. mlw == 14)THEN
3603 DO i=1,nel
3604 n = i + nft
3605 ii = 3*(i-1)
3606 evar(1,i) = evar(1,i) + lbuf%EPE(jj(1) + i)
3607 evar(2,i) = evar(2,i) + lbuf%EPE(jj(2) + i)
3608 evar(3,i) = evar(3,i) + lbuf%EPE(jj(3) + i)
3609 is_written_tensor(i) = 1
3610 ENDDO
3611 ELSEIF (mlw == 24 .OR. mlw == 25)THEN
3612 DO i=1,nel
3613 n = i + nft
3614 ii = 6*(i-1)
3615 evar(1,i) = lbuf%STRA(jj(1) + i)
3616 evar(2,i) = lbuf%STRA(jj(2) + i)
3617 evar(3,i) = lbuf%STRA(jj(3) + i)
3618 evar(4,i) = lbuf%STRA(jj(4) + i)*half
3619 evar(5,i) = lbuf%STRA(jj(5) + i)*half
3620 evar(6,i) = lbuf%STRA(jj(6) + i)*half
3621 is_written_tensor(i) = 1
3622 ENDDO
3623 ELSEIF (istrain > 0) THEN
3624 IF (mlw /= 14.AND.mlw /= 24.AND.mlw<28.OR.
3625 . mlw == 49) THEN
3626 DO i=1,nel
3627 n = i + nft
3628 ii = 6*(i-1)
3629 evar(1,i) = lbuf%STRA(jj(1) + i)
3630 evar(2,i) = lbuf%STRA(jj(2) + i)
3631 evar(3,i) = lbuf%STRA(jj(3) + i)
3632 evar(4,i) = lbuf%STRA(jj(4) + i)*half
3633 evar(5,i) = lbuf%STRA(jj(5) + i)*half
3634 evar(6,i) = lbuf%STRA(jj(6) + i)*half
3635 is_written_tensor(i) = 1
3636 ENDDO
3637 ENDIF
3638 ENDIF
3639 IF (kcvt /= 0) THEN
3640C STRAIN TENSOR IN GLOBAL SYSTEM
3641 DO i=1,nel
3642 n = i + nft
3643 IF(kcvt==2)THEN
3644 ii = 6*(i-1)
3645 gama(1)=gbuf%GAMA(jj(1) + i)
3646 gama(2)=gbuf%GAMA(jj(2) + i)
3647 gama(3)=gbuf%GAMA(jj(3) + i)
3648 gama(4)=gbuf%GAMA(jj(4) + i)
3649 gama(5)=gbuf%GAMA(jj(5) + i)
3650 gama(6)=gbuf%GAMA(jj(6) + i)
3651 ELSE
3652 gama(1)=one
3653 gama(2)=zero
3654 gama(3)=zero
3655 gama(4)=zero
3656 gama(5)=one
3657 gama(6)=zero
3658 END IF
3659 CALL srota6(
3660 1 x, ixs(1,n), kcvt, evar(1,i),
3661 2 gama, jhbe, igtyp, isorth)
3662 ENDDO
3663 ENDIF
3664c-----------
3665 ELSEIF(isolnod == 16.OR.isolnod == 20 .OR.
3666 . (isolnod == 8.AND.(jhbe == 14.OR.jhbe == 17)))THEN
3667c-----------
3668 IF (mlw>=28.AND.mlw /= 49)THEN
3669 DO i=1,nel
3670 n = i + nft
3671 ii = 6*(i-1)
3672 DO il=1,nlay
3673 DO is=1,npts
3674 DO it=1,nptt
3675 DO ir=1,nptr
3676 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
3677 evar(1,i) = evar(1,i) + lbuf%STRA(jj(1) + i)/npt
3678 evar(2,i) = evar(2,i) + lbuf%STRA(jj(2) + i)/npt
3679 evar(3,i) = evar(3,i) + lbuf%STRA(jj(3) + i)/npt
3680 evar(4,i) = evar(4,i) + lbuf%STRA(jj(4) + i)*half/npt
3681 evar(5,i) = evar(5,i) + lbuf%STRA(jj(5) + i)*half/npt
3682 evar(6,i) = evar(6,i) + lbuf%STRA(jj(6) + i)*half/npt
3683 is_written_tensor(i) = 1
3684 ENDDO
3685 ENDDO
3686 ENDDO
3687 ENDDO
3688 ENDDO
3689 ELSEIF (mlw == 12 .OR. mlw == 14) THEN
3690 DO i=1,nel
3691 n = i + nft
3692 ii = 3*(i-1)
3693 DO il=1,nlay
3694 DO is=1,npts
3695 DO it=1,nptt
3696 DO ir=1,nptr
3697 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
3698 evar(1,i) = evar(1,i) + lbuf%EPE(jj(1) + i)/npt
3699 evar(2,i) = evar(2,i) + lbuf%EPE(jj(2) + i)/npt
3700 evar(3,i) = evar(3,i) + lbuf%EPE(jj(3) + i)/npt
3701 is_written_tensor(i) = 1
3702 ENDDO
3703 ENDDO
3704 ENDDO
3705 ENDDO
3706 ENDDO
3707 ELSEIF(mlw == 24 .OR. mlw == 25)THEN
3708 DO i=1,nel
3709 n = i + nft
3710 ii = 6*(i-1)
3711 DO il=1,nlay
3712 DO is=1,npts
3713 DO it=1,nptt
3714 DO ir=1,nptr
3715 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
3716 IF (elbuf_tab(ng)%BUFLY(il)%L_STRA > 0) THEN
3717 evar_tmp(1) = lbuf%STRA(jj(1) + i)/npt
3718 evar_tmp(2) = lbuf%STRA(jj(2) + i)/npt
3719 evar_tmp(3) = lbuf%STRA(jj(3) + i)/npt
3720 evar_tmp(4) = lbuf%STRA(jj(4) + i)*half/npt
3721 evar_tmp(5) = lbuf%STRA(jj(5) + i)*half/npt
3722 evar_tmp(6) = lbuf%STRA(jj(6) + i)*half/npt
3723 icsig=iparg(17,ng)
3724 IF (kcvt /= 0 .AND.icsig > 0) THEN
3725C STRAIN TENSOR IN GLOBAL SYSTEM
3726 IF (jhbe == 14) THEN
3727 SELECT CASE (icsig)
3728 CASE (1)
3729 IF(kcvt==2 .AND. igtyp ==22)THEN
3730 gama(1)= zero
3731 gama(2)= lbuf%GAMA(jj(1) + i)
3732 gama(3)= lbuf%GAMA(jj(2) + i)
3733 gama(4)= zero
3734 gama(5)=-gama(2)
3735 gama(6)= gama(1)
3736 ELSEIF(kcvt==2 .AND. igtyp ==21)THEN
3737 gama(1)= zero
3738 gama(2)= gbuf%GAMA(jj(1) + i)
3739 gama(3)= gbuf%GAMA(jj(2) + i)
3740 gama(4)= zero
3741 gama(5)=-gama(2)
3742 gama(6)= gama(1)
3743 ELSE
3744 gama(1)=one
3745 gama(2)=zero
3746 gama(3)=zero
3747 gama(4)=zero
3748 gama(5)=one
3749 gama(6)=zero
3750 END IF
3751 CALL srota6(
3752 1 x, ixs(1,n),kcvt, evar_tmp,
3753 2 gama, jhbe, igtyp, isorth)
3754 CASE (10)
3755 IF(kcvt==2 .AND. igtyp ==22)THEN
3756 gama(1)= lbuf%GAMA(jj(1) + i)
3757 gama(2)= lbuf%GAMA(jj(2) + i)
3758 gama(3)= zero
3759 gama(4)=-gama(2)
3760 gama(5)= gama(1)
3761 gama(6)= zero
3762 ELSEIF(kcvt==2 .AND. igtyp ==21)THEN
3763 gama(1)= gbuf%GAMA(jj(1) + i)
3764 gama(2)= gbuf%GAMA(jj(2) + i)
3765 gama(3)= zero
3766 gama(4)=-gama(2)
3767 gama(5)= gama(1)
3768 gama(6)= zero
3769 ELSE
3770 gama(1)=one
3771 gama(2)=zero
3772 gama(3)=zero
3773 gama(4)=zero
3774 gama(5)=one
3775 gama(6)=zero
3776 END IF
3777 CALL srota6(
3778 1 x, ixs(1,n),kcvt, evar_tmp,
3779 2 gama, jhbe, igtyp, isorth)
3780 CASE (100)
3781 IF(kcvt==2 .AND. igtyp ==22)THEN
3782 gama(1)= lbuf%GAMA(jj(2) + i)
3783 gama(2)= zero
3784 gama(3)= lbuf%GAMA(jj(1) + i)
3785 gama(4)= gama(3)
3786 gama(5)= zero
3787 gama(6)=-gama(1)
3788 ELSEIF(kcvt==2 .AND. igtyp ==21)THEN
3789 gama(1)= gbuf%GAMA(jj(2) + i)
3790 gama(2)= zero
3791 gama(3)= gbuf%GAMA(jj(1) + i)
3792 gama(4)= gama(3)
3793 gama(5)= zero
3794 gama(6)=-gama(1)
3795 ELSE
3796 gama(1)=one
3797 gama(2)=zero
3798 gama(3)=zero
3799 gama(4)=zero
3800 gama(5)=one
3801 gama(6)=zero
3802 END IF
3803 CALL srota6(
3804 1 x, ixs(1,n),kcvt, evar_tmp,
3805 2 gama, jhbe, igtyp, isorth)
3806 END SELECT
3807 ENDIF
3808 ENDIF
3809 evar(1,i) = evar(1,i)+evar_tmp(1)
3810 evar(2,i) = evar(2,i)+evar_tmp(2)
3811 evar(3,i) = evar(3,i)+evar_tmp(3)
3812 evar(4,i) = evar(4,i)+evar_tmp(4)
3813 evar(5,i) = evar(5,i)+evar_tmp(5)
3814 evar(6,i) = evar(6,i)+evar_tmp(6)
3815 is_written_tensor(i) = 1
3816 ENDIF
3817 ENDDO
3818 ENDDO
3819 ENDDO
3820 ENDDO
3821 ENDDO
3822 ELSEIF(istrain > 0)THEN
3823 IF (mlw /= 14.AND.mlw /= 24.AND.mlw<28)THEN
3824 DO i=1,nel
3825 n = i + nft
3826 ii = 6*(i-1)
3827 DO il=1,nlay
3828 DO is=1,npts
3829 DO it=1,nptt
3830 DO ir=1,nptr
3831 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
3832 evar_tmp(1) = lbuf%STRA(jj(1) + i)/npt
3833 evar_tmp(2) = lbuf%STRA(jj(2) + i)/npt
3834 evar_tmp(3) = lbuf%STRA(jj(3) + i)/npt
3835 evar_tmp(4) = lbuf%STRA(jj(4) + i)*half/npt
3836 evar_tmp(5) = lbuf%STRA(jj(5) + i)*half/npt
3837 evar_tmp(6) = lbuf%STRA(jj(6) + i)*half/npt
3838c
3839 icsig=iparg(17,ng)
3840 IF (kcvt /= 0 .AND.icsig > 0) THEN
3841C STRAIN TENSOR IN GLOBAL SYSTEM
3842 IF (jhbe == 14) THEN
3843 SELECT CASE (icsig)
3844 CASE (1)
3845 IF(kcvt==2.AND.igtyp == 22)THEN
3846 gama(1)= zero
3847 gama(2)= lbuf%GAMA(jj(1) + i)
3848 gama(3)= lbuf%GAMA(jj(2) + i)
3849 gama(4)= zero
3850 gama(5)=-gama(2)
3851 gama(6)= gama(1)
3852 ELSEIF(kcvt==2.AND.igtyp == 21)THEN
3853 gama(1)= zero
3854 gama(2)= gbuf%GAMA(jj(1) + i)
3855 gama(3)= gbuf%GAMA(jj(2) + i)
3856 gama(4)= zero
3857 gama(5)=-gama(2)
3858 gama(6)= gama(1)
3859 ELSE
3860 gama(1)=one
3861 gama(2)=zero
3862 gama(3)=zero
3863 gama(4)=zero
3864 gama(5)=one
3865 gama(6)=zero
3866 END IF
3867 CALL srota6(
3868 1 x, ixs(1,n),kcvt, evar_tmp,
3869 2 gama, jhbe, igtyp, isorth)
3870 CASE (10)
3871 IF(kcvt==2.AND.igtyp == 22)THEN
3872 gama(1)= lbuf%GAMA(jj(1) + i)
3873 gama(2)= lbuf%GAMA(jj(2) + i)
3874 gama(3)= zero
3875 gama(4)=-gama(2)
3876 gama(5)= gama(1)
3877 gama(6)= zero
3878 ELSEIF(kcvt==2.AND.igtyp == 21)THEN
3879 gama(1)= gbuf%GAMA(jj(1) + i)
3880 gama(2)= gbuf%GAMA(jj(2) + i)
3881 gama(3)= zero
3882 gama(4)=-gama(2)
3883 gama(5)= gama(1)
3884 gama(6)= zero
3885 ELSE
3886 gama(1)=one
3887 gama(2)=zero
3888 gama(3)=zero
3889 gama(4)=zero
3890 gama(5)=one
3891 gama(6)=zero
3892 END IF
3893 CALL srota6(
3894 1 x, ixs(1,n),kcvt, evar_tmp,
3895 2 gama, jhbe, igtyp, isorth)
3896 CASE (100)
3897 IF(kcvt==2.AND.igtyp == 22)THEN
3898 gama(1)= lbuf%GAMA(jj(2) + i)
3899 gama(2)= zero
3900 gama(3)= lbuf%GAMA(jj(1) + i)
3901 gama(4)= gama(3)
3902 gama(5)= zero
3903 gama(6)=-gama(1)
3904 ELSEIF(kcvt==2.AND.igtyp == 21)THEN
3905 gama(1)= gbuf%GAMA(jj(2) + i)
3906 gama(2)= zero
3907 gama(3)= gbuf%GAMA(jj(1) + i)
3908 gama(4)= gama(3)
3909 gama(5)= zero
3910 gama(6)=-gama(1)
3911 ELSE
3912 gama(1)=one
3913 gama(2)=zero
3914 gama(3)=zero
3915 gama(4)=zero
3916 gama(5)=one
3917 gama(6)=zero
3918 END IF
3919 CALL srota6(
3920 1 x, ixs(1,n),kcvt, evar_tmp,
3921 2 gama, jhbe, igtyp, isorth)
3922 END SELECT
3923 ENDIF
3924 ENDIF
3925 evar(1,i) = evar(1,i)+evar_tmp(1)
3926 evar(2,i) = evar(2,i)+evar_tmp(2)
3927 evar(3,i) = evar(3,i)+evar_tmp(3)
3928 evar(4,i) = evar(4,i)+evar_tmp(4)
3929 evar(5,i) = evar(5,i)+evar_tmp(5)
3930 evar(6,i) = evar(6,i)+evar_tmp(6)
3931 is_written_tensor(i) = 1
3932 ENDDO
3933 ENDDO
3934 ENDDO
3935 ENDDO
3936 ENDDO
3937 ENDIF
3938 ENDIF
3939c---
3940 icsig=iparg(17,ng)
3941 IF (kcvt /= 0 .AND.icsig == 0 .AND. jhbe /= 16) THEN
3942C STRAIN TENSOR IN GLOBAL SYSTEM
3943 DO i=1,nel
3944 n = i + nft
3945 IF(kcvt==2)THEN
3946 ii = 6*(i-1)
3947 gama(1)=gbuf%GAMA(jj(1) + i)
3948 gama(2)=gbuf%GAMA(jj(2) + i)
3949 gama(3)=gbuf%GAMA(jj(3) + i)
3950 gama(4)=gbuf%GAMA(jj(4) + i)
3951 gama(5)=gbuf%GAMA(jj(5) + i)
3952 gama(6)=gbuf%GAMA(jj(6) + i)
3953 ELSE
3954 gama(1)=one
3955 gama(2)=zero
3956 gama(3)=zero
3957 gama(4)=zero
3958 gama(5)=one
3959 gama(6)=zero
3960 END IF
3961 CALL srota6(
3962 1 x, ixs(1,n), kcvt, evar(1,i),
3963 2 gama, jhbe, igtyp, isorth)
3964 ENDDO
3965 ENDIF
3966c-----------
3967 ELSEIF (isolnod==10 .OR. (isolnod==4 .AND. isrot==1)) THEN
3968c-----------
3969 IF (mlw>=28.AND.mlw /= 49)THEN
3970 DO i=1,nel
3971 n = i + nft
3972 ii = 6*(i-1)
3973 DO ipt=1,npt
3974 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ipt,1,1)
3975 evar(1,i) = evar(1,i)+lbuf%STRA(jj(1) + i)/npt
3976 evar(2,i) = evar(2,i)+lbuf%STRA(jj(2) + i)/npt
3977 evar(3,i) = evar(3,i)+lbuf%STRA(jj(3) + i)/npt
3978 evar(4,i) = evar(4,i)+lbuf%STRA(jj(4) + i)*half/npt
3979 evar(5,i) = evar(5,i)+lbuf%STRA(jj(5) + i)*half/npt
3980 evar(6,i) = evar(6,i)+lbuf%STRA(jj(6) + i)*half/npt
3981 is_written_tensor(i) = 1
3982 ENDDO
3983 ENDDO
3984 ELSEIF(mlw == 12 .OR. mlw == 14)THEN
3985 DO i=1,nel
3986 n = i + nft
3987 ii = 3*(i-1)
3988 DO ipt=1,npt
3989 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ipt,1,1)
3990 evar(1,i) = evar(1,i) + lbuf%EPE(jj(1) + i)/npt
3991 evar(2,i) = evar(2,i) + lbuf%EPE(jj(2) + i)/npt
3992 evar(3,i) = evar(3,i) + lbuf%EPE(jj(3) + i)/npt
3993 is_written_tensor(i) = 1
3994 ENDDO
3995 ENDDO
3996 ELSEIF ((mlw == 24 .OR. mlw == 25) .and. istrain > 0) THEN
3997 DO i=1,nel
3998 n = i + nft
3999 ii = 6*(i-1)
4000 DO ipt=1,npt
4001 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ipt,1,1)
4002 evar(1,i) = evar(1,i)+lbuf%STRA(jj(1) + i)/npt
4003 evar(2,i) = evar(2,i)+lbuf%STRA(jj(2) + i)/npt
4004 evar(3,i) = evar(3,i)+lbuf%STRA(jj(3) + i)/npt
4005 evar(4,i) = evar(4,i)+lbuf%STRA(jj(4) + i)*half/npt
4006 evar(5,i) = evar(5,i)+lbuf%STRA(jj(5) + i)*half/npt
4007 evar(6,i) = evar(6,i)+lbuf%STRA(jj(6) + i)*half/npt
4008 is_written_tensor(i) = 1
4009 ENDDO
4010 ENDDO
4011 ELSEIF(istrain > 0)THEN
4012 IF (mlw /= 14.AND.mlw /= 24.AND.mlw<28) THEN
4013 DO i=1,nel
4014 n = i + nft
4015 ii = 6*(i-1)
4016 DO ipt=1,npt
4017 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ipt,1,1)
4018 evar(1,i) = evar(1,i)+lbuf%STRA(jj(1) + i)/npt
4019 evar(2,i) = evar(2,i)+lbuf%STRA(jj(2) + i)/npt
4020 evar(3,i) = evar(3,i)+lbuf%STRA(jj(3) + i)/npt
4021 evar(4,i) = evar(4,i)+lbuf%STRA(jj(4) + i)*half/npt
4022 evar(5,i) = evar(5,i)+lbuf%STRA(jj(5) + i)*half/npt
4023 evar(6,i) = evar(6,i)+lbuf%STRA(jj(6) + i)*half/npt
4024 is_written_tensor(i) = 1
4025 ENDDO
4026 ENDDO
4027 ENDIF
4028 ENDIF
4029 IF (kcvt /= 0) THEN
4030C STRAIN TENSOR IN GLOBAL SYSTEM
4031 DO i=1,nel
4032 n = i + nft
4033 IF (kcvt==2) THEN
4034 ii = 6*(i-1)
4035 gama(1)=gbuf%GAMA(jj(1) + i)
4036 gama(2)=gbuf%GAMA(jj(2) + i)
4037 gama(3)=gbuf%GAMA(jj(3) + i)
4038 gama(4)=gbuf%GAMA(jj(4) + i)
4039 gama(5)=gbuf%GAMA(jj(5) + i)
4040 gama(6)=gbuf%GAMA(jj(6) + i)
4041 ELSE
4042 gama(1)=one
4043 gama(2)=zero
4044 gama(3)=zero
4045 gama(4)=zero
4046 gama(5)=one
4047 gama(6)=zero
4048 ENDIF
4049 CALL srota6(
4050 1 x, ixs(1,n), kcvt, evar(1,i),
4051 2 gama, jhbe, igtyp, isorth)
4052 ENDDO
4053 ENDIF
4054c-----------
4055 ELSEIF((isolnod == 6.OR.isolnod == 8).AND.jhbe == 15)THEN
4056c-----------
4057 IF (mlw>=28.AND.mlw /= 49.AND.istrain > 0) THEN
4058 DO i=1,nel
4059 n = i + nft
4060 ii = 6*(i-1)
4061 DO il= 1,nlay
4062 DO ipt=1,nptg
4063 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ipt,1,1)
4064 evar(1,i) = evar(1,i)+lbuf%STRA(jj(1) + i)/(nptg*nlay)
4065 evar(2,i) = evar(2,i)+lbuf%STRA(jj(2) + i)/(nptg*nlay)
4066 evar(3,i) = evar(3,i)+lbuf%STRA(jj(3) + i)/(nptg*nlay)
4067 evar(4,i) = evar(4,i)+lbuf%STRA(jj(4) + i)*
4068 . half/(nptg*nlay)
4069 evar(5,i) = evar(5,i)+lbuf%STRA(jj(5) + i)*
4070 . half/(nptg*nlay)
4071 evar(6,i) = evar(6,i)+lbuf%STRA(jj(6) + i)*
4072 . half/(nptg*nlay)
4073 is_written_tensor(i) = 1
4074 ENDDO
4075 ENDDO
4076 ENDDO
4077 ELSEIF(mlw == 12 .OR. mlw == 14)THEN
4078 DO i=1,nel
4079 ii = 3*(i-1)
4080 DO il= 1,nlay
4081 DO ipt=1,nptg
4082 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ipt,1,1)
4083 evar(1,i) = evar(1,i) + lbuf%EPE(jj(1) + i)/(nptg*nlay)
4084 evar(2,i) = evar(2,i) + lbuf%EPE(jj(2) + i)/(nptg*nlay)
4085 evar(3,i) = evar(3,i) + lbuf%EPE(jj(3) + i)/(nptg*nlay)
4086 is_written_tensor(i) = 1
4087 ENDDO
4088 ENDDO
4089 ENDDO
4090 ELSEIF ((mlw == 24 .OR. mlw == 25) .and. istrain > 0)THEN
4091 DO i=1,nel
4092 n = i + nft
4093 ii = 6*(i-1)
4094 DO il= 1,nlay
4095 DO ipt=1,nptg
4096 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ipt,1,1)
4097 evar(1,i) = evar(1,i)+lbuf%STRA(jj(1) + i)/(nptg*nlay)
4098 evar(2,i) = evar(2,i)+lbuf%STRA(jj(2) + i)/(nptg*nlay)
4099 evar(3,i) = evar(3,i)+lbuf%STRA(jj(3) + i)/(nptg*nlay)
4100 evar(4,i) = evar(4,i)+lbuf%STRA(jj(4) + i)*
4101 . half/(nptg*nlay)
4102 evar(5,i) = evar(5,i)+lbuf%STRA(jj(5) + i)*
4103 . half/(nptg*nlay)
4104 evar(6,i) = evar(6,i)+lbuf%STRA(jj(6) + i)*
4105 . half/(nptg*nlay)
4106 is_written_tensor(i) = 1
4107 ENDDO
4108 ENDDO
4109 ENDDO
4110 ELSEIF (istrain > 0) THEN
4111 IF(mlw /= 14.AND.mlw /= 24.AND.mlw<28) THEN
4112 DO i=1,nel
4113 n = i + nft
4114 ii = 6*(i-1)
4115 DO il= 1,nlay
4116 DO ipt=1,nptg
4117 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ipt,1,1)
4118 evar(1,i) = evar(1,i)+lbuf%STRA(jj(1) + i)/(nptg*nlay)
4119 evar(2,i) = evar(2,i)+lbuf%STRA(jj(2) + i)/(nptg*nlay)
4120 evar(3,i) = evar(3,i)+lbuf%STRA(jj(3) + i)/(nptg*nlay)
4121 evar(4,i) = evar(4,i)+lbuf%STRA(jj(4) + i)*
4122 . half/(nptg*nlay)
4123 evar(5,i) = evar(5,i)+lbuf%STRA(jj(5) + i)*
4124 . half/(nptg*nlay)
4125 evar(6,i) = evar(6,i)+lbuf%STRA(jj(6) + i)*
4126 . half/(nptg*nlay)
4127 is_written_tensor(i) = 1
4128 ENDDO
4129 ENDDO
4130 ENDDO
4131 ENDIF
4132 ENDIF
4133 IF (kcvt /= 0) THEN
4134C STRAIN TENSOR IN GLOBAL SYSTEM
4135 DO i=1,nel
4136 n = i + nft
4137 IF (kcvt==2)THEN
4138 ii = 6*(i-1)
4139 gama(1)= gbuf%GAMA(jj(1) + i)
4140 gama(2)= gbuf%GAMA(jj(2) + i)
4141 gama(3)= zero
4142 gama(4)=-gama(2)
4143 gama(5)= gama(1)
4144 gama(6)= zero
4145 ELSE
4146 gama(1)=one
4147 gama(2)=zero
4148 gama(3)=zero
4149 gama(4)=zero
4150 gama(5)=one
4151 gama(6)=zero
4152 END IF
4153 CALL srota6(
4154 1 x, ixs(1,n), kcvt, evar(1,i),
4155 2 gama, jhbe, igtyp, isorth)
4156 ENDDO
4157 ENDIF
4158c-----------
4159 ENDIF ! ISOLNOD & ......
4160C---- Corner Data :
4161 CALL strn_tenscor3(elbuf_tab(ng),iparg(1,ng),ixs ,ixs10 ,x ,
4162 . pm ,kcvt ,nel ,evar_corner )
4163 IF (isolnod <= 10) is_written_tensor(1:nel) = 1
4164C--------------------------------------------------
4165c back stress tensor
4166C--------------------------------------------------
4167 ELSEIF (keyword == 'TENS/BSTRESS') THEN
4168C--------------------------------------------------
4169c ILAYER=NULL IR=NULL IS=NULL IT=NULL
4170C--------------------------------------------------
4171 IF( ilay == -1 .AND. ir == -1 .AND. is == -1 .AND. it == -1 )THEN ! mean values since II not precised
4172 ! not for thick shells
4173 !--------
4174 ! LAW36
4175 !--------
4176 IF(mlw == 36 .AND. ( id == -1 .OR. id == 1)) THEN
4177 DO i=1,nel
4178 DO ir=1,nptr
4179 DO is=1,npts
4180 DO it=1,nptt
4181 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ir,is,it)
4182 evar(1,i) = evar(1,i) + lbuf%SIGB(jj(1) + i)/nptg
4183 evar(2,i) = evar(2,i) + lbuf%SIGB(jj(2) + i)/nptg
4184 evar(3,i) = evar(3,i) + lbuf%SIGB(jj(3) + i)/nptg
4185 evar(4,i) = evar(4,i) + lbuf%SIGB(jj(4) + i)/nptg
4186 evar(5,i) = evar(5,i) + lbuf%SIGB(jj(5) + i)/nptg
4187 evar(6,i) = evar(6,i) + lbuf%SIGB(jj(6) + i)/nptg
4188 ENDDO !IT
4189 ENDDO !IS
4190 ENDDO !IR
4191 ENDDO
4192 !!IF (KCVT /= 0 .AND. JHBE /= 16) THEN ????
4193 !--------
4194 ! LAW78
4195 !--------
4196 ELSEIF (mlw == 78) THEN
4197 IF(id == -1) THEN ! sum of all backstresses
4198 DO i=1,nel
4199 DO ir=1,nptr
4200 DO is=1,npts
4201 DO it=1,nptt
4202 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ir,is,it)
4203 evar(1,i) = evar(1,i) +( lbuf%SIGA(jj(1) + i) + lbuf%SIGB(jj(1) + i) )/nptg
4204 evar(2,i) = evar(2,i) +( lbuf%SIGA(jj(2) + i) + lbuf%SIGB(jj(2) + i) )/nptg
4205 evar(3,i) = evar(3,i) +( lbuf%SIGA(jj(3) + i) + lbuf%SIGB(jj(3) + i) )/nptg
4206 evar(4,i) = evar(4,i) +( lbuf%SIGA(jj(4) + i) + lbuf%SIGB(jj(4) + i) )/nptg
4207 evar(5,i) = evar(5,i) +( lbuf%SIGA(jj(5) + i) + lbuf%SIGB(jj(5) + i) )/nptg
4208 evar(6,i) = evar(6,i) +( lbuf%SIGA(jj(6) + i) + lbuf%SIGB(jj(6) + i) )/nptg
4209 ENDDO !IT
4210 ENDDO !IS
4211 ENDDO !IR
4212 ENDDO
4213
4214 ELSEIF(id ==1 ) THEN
4215 DO i=1,nel
4216 DO ir=1,nptr
4217 DO is=1,npts
4218 DO it=1,nptt
4219 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ir,is,it)
4220 evar(1,i) = evar(1,i) + lbuf%SIGA(jj(1) + i) /nptg
4221 evar(2,i) = evar(2,i) + lbuf%SIGA(jj(2) + i) /nptg
4222 evar(3,i) = evar(3,i) + lbuf%SIGA(jj(3) + i) /nptg
4223 evar(4,i) = evar(4,i) + lbuf%SIGA(jj(4) + i) /nptg
4224 evar(5,i) = evar(5,i) + lbuf%SIGA(jj(5) + i) /nptg
4225 evar(6,i) = evar(6,i) + lbuf%SIGA(jj(6) + i) /nptg
4226 ENDDO !IT
4227 ENDDO !IS
4228 ENDDO !IR
4229 ENDDO
4230
4231 ELSEIF(id ==2 ) THEN
4232 DO i=1,nel
4233 DO ir=1,nptr
4234 DO is=1,npts
4235 DO it=1,nptt
4236 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ir,is,it)
4237 evar(1,i) = evar(1,i) + lbuf%SIGB(jj(1) + i) /nptg
4238 evar(2,i) = evar(2,i) + lbuf%SIGB(jj(2) + i) /nptg
4239 evar(3,i) = evar(3,i) + lbuf%SIGB(jj(3) + i) /nptg
4240 evar(4,i) = evar(4,i) + lbuf%SIGB(jj(4) + i) /nptg
4241 evar(5,i) = evar(5,i) + lbuf%SIGB(jj(5) + i) /nptg
4242 evar(6,i) = evar(6,i) + lbuf%SIGB(jj(6) + i) /nptg
4243 ENDDO !IT
4244 ENDDO !IS
4245 ENDDO !IR
4246 ENDDO
4247 ELSEIF(id ==3 ) THEN
4248 DO i=1,nel
4249 DO ir=1,nptr
4250 DO is=1,npts
4251 DO it=1,nptt
4252 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ir,is,it)
4253 evar(1,i) = evar(1,i) + lbuf%SIGC(jj(1) + i) /nptg
4254 evar(2,i) = evar(2,i) + lbuf%SIGC(jj(2) + i) /nptg
4255 evar(3,i) = evar(3,i) + lbuf%SIGC(jj(3) + i) /nptg
4256 evar(4,i) = evar(4,i) + lbuf%SIGC(jj(4) + i) /nptg
4257 evar(5,i) = evar(5,i) + lbuf%SIGC(jj(5) + i) /nptg
4258 evar(6,i) = evar(6,i) + lbuf%SIGC(jj(6) + i) /nptg
4259 ENDDO !IT
4260 ENDDO !is
4261 ENDDO !IR
4262 ENDDO
4263 ENDIF !ID == -1
4264 ENDIF !(MLW ==
4265C--------------------------------------------
4266c IR= IS= IT =
4267C--------------------------------------------------
4268 ELSEIF ( ilay == -1 .AND. ir > 0 .AND. ir <= nptr .AND.
4269 . is > 0 .AND. is <= npts .AND.
4270 . it > 0 .AND. it <= nptt) THEN
4271
4272 DO i=1,nel
4273 evar(1,i) = zero
4274 evar(2,i) = zero
4275 evar(3,i) = zero
4276 evar(4,i) = zero
4277 evar(5,i) = zero
4278 evar(6,i) = zero
4279 ENDDO
4280 IF(isolnod == 10.OR.(isolnod == 4 .AND. isrot == 1))THEN
4281 ipt = 0
4282 IF (ir == 1 .AND. is == 1 .AND. it == 1) ipt = 1
4283 IF (ir == 2 .AND. is == 1 .AND. it == 1) ipt = 2
4284 IF (ir == 1 .AND. is == 2 .AND. it == 1) ipt = 3
4285 IF (ir == 1 .AND. is == 1 .AND. it == 2) ipt = 4
4286 IF (ipt > 0) lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ipt,1,1)
4287 ELSEIF (isolnod == 8 .AND. (jhbe == 14.OR.jhbe == 17) )THEN !idem stress
4288 icsig = iparg(17,ng)
4289 nptg = nptr * npts * nptt * nlay
4290 ipid = ixs(10,1 + nft)
4291 IF (ior_tsh >0) THEN
4292 IF (icsig == 10) THEN
4293 ir=it_input
4294 is=ir_input
4295 it=is_input
4296 ELSEIF (icsig == 1) THEN
4297 ir=is_input
4298 is=it_input
4299 it=ir_input
4300 ELSE
4301 ir=ir_input
4302 is=is_input
4303 it=it_input
4304 ENDIF
4305 ENDIF
4306 ipt = ir + ( (is-1) + (it-1)*npts )*nptr
4307 IF(ir <= nptr .AND. is <= npts .AND. it <= nptt) THEN
4308 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ir,is,it)
4309 ELSE
4310 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
4311 ENDIF
4312 ELSE
4313 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ir,is,it)
4314 ENDIF !ISOLNOD
4315 !--------
4316 ! LAW36
4317 !--------
4318 IF(mlw == 36 .AND. ( id == -1 .OR. id == 1)) THEN
4319 DO i=1,nel
4320 evar(1,i) = lbuf%SIGB(jj(1) + i)
4321 evar(2,i) = lbuf%SIGB(jj(2) + i)
4322 evar(3,i) = lbuf%SIGB(jj(3) + i)
4323 evar(4,i) = lbuf%SIGB(jj(4) + i)
4324 evar(5,i) = lbuf%SIGB(jj(5) + i)
4325 evar(6,i) = lbuf%SIGB(jj(6) + i)
4326 is_written_tensor(i) = 1
4327 ENDDO
4328 !--------
4329 ! LAW78
4330 !--------
4331 ELSEIF (mlw == 78) THEN
4332 IF(id == -1) THEN ! somme of all backstresses
4333 DO i=1,nel
4334 evar(1,i) = ( lbuf%SIGA(jj(1) + i) + lbuf%SIGB(jj(1) + i) )
4335 evar(2,i) = ( lbuf%SIGA(jj(2) + i) + lbuf%SIGB(jj(2) + i) )
4336 evar(3,i) = ( lbuf%SIGA(jj(3) + i) + lbuf%SIGB(jj(3) + i) )
4337 evar(4,i) = ( lbuf%SIGA(jj(4) + i) + lbuf%SIGB(jj(4) + i) )
4338 evar(5,i) = ( lbuf%SIGA(jj(5) + i) + lbuf%SIGB(jj(5) + i) )
4339 evar(6,i) = ( lbuf%SIGA(jj(6) + i) + lbuf%SIGB(jj(6) + i) )
4340 is_written_tensor(i) = 1
4341 ENDDO
4342 ELSEIF(id ==1 ) THEN
4343 DO i=1,nel
4344 evar(1,i) = lbuf%SIGA(jj(1) + i)
4345 evar(2,i) = lbuf%SIGA(jj(2) + i)
4346 evar(3,i) = lbuf%SIGA(jj(3) + i)
4347 evar(4,i) = lbuf%SIGA(jj(4) + i)
4348 evar(5,i) = lbuf%SIGA(jj(5) + i)
4349 evar(6,i) = lbuf%SIGA(jj(6) + i)
4350 is_written_tensor(i) = 1
4351 ENDDO
4352 ELSEIF(id ==2 ) THEN
4353 DO i=1,nel
4354 evar(1,i) = lbuf%SIGB(jj(1) + i)
4355 evar(2,i) = lbuf%SIGB(jj(2) + i)
4356 evar(3,i) = lbuf%SIGB(jj(3) + i)
4357 evar(4,i) = lbuf%SIGB(jj(4) + i)
4358 evar(5,i) = lbuf%SIGB(jj(5) + i)
4359 evar(6,i) = lbuf%SIGB(jj(6) + i)
4360 is_written_tensor(i) = 1
4361 ENDDO
4362 ELSEIF(id ==3 ) THEN
4363 DO i=1,nel
4364 evar(1,i) = lbuf%SIGC(jj(1) + i)
4365 evar(2,i) = lbuf%SIGC(jj(2) + i)
4366 evar(3,i) = lbuf%SIGC(jj(3) + i)
4367 evar(4,i) = lbuf%SIGC(jj(4) + i)
4368 evar(5,i) = lbuf%SIGC(jj(5) + i)
4369 evar(6,i) = lbuf%SIGC(jj(6) + i)
4370 is_written_tensor(i) = 1
4371 ENDDO
4372 ENDIF !ID == -1
4373 ENDIF !(MLW ==
4374C--------------------------------------------------
4375CiLAY = ir= is=
4376C--------------------------------------------------
4377 ELSEIF ( ilay > 0 .AND. ilay <= nlay .AND.
4378 . ir > 0 .AND. ir <= nptr .AND.
4379 . is > 0 .AND. is <= npts) THEN
4380C--------------------------------------------------
4381 evar(1:6,1:nel) = zero
4382 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,1)
4383 IF (tshell == 1 ) THEN
4384 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,is,1)
4385 IF (isolnod == 16) lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(ir,1,it) !!
4386 ENDIF
4387c-----------
4388 !--------
4389 ! LAW36
4390 !--------
4391 IF(mlw == 36 .AND. ( id == -1 .OR. id == 1)) THEN
4392 DO i=1,nel
4393 evar(1,i) = lbuf%SIGB(jj(1) + i)
4394 evar(2,i) = lbuf%SIGB(jj(2) + i)
4395 evar(3,i) = lbuf%SIGB(jj(3) + i)
4396 evar(4,i) = lbuf%SIGB(jj(4) + i)
4397 evar(5,i) = lbuf%SIGB(jj(5) + i)
4398 evar(6,i) = lbuf%SIGB(jj(6) + i)
4399 is_written_tensor(i) = 1
4400 ENDDO
4401 !--------
4402 ! LAW78
4403 !--------
4404 ELSEIF (mlw == 78) THEN
4405 IF(id == -1) THEN ! somme of all backstresses
4406 DO i=1,nel
4407 evar(1,i) = ( lbuf%SIGA(jj(1) + i) + lbuf%SIGB(jj(1) + i) )
4408 evar(2,i) = ( lbuf%SIGA(jj(2) + i) + lbuf%SIGB(jj(2) + i) )
4409 evar(3,i) = ( lbuf%SIGA(jj(3) + i) + lbuf%SIGB(jj(3) + i) )
4410 evar(4,i) = ( lbuf%SIGA(jj(4) + i) + lbuf%SIGB(jj(4) + i) )
4411 evar(5,i) = ( lbuf%SIGA(jj(5) + i) + lbuf%SIGB(jj(5) + i) )
4412 evar(6,i) = ( lbuf%SIGA(jj(6) + i) + lbuf%SIGB(jj(6) + i) )
4413 is_written_tensor(i) = 1
4414 ENDDO
4415 ELSEIF(id ==1 ) THEN
4416 DO i=1,nel
4417 evar(1,i) = lbuf%SIGA(jj(1) + i)
4418 evar(2,i) = lbuf%SIGA(jj(2) + i)
4419 evar(3,i) = lbuf%SIGA(jj(3) + i)
4420 evar(4,i) = lbuf%SIGA(jj(4) + i)
4421 evar(5,i) = lbuf%SIGA(jj(5) + i)
4422 evar(6,i) = lbuf%SIGA(jj(6) + i)
4423 is_written_tensor(i) = 1
4424 ENDDO
4425 ELSEIF(id ==2 ) THEN
4426 DO i=1,nel
4427 evar(1,i) = lbuf%SIGB(jj(1) + i)
4428 evar(2,i) = lbuf%SIGB(jj(2) + i)
4429 evar(3,i) = lbuf%SIGB(jj(3) + i)
4430 evar(4,i) = lbuf%SIGB(jj(4) + i)
4431 evar(5,i) = lbuf%SIGB(jj(5) + i)
4432 evar(6,i) = lbuf%SIGB(jj(6) + i)
4433 is_written_tensor(i) = 1
4434 ENDDO
4435 ELSEIF(id ==3 ) THEN
4436 DO i=1,nel
4437 evar(1,i) = lbuf%SIGC(jj(1) + i)
4438 evar(2,i) = lbuf%SIGC(jj(2) + i)
4439 evar(3,i) = lbuf%SIGC(jj(3) + i)
4440 evar(4,i) = lbuf%SIGC(jj(4) + i)
4441 evar(5,i) = lbuf%SIGC(jj(5) + i)
4442 evar(6,i) = lbuf%SIGC(jj(6) + i)
4443 is_written_tensor(i) = 1
4444 ENDDO
4445 ENDIF !ID == -1
4446 ENDIF !(MLW ==
4447
4448c-----------
4449c ILAY=
4450c-----------
4451 ELSEIF ( ilay >= 0 .AND. ilay <= nlay) THEN
4452c-----------
4453 evar(1:6,1:nel) = zero
4454 IF((isolnod == 6.OR.isolnod == 8).AND.jhbe == 15)THEN
4455 ipt = is
4456 IF ( ilay <= npt) THEN
4457 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(1,1,1)
4458 IF(mlw == 36 .AND. ( id == -1 .OR. id == 1)) THEN
4459 DO i=1,nel
4460 evar(1,i) = lbuf%SIGB(jj(1) + i)
4461 evar(2,i) = lbuf%SIGB(jj(2) + i)
4462 evar(3,i) = lbuf%SIGB(jj(3) + i)
4463 evar(4,i) = lbuf%SIGB(jj(4) + i)
4464 evar(5,i) = lbuf%SIGB(jj(5) + i)
4465 evar(6,i) = lbuf%SIGB(jj(6) + i)
4466 is_written_tensor(i) = 1
4467 ENDDO
4468 !--------
4469 ! LAW78
4470 !--------
4471 ELSEIF (mlw == 78) THEN
4472 IF(id == -1) THEN ! somme of all backstresses
4473 DO i=1,nel
4474 evar(1,i) = ( lbuf%SIGA(jj(1) + i) + lbuf%SIGB(jj(1) + i) )
4475 evar(2,i) = ( lbuf%SIGA(jj(2) + i) + lbuf%SIGB(jj(2) + i) )
4476 evar(3,i) = ( lbuf%SIGA(jj(3) + i) + lbuf%SIGB(jj(3) + i) )
4477 evar(4,i) = ( lbuf%SIGA(jj(4) + i) + lbuf%SIGB(jj(4) + i) )
4478 evar(5,i) = ( lbuf%SIGA(jj(5) + i) + lbuf%SIGB(jj(5) + i) )
4479 evar(6,i) = ( lbuf%SIGA(jj(6) + i) + lbuf%SIGB(jj(6) + i) )
4480 is_written_tensor(i) = 1
4481 ENDDO
4482 ELSEIF(id ==1 ) THEN
4483 DO i=1,nel
4484 evar(1,i) = lbuf%SIGA(jj(1) + i)
4485 evar(2,i) = lbuf%SIGA(jj(2) + i)
4486 evar(3,i) = lbuf%SIGA(jj(3) + i)
4487 evar(4,i) = lbuf%SIGA(jj(4) + i)
4488 evar(5,i) = lbuf%SIGA(jj(5) + i)
4489 evar(6,i) = lbuf%SIGA(jj(6) + i)
4490 is_written_tensor(i) = 1
4491 ENDDO
4492
4493 ELSEIF(id ==2 ) THEN
4494 DO i=1,nel
4495 evar(1,i) = lbuf%SIGB(jj(1) + i)
4496 evar(2,i) = lbuf%SIGB(jj(2) + i)
4497 evar(3,i) = lbuf%SIGB(jj(3) + i)
4498 evar(4,i) = lbuf%SIGB(jj(4) + i)
4499 evar(5,i) = lbuf%SIGB(jj(5) + i)
4500 evar(6,i) = lbuf%SIGB(jj(6) + i)
4501 is_written_tensor(i) = 1
4502 ENDDO
4503 ELSEIF(id ==3 ) THEN
4504 DO i=1,nel
4505 evar(1,i) = lbuf%SIGC(jj(1) + i)
4506 evar(2,i) = lbuf%SIGC(jj(2) + i)
4507 evar(3,i) = lbuf%SIGC(jj(3) + i)
4508 evar(4,i) = lbuf%SIGC(jj(4) + i)
4509 evar(5,i) = lbuf%SIGC(jj(5) + i)
4510 evar(6,i) = lbuf%SIGC(jj(6) + i)
4511 is_written_tensor(i) = 1
4512 ENDDO
4513 ENDIF !ID == -1
4514 ENDIF !(MLW ==
4515
4516 ENDIF !( ILAY <= NPT)
4517 endif!((ISOLNOD == 6.OR.ISOLNOD == 8).AND.JHBE == 15)
4518 END IF
4519c ........
4520C-----------------------------------------------
4521 ELSEIF (keyword == 'TENS/STRESS/TMAX') THEN
4522C-----------------------------------------------
4523 DO i=1,nel
4524 evar(1:6,i) = gbuf%TM_SIG1(jj(1:6) + i)
4525 is_written_tensor(i) = 1
4526 ENDDO
4527C-----------------------------------------------
4528 ELSEIF (keyword == 'TENS/STRESS/TMIN') THEN
4529C-----------------------------------------------
4530 DO i=1,nel
4531 evar(1:6,i) = gbuf%TM_SIG3(jj(1:6) + i)
4532 is_written_tensor(i) = 1
4533 ENDDO
4534C-----------------------------------------------
4535 ELSEIF (keyword == 'TENS/STRAIN/TMAX') THEN
4536C-----------------------------------------------
4537 DO i=1,nel
4538 evar(1:6,i) = gbuf%TM_STRA1(jj(1:6) + i)
4539 is_written_tensor(i) = 1
4540 ENDDO
4541C-----------------------------------------------
4542 ELSEIF (keyword == 'TENS/STRAIN/TMIN') THEN
4543C-----------------------------------------------
4544 DO i=1,nel
4545 evar(1:6,i) = gbuf%TM_STRA3(jj(1:6) + i)
4546 is_written_tensor(i) = 1
4547 ENDDO
4548 ELSE
4549C-----------------------------------------------
4550C
4551C-----------------------------------------------
4552 DO i=1,nel
4553 n = i + nft
4554 evar(1,i) = zero
4555 evar(2,i) = zero
4556 evar(3,i) = zero
4557 evar(4,i) = zero
4558 evar(5,i) = zero
4559 evar(6,i) = zero
4560 ENDDO
4561 ENDIF
4562
4563 CALL h3d_write_tensor(iok_part,is_written_solid,solid_tensor,nel,0,nft,
4564 . evar,is_written_tensor)
4565
4566 IF (is_corner_data == 1)CALL h3d_write_tensor_corner(iok_part,is_written_solid,
4567 . solid_tensor_corner,nel,0,nft,evar_corner,maxnnod,is_written_tensor)
4568C
4569c-----------
4570 isorthg = isorth ! pour precaution
4571C-----------------------------------------------
4572 ELSE
4573c
4574 ENDIF
4575C
4576 ENDIF ! mlw /= 13
4577C-----------
4578 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
s6_tstrain
subroutine s6_tstrain(xn, yn, zn, dx, dy, dz, strain, nel)
Definition h3d_solid_tensor_1.F:4764
s8_tstrain
subroutine s8_tstrain(xn, yn, zn, dx, dy, dz, strain, nel)
Definition h3d_solid_tensor_1.F:4666
t4_tstrain
subroutine t4_tstrain(xn, yn, zn, dx, dy, dz, strain, nel)
Definition h3d_solid_tensor_1.F:4589
strn_tenscor3
subroutine strn_tenscor3(elbuf_tab, iparg, ixs, ixs10, x, pm, kcvt, nel, evar)
Definition h3d_strn_tenscor3.F:36
h3d_write_tensor
subroutine h3d_write_tensor(iok_part, is_written, tensor, nel, offset, nft, value, is_written_tensor)
Definition h3d_write_tensor.F:35
h3d_write_tensor_corner
subroutine h3d_write_tensor_corner(iok_part, is_written, tensor_corner, nel, offset, nft, value, nnod, is_written_tensor)
Definition h3d_write_tensor_corner.F:31
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
id
initmumps id
Definition multiplerhs_example.m:4
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
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::ncharline100
integer, parameter ncharline100
Definition names_and_titles_mod.F:1002
schlieren_mod
Definition schlieren_mod.F:46
stack_mod
Definition stack_mod.F:72
srota6
subroutine srota6(x, ixs, kcvt, tens, gama)
Definition srota6.F:32
strs_tenscor3
subroutine strs_tenscor3(elbuf_tab, iparg, ixs, ixs10, x, pm, kcvt, nel, evar)
Definition strs_tenscor3.F:36

◆ s6_tstrain()

subroutine s6_tstrain ( xn,
yn,
zn,
dx,
dy,
dz,
strain,
integer nel )

Definition at line 4763 of file h3d_solid_tensor_1.F.

4764C---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
4765#include "implicit_f.inc"
4766C---------+---------+---+---+--------------------------------------------
4767C VAR | SIZE |TYP| RW| DEFINITION
4768C---------+---------+---+---+--------------------------------------------
4769C NEL | 1 | I | R | SIZE OF THE ELEMENT GROUP NEL
4770C XN | 6*NEL | R | R | X-coordinate ARRAY (6n Penta)
4771C YN | 6*NEL | R | R | Y-coordinate ARRAY (6n Penta)
4772C ZN | 6*NEL | R | R | Z-coordinate ARRAY (6n Penta)
4773C DX | 6*NEL | R | R | X-Displ ARRAY (6n Penta)
4774C DY | 6*NEL | R | R | Y-Displ ARRAY (6n Penta)
4775C DZ | 6*NEL | R | R | D-Displ ARRAY (6n Penta)
4776C STRAIN | 6*NEL | R | W | STRAIN ARRAY
4777C---------+---------+---+---+--------------------------------------------
4778C-----------------------------------------------
4779C D U M M Y A R G U M E N T S
4780C-----------------------------------------------
4781 INTEGER NEL
4782 my_real
4783 . xn(nel,6) , yn(nel,6) , zn(nel,6),
4784 . dx(nel,6) , dy(nel,6) , dz(nel,6),strain(6,*)
4785C-----------------------------------------------
4786C L O C A L V A R I A B L E S
4787C-----------------------------------------------
4788 INTEGER I,J,NNOD
4789 parameter(nnod = 6)
4790 my_real
4791 . x0n(nel,nnod) , y0n(nel,nnod) , z0n(nel,nnod),
4792 . px1(nel), px2(nel), px3(nel), px4(nel),
4793 . py1(nel), py2(nel), py3(nel), py4(nel),
4794 . pz1(nel), pz2(nel), pz3(nel), pz4(nel),
4795 . vol(nel),f(3,3,nel)
4796 my_real
4797 . vx14, vy14, vz14,
4798 . vx25, vy25, vz25,
4799 . vx36, vy36, vz36,
4800 . vxhi, vyhi, vzhi
4801C----------------------------------------------
4802C------initial configuration :
4803 DO i=1,nel
4804 x0n(i,1:nnod) = xn(i,1:nnod)-dx(i,1:nnod)
4805 y0n(i,1:nnod) = yn(i,1:nnod)-dy(i,1:nnod)
4806 z0n(i,1:nnod) = zn(i,1:nnod)-dz(i,1:nnod)
4807 END DO
4808 CALL t6deri3(
4809 . x0n(1,1),x0n(1,2),x0n(1,3),x0n(1,4),x0n(1,5),x0n(1,6),
4810 . y0n(1,1),y0n(1,2),y0n(1,3),y0n(1,4),y0n(1,5),y0n(1,6),
4811 . z0n(1,1),z0n(1,2),z0n(1,3),z0n(1,4),z0n(1,5),z0n(1,6),
4812 . px1, px2, px3, px4,
4813 . py1, py2, py3, py4,
4814 . pz1, pz2, pz3, pz4,
4815 . vol ,nel )
4816C---------------
4817C MEMBRANE [F]-[1]
4818C---------------
4819 DO i=1,nel
4820 vx14=dx(i,1)+dx(i,4)
4821 vx25=dx(i,2)+dx(i,5)
4822 vx36=dx(i,3)+dx(i,6)
4823 vxhi=dx(i,4)+dx(i,5)+dx(i,6)-dx(i,1)-dx(i,2)-dx(i,3)
4824 vy14=dy(i,1)+dy(i,4)
4825 vy25=dy(i,2)+dy(i,5)
4826 vy36=dy(i,3)+dy(i,6)
4827 vyhi=dy(i,4)+dy(i,5)+dy(i,6)-dy(i,1)-dy(i,2)-dy(i,3)
4828 vz14=dz(i,1)+dz(i,4)
4829 vz25=dz(i,2)+dz(i,5)
4830 vz36=dz(i,3)+dz(i,6)
4831 vzhi=dz(i,4)+dz(i,5)+dz(i,6)-dz(i,1)-dz(i,2)-dz(i,3)
4832C
4833 f(1,1,i)=px1(i)*vx14+px2(i)*vx25+px3(i)*vx36+px4(i)*vxhi
4834 f(2,2,i)=py1(i)*vy14+py2(i)*vy25+py3(i)*vy36+py4(i)*vyhi
4835 f(3,3,i)=pz1(i)*vz14+pz2(i)*vz25+pz3(i)*vz36+pz4(i)*vzhi
4836 f(1,2,i)=py1(i)*vx14+py2(i)*vx25+py3(i)*vx36+py4(i)*vxhi
4837 f(1,3,i)=pz1(i)*vx14+pz2(i)*vx25+pz3(i)*vx36+pz4(i)*vxhi
4838 f(2,1,i)=px1(i)*vy14+px2(i)*vy25+px3(i)*vy36+px4(i)*vyhi
4839 f(2,3,i)=pz1(i)*vy14+pz2(i)*vy25+pz3(i)*vy36+pz4(i)*vyhi
4840 f(3,1,i)=px1(i)*vz14+px2(i)*vz25+px3(i)*vz36+px4(i)*vzhi
4841 f(3,2,i)=py1(i)*vz14+py2(i)*vz25+py3(i)*vz36+py4(i)*vzhi
4842 END DO
4843C---------------
4844C MEMBRANE [e]=[U]-1
4845C---------------
4846 CALL u_from_f3(f,strain,nel)
4847C
4848 RETURN
t6deri3
subroutine t6deri3(x1, x2, x3, x4, x5, x6, y1, y2, y3, y4, y5, y6, z1, z2, z3, z4, z5, z6, px1, px2, px3, px4, py1, py2, py3, py4, pz1, pz2, pz3, pz4, det, nel)
Definition h3d_solid_tensor_1.F:5079
u_from_f3
subroutine u_from_f3(f, strain, nel)
Definition h3d_solid_tensor_1.F:5178

◆ s8_tstrain()

subroutine s8_tstrain ( xn,
yn,
zn,
dx,
dy,
dz,
strain,
integer nel )

Definition at line 4665 of file h3d_solid_tensor_1.F.

4666C---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
4667#include "implicit_f.inc"
4668C---------+---------+---+---+--------------------------------------------
4669C VAR | SIZE |TYP| RW| DEFINITION
4670C---------+---------+---+---+--------------------------------------------
4671C NEL | 1 | I | R | SIZE OF THE ELEMENT GROUP NEL
4672C XN | 8*NEL | R | R | X-coordinate ARRAY (8n Hexa)
4673C YN | 8*NEL | R | R | Y-coordinate ARRAY (8n Hexa)
4674C ZN | 8*NEL | R | R | Z-coordinate ARRAY (8n Hexa)
4675C DX | 8*NEL | R | R | X-Displ ARRAY (8n Hexa)
4676C DY | 8*NEL | R | R | Y-Displ ARRAY (8n Hexa)
4677C DZ | 8*NEL | R | R | D-Displ ARRAY (8n Hexa)
4678C STRAIN | 6*NEL | R | W | STRAIN ARRAY
4679C---------+---------+---+---+--------------------------------------------
4680C-----------------------------------------------
4681C D U M M Y A R G U M E N T S
4682C-----------------------------------------------
4683 INTEGER NEL
4684 my_real
4685 . xn(nel,8) , yn(nel,8) , zn(nel,8),
4686 . dx(nel,8) , dy(nel,8) , dz(nel,8),strain(6,*)
4687C-----------------------------------------------
4688C L O C A L V A R I A B L E S
4689C-----------------------------------------------
4690 INTEGER I,J,NNOD
4691 parameter(nnod = 8)
4692 my_real
4693 . x0n(nel,nnod) , y0n(nel,nnod) , z0n(nel,nnod),
4694 . px1(nel), px2(nel), px3(nel), px4(nel),
4695 . py1(nel), py2(nel), py3(nel), py4(nel),
4696 . pz1(nel), pz2(nel), pz3(nel), pz4(nel),
4697 . vol(nel),f(3,3,nel),
4698 . vx17, vy17, vz17,
4699 . vx28, vy28, vz28,
4700 . vx35, vy35, vz35,
4701 . vx46, vy46, vz46
4702C----------------------------------------------
4703C------initial configuration :
4704 DO i=1,nel
4705 x0n(i,1:nnod) = xn(i,1:nnod)-dx(i,1:nnod)
4706 y0n(i,1:nnod) = yn(i,1:nnod)-dy(i,1:nnod)
4707 z0n(i,1:nnod) = zn(i,1:nnod)-dz(i,1:nnod)
4708 END DO
4709 CALL t8deri3(
4710 . x0n(1,1),x0n(1,2),x0n(1,3),x0n(1,4),
4711 . x0n(1,5),x0n(1,6),x0n(1,7),x0n(1,8),
4712 . y0n(1,1),y0n(1,2),y0n(1,3),y0n(1,4),
4713 . y0n(1,5),y0n(1,6),y0n(1,7),y0n(1,8),
4714 . z0n(1,1),z0n(1,2),z0n(1,3),z0n(1,4),
4715 . z0n(1,5),z0n(1,6),z0n(1,7),z0n(1,8),
4716 . px1, px2, px3, px4,
4717 . py1, py2, py3, py4,
4718 . pz1, pz2, pz3, pz4,
4719 . vol ,nel )
4720C---------------
4721C MEMBRANE [F]-[1]
4722C---------------
4723 DO i=1,nel
4724 vx17=dx(i,1)-dx(i,7)
4725 vx28=dx(i,2)-dx(i,8)
4726 vx35=dx(i,3)-dx(i,5)
4727 vx46=dx(i,4)-dx(i,6)
4728 vy17=dy(i,1)-dy(i,7)
4729 vy28=dy(i,2)-dy(i,8)
4730 vy35=dy(i,3)-dy(i,5)
4731 vy46=dy(i,4)-dy(i,6)
4732 vz17=dz(i,1)-dz(i,7)
4733 vz28=dz(i,2)-dz(i,8)
4734 vz35=dz(i,3)-dz(i,5)
4735 vz46=dz(i,4)-dz(i,6)
4736C
4737 f(1,1,i)=px1(i)*vx17+px2(i)*vx28+px3(i)*vx35+px4(i)*vx46
4738 f(2,2,i)=py1(i)*vy17+py2(i)*vy28+py3(i)*vy35+py4(i)*vy46
4739 f(3,3,i)=pz1(i)*vz17+pz2(i)*vz28+pz3(i)*vz35+pz4(i)*vz46
4740 f(1,2,i)=py1(i)*vx17+py2(i)*vx28+py3(i)*vx35+py4(i)*vx46
4741 f(1,3,i)=pz1(i)*vx17+pz2(i)*vx28+pz3(i)*vx35+pz4(i)*vx46
4742 f(2,1,i)=px1(i)*vy17+px2(i)*vy28+px3(i)*vy35+px4(i)*vy46
4743 f(2,3,i)=pz1(i)*vy17+pz2(i)*vy28+pz3(i)*vy35+pz4(i)*vy46
4744 f(3,1,i)=px1(i)*vz17+px2(i)*vz28+px3(i)*vz35+px4(i)*vz46
4745 f(3,2,i)=py1(i)*vz17+py2(i)*vz28+py3(i)*vz35+py4(i)*vz46
4746
4747 END DO
4748C---------------
4749C MEMBRANE [e]=[U]-1
4750C---------------
4751 CALL u_from_f3(f,strain,nel)
4752C
4753 RETURN
t8deri3
subroutine t8deri3(x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, px1, px2, px3, px4, py1, py2, py3, py4, pz1, pz2, pz3, pz4, det, nel)
Definition h3d_solid_tensor_1.F:4951

◆ t4_tstrain()

subroutine t4_tstrain ( xn,
yn,
zn,
dx,
dy,
dz,
strain,
integer nel )

Definition at line 4588 of file h3d_solid_tensor_1.F.

4589C---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
4590#include "implicit_f.inc"
4591C---------+---------+---+---+--------------------------------------------
4592C VAR | SIZE |TYP| RW| DEFINITION
4593C---------+---------+---+---+--------------------------------------------
4594C NEL | 1 | I | R | SIZE OF THE ELEMENT GROUP NEL
4595C XN | 4*NEL | R | R | X-coordinate ARRAY (4n tetra)
4596C YN | 4*NEL | R | R | Y-coordinate ARRAY (4n tetra)
4597C ZN | 4*NEL | R | R | Z-coordinate ARRAY (4n tetra)
4598C DX | 4*NEL | R | R | X-Displ ARRAY (4n tetra)
4599C DY | 4*NEL | R | R | Y-Displ ARRAY (4n tetra)
4600C DZ | 4*NEL | R | R | D-Displ ARRAY (4n tetra)
4601C STRAIN | 6*NEL | R | W | STRAIN ARRAY
4602C---------+---------+---+---+--------------------------------------------
4603C-----------------------------------------------
4604C D U M M Y A R G U M E N T S
4605C-----------------------------------------------
4606 INTEGER NEL
4607 my_real
4608 . xn(nel,4) , yn(nel,4) , zn(nel,4),
4609 . dx(nel,4) , dy(nel,4) , dz(nel,4),strain(6,*)
4610C-----------------------------------------------
4611C L O C A L V A R I A B L E S
4612C-----------------------------------------------
4613 INTEGER I,J,NNOD
4614 parameter(nnod = 4)
4615 my_real
4616 . x0n(nel,nnod) , y0n(nel,nnod) , z0n(nel,nnod),
4617 . px1(nel), px2(nel), px3(nel), px4(nel),
4618 . py1(nel), py2(nel), py3(nel), py4(nel),
4619 . pz1(nel), pz2(nel), pz3(nel), pz4(nel),
4620 . vol(nel),f(3,3,nel)
4621C----------------------------------------------
4622C------initial configuration :
4623 DO i=1,nel
4624 x0n(i,1:nnod) = xn(i,1:nnod)-dx(i,1:nnod)
4625 y0n(i,1:nnod) = yn(i,1:nnod)-dy(i,1:nnod)
4626 z0n(i,1:nnod) = zn(i,1:nnod)-dz(i,1:nnod)
4627 END DO
4628 CALL t4deri3(
4629 . x0n(1,1),x0n(1,2),x0n(1,3),x0n(1,4),
4630 . y0n(1,1),y0n(1,2),y0n(1,3),y0n(1,4),
4631 . z0n(1,1),z0n(1,2),z0n(1,3),z0n(1,4),
4632 . px1, px2, px3, px4,
4633 . py1, py2, py3, py4,
4634 . pz1, pz2, pz3, pz4,
4635 . vol ,nel )
4636C---------------
4637C MEMBRANE [F]-1
4638C---------------
4639 DO i=1,nel
4640 f(1,1,i)=px1(i)*dx(i,1)+px2(i)*dx(i,2)+px3(i)*dx(i,3)+px4(i)*dx(i,4)
4641 f(2,2,i)=py1(i)*dy(i,1)+py2(i)*dy(i,2)+py3(i)*dy(i,3)+py4(i)*dy(i,4)
4642 f(3,3,i)=pz1(i)*dz(i,1)+pz2(i)*dz(i,2)+pz3(i)*dz(i,3)+pz4(i)*dz(i,4)
4643 f(1,2,i)=py1(i)*dx(i,1)+py2(i)*dx(i,2)+py3(i)*dx(i,3)+py4(i)*dx(i,4)
4644 f(1,3,i)=pz1(i)*dx(i,1)+pz2(i)*dx(i,2)+pz3(i)*dx(i,3)+pz4(i)*dx(i,4)
4645 f(2,1,i)=px1(i)*dy(i,1)+px2(i)*dy(i,2)+px3(i)*dy(i,3)+px4(i)*dy(i,4)
4646 f(2,3,i)=pz1(i)*dy(i,1)+pz2(i)*dy(i,2)+pz3(i)*dy(i,3)+pz4(i)*dy(i,4)
4647 f(3,1,i)=px1(i)*dz(i,1)+px2(i)*dz(i,2)+px3(i)*dz(i,3)+px4(i)*dz(i,4)
4648 f(3,2,i)=py1(i)*dz(i,1)+py2(i)*dz(i,2)+py3(i)*dz(i,3)+py4(i)*dz(i,4)
4649 END DO
4650C---------------
4651C MEMBRANE [e]=[U]-1
4652C---------------
4653 CALL u_from_f3(f,strain,nel)
4654C
4655 RETURN
t4deri3
subroutine t4deri3(x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, px1, px2, px3, px4, py1, py2, py3, py4, pz1, pz2, pz3, pz4, det, nel)
Definition h3d_solid_tensor_1.F:4860

◆ t4deri3()

subroutine t4deri3 ( x1,
x2,
x3,
x4,
y1,
y2,
y3,
y4,
z1,
z2,
z3,
z4,
px1,
px2,
px3,
px4,
py1,
py2,
py3,
py4,
pz1,
pz2,
pz3,
pz4,
det,
integer nel )

Definition at line 4855 of file h3d_solid_tensor_1.F.

4860C-----------------------------------------------
4861C I m p l i c i t T y p e s
4862C-----------------------------------------------
4863#include "implicit_f.inc"
4864C-----------------------------------------------
4865C D u m m y A r g u m e n t s
4866C-----------------------------------------------
4867 INTEGER NEL
4868 my_real
4869 . x1(*), x2(*), x3(*), x4(*),
4870 . y1(*), y2(*), y3(*), y4(*),
4871 . z1(*), z2(*), z3(*), z4(*)
4872
4873 my_real
4874 . px1(*), px2(*), px3(*), px4(*),
4875 . py1(*), py2(*), py3(*), py4(*),
4876 . pz1(*), pz2(*), pz3(*), pz4(*),det(*)
4877C-----------------------------------------------
4878C L o c a l V a r i a b l e s
4879C-----------------------------------------------
4880C REAL
4881 INTEGER I
4882 my_real
4883 . x41, y41, z41, x42, y42, z42, x43, y43, z43,
4884 . a1, a2, a3, a4, d, areamx2,
4885 . b1(nel), b2(nel), b3(nel), b4(nel),
4886 . c1(nel), c2(nel), c3(nel), c4(nel),
4887 . d1(nel), d2(nel), d3(nel), d4(nel)
4888C-----------------------------------------------
4889C
4890 DO i=1,nel
4891 x43 = x4(i) - x3(i)
4892 y43 = y4(i) - y3(i)
4893 z43 = z4(i) - z3(i)
4894 x41 = x4(i) - x1(i)
4895 y41 = y4(i) - y1(i)
4896 z41 = z4(i) - z1(i)
4897 x42 = x4(i) - x2(i)
4898 y42 = y4(i) - y2(i)
4899 z42 = z4(i) - z2(i)
4900C
4901 b1(i) = y43*z42 - y42*z43
4902 b2(i) = y41*z43 - y43*z41
4903 b3(i) = y42*z41 - y41*z42
4904 b4(i) = -(b1(i) + b2(i) + b3(i))
4905C
4906 c1(i) = z43*x42 - z42*x43
4907 c2(i) = z41*x43 - z43*x41
4908 c3(i) = z42*x41 - z41*x42
4909 c4(i) = -(c1(i) + c2(i) + c3(i))
4910C
4911 d1(i) = x43*y42 - x42*y43
4912 d2(i) = x41*y43 - x43*y41
4913 d3(i) = x42*y41 - x41*y42
4914 d4(i) = -(d1(i) + d2(i) + d3(i))
4915C----------SIX = 6.
4916 det(i) = (x41*b1(i) + y41*c1(i) + z41*d1(i))/six
4917C
4918 ENDDO
4919C
4920 DO i=1,nel
4921 d = one/det(i)/six
4922 px1(i)=-b1(i)*d
4923 py1(i)=-c1(i)*d
4924 pz1(i)=-d1(i)*d
4925 px2(i)=-b2(i)*d
4926 py2(i)=-c2(i)*d
4927 pz2(i)=-d2(i)*d
4928 px3(i)=-b3(i)*d
4929 py3(i)=-c3(i)*d
4930 pz3(i)=-d3(i)*d
4931 px4(i)=-b4(i)*d
4932 py4(i)=-c4(i)*d
4933 pz4(i)=-d4(i)*d
4934 END DO
4935C
4936 RETURN

◆ t6deri3()

subroutine t6deri3 ( x1,
x2,
x3,
x4,
x5,
x6,
y1,
y2,
y3,
y4,
y5,
y6,
z1,
z2,
z3,
z4,
z5,
z6,
px1,
px2,
px3,
px4,
py1,
py2,
py3,
py4,
pz1,
pz2,
pz3,
pz4,
det,
integer nel )

Definition at line 5071 of file h3d_solid_tensor_1.F.

5079C-----------------------------------------------
5080C I m p l i c i t T y p e s
5081C-----------------------------------------------
5082#include "implicit_f.inc"
5083C-----------------------------------------------
5084C D u m m y A r g u m e n t s
5085C-----------------------------------------------
5086 INTEGER NEL
5087 my_real
5088 . x1(*), x2(*), x3(*), x4(*), x5(*), x6(*),
5089 . y1(*), y2(*), y3(*), y4(*), y5(*), y6(*),
5090 . z1(*), z2(*), z3(*), z4(*), z5(*), z6(*)
5091
5092 my_real
5093 . px1(*), px2(*), px3(*), px4(*),
5094 . py1(*), py2(*), py3(*), py4(*),
5095 . pz1(*), pz2(*), pz3(*), pz4(*),det(*)
5096C-----------------------------------------------
5097C L o c a l V a r i a b l e s
5098C-----------------------------------------------
5099 INTEGER I, J
5100C REAL
5101 my_real
5102 . dett , aj1(nel), aj2(nel) ,aj3(nel),
5103 . aj4(nel) , aj5(nel), aj6(nel),
5104 . aj7(nel) , aj8(nel), aj9(nel),
5105 . aji1, aji2, aji3,
5106 . aji4, aji5, aji6,
5107 . aji7, aji8, aji9,
5108 . jac_59_68, jac_67_49, jac_48_57,
5109 . aj12, aj45, aj78,
5110 . fac
5111C-----------------------------------------------
5112C
5113 DO i=1,nel
5114 aj1(i)=x2(i)-x1(i)+x5(i)-x4(i)
5115 aj2(i)=y2(i)-y1(i)+y5(i)-y4(i)
5116 aj3(i)=z2(i)-z1(i)+z5(i)-z4(i)
5117 aj4(i)=x3(i)-x1(i)+x6(i)-x4(i)
5118 aj5(i)=y3(i)-y1(i)+y6(i)-y4(i)
5119 aj6(i)=z3(i)-z1(i)+z6(i)-z4(i)
5120 aj7(i)=third*(x4(i)-x1(i)+x5(i)-x2(i)+x6(i)-x3(i))
5121 aj8(i)=third*(y4(i)-y1(i)+y5(i)-y2(i)+y6(i)-y3(i))
5122 aj9(i)=third*(z4(i)-z1(i)+z5(i)-z2(i)+z6(i)-z3(i))
5123 END DO
5124C
5125 DO i=1,nel
5126 jac_59_68=aj5(i)*aj9(i)-aj6(i)*aj8(i)
5127 jac_67_49=aj6(i)*aj7(i)-aj4(i)*aj9(i)
5128 jac_48_57=aj4(i)*aj8(i)-aj5(i)*aj7(i)
5129 det(i)=aj1(i)*jac_59_68+aj2(i)*jac_67_49+aj3(i)*jac_48_57
5130 END DO
5131C
5132 DO i=1,nel
5133 dett=1.0/det(i)
5134C
5135C INVERSE DE LA MATRICE JACOBIENNE
5136C
5137 aji1=dett*jac_59_68
5138 aji4=dett*jac_67_49
5139 aji7=dett*jac_48_57
5140 aji2=dett*(-aj2(i)*aj9(i)+aj3(i)*aj8(i))
5141 aji5=dett*(aj1(i)*aj9(i)-aj3(i)*aj7(i))
5142 aji8=dett*(-aj1(i)*aj8(i)+aj2(i)*aj7(i))
5143 aji3=dett*( aj2(i)*aj6(i)-aj3(i)*aj5(i))
5144 aji6=dett*(-aj1(i)*aj6(i)+aj3(i)*aj4(i))
5145 aji9=dett*(aj1(i)*aj5(i)-aj2(i)*aj4(i))
5146C
5147 aj12=aji1+aji2
5148 aj45=aji4+aji5
5149 aj78=aji7+aji8
5150C
5151C ----------symtrie(a b c a b c)->P1-P3,anti-symtrie(-1 -1 -1 1 1 1)->P4
5152 px1(i)=-aj12
5153 py1(i)=-aj45
5154 pz1(i)=-aj78
5155 px2(i)=aji1
5156 py2(i)=aji4
5157 pz2(i)=aji7
5158 px3(i)=aji2
5159 py3(i)=aji5
5160 pz3(i)=aji8
5161 px4(i)=third*aji3
5162 py4(i)=third*aji6
5163 pz4(i)=third*aji9
5164 END DO
5165C
5166 RETURN

◆ t8deri3()

subroutine t8deri3 ( x1,
x2,
x3,
x4,
x5,
x6,
x7,
x8,
y1,
y2,
y3,
y4,
y5,
y6,
y7,
y8,
z1,
z2,
z3,
z4,
z5,
z6,
z7,
z8,
px1,
px2,
px3,
px4,
py1,
py2,
py3,
py4,
pz1,
pz2,
pz3,
pz4,
det,
integer nel )

Definition at line 4943 of file h3d_solid_tensor_1.F.

4951C-----------------------------------------------
4952C I m p l i c i t T y p e s
4953C-----------------------------------------------
4954#include "implicit_f.inc"
4955C-----------------------------------------------
4956C D u m m y A r g u m e n t s
4957C-----------------------------------------------
4958 INTEGER NEL
4959 my_real
4960 . x1(*), x2(*), x3(*), x4(*), x5(*), x6(*), x7(*), x8(*),
4961 . y1(*), y2(*), y3(*), y4(*), y5(*), y6(*), y7(*), y8(*),
4962 . z1(*), z2(*), z3(*), z4(*), z5(*), z6(*), z7(*), z8(*)
4963
4964 my_real
4965 . px1(*), px2(*), px3(*), px4(*),
4966 . py1(*), py2(*), py3(*), py4(*),
4967 . pz1(*), pz2(*), pz3(*), pz4(*),det(*)
4968C-----------------------------------------------
4969C L o c a l V a r i a b l e s
4970C-----------------------------------------------
4971 INTEGER I, J
4972C REAL
4973 my_real
4974 . aj1(nel),aj2(nel),aj3(nel),
4975 . aj4(nel),aj5(nel),aj6(nel),
4976 . dett , aj7(nel), aj8(nel) , aj9(nel),
4977 . aji1, aji2, aji3,
4978 . aji4, aji5, aji6,
4979 . aji7, aji8, aji9,
4980 . jac_59_68, jac_67_49, jac_48_57,
4981 . aj12, aj45, aj78,
4982 . a17 , a28 ,
4983 . b17 , b28 ,
4984 . c17 , c28 ,
4985 . x17 , x28 , x35 , x46,
4986 . y17 , y28 , y35 , y46,
4987 . z17 , z28 , z35 , z46
4988C-----------------------------------------------
4989C
4990 DO i=1,nel
4991 x17=x7(i)-x1(i)
4992 x28=x8(i)-x2(i)
4993 x35=x5(i)-x3(i)
4994 x46=x6(i)-x4(i)
4995 y17=y7(i)-y1(i)
4996 y28=y8(i)-y2(i)
4997 y35=y5(i)-y3(i)
4998 y46=y6(i)-y4(i)
4999 z17=z7(i)-z1(i)
5000 z28=z8(i)-z2(i)
5001 z35=z5(i)-z3(i)
5002 z46=z6(i)-z4(i)
5003c
5004 aj1(i)=x17+x28-x35-x46
5005 aj2(i)=y17+y28-y35-y46
5006 aj3(i)=z17+z28-z35-z46
5007 a17=x17+x46
5008 a28=x28+x35
5009 b17=y17+y46
5010 b28=y28+y35
5011 c17=z17+z46
5012 c28=z28+z35
5013
5014 aj4(i)=a17+a28
5015 aj5(i)=b17+b28
5016 aj6(i)=c17+c28
5017 aj7(i)=a17-a28
5018 aj8(i)=b17-b28
5019 aj9(i)=c17-c28
5020 ENDDO
5021C
5022C JACOBIAN
5023C
5024 DO i=1,nel
5025 jac_59_68=aj5(i)*aj9(i)-aj6(i)*aj8(i)
5026 jac_67_49=aj6(i)*aj7(i)-aj4(i)*aj9(i)
5027 jac_48_57=aj4(i)*aj8(i)-aj5(i)*aj7(i)
5028 det(i)=aj1(i)*jac_59_68+aj2(i)*jac_67_49+aj3(i)*jac_48_57
5029C DET(I)=ONE_OVER_64*(AJ1(I)*JAC_59_68+AJ2(I)*JAC_67_49+AJ3(I)*JAC_48_57)
5030 dett=1.0/det(i)
5031C INVERSE DE LA MATRICE JACOBIENNE
5032 aji1=dett*jac_59_68
5033 aji4=dett*jac_67_49
5034 aji7=dett*jac_48_57
5035 aji2=dett*(-aj2(i)*aj9(i)+aj3(i)*aj8(i))
5036 aji5=dett*( aj1(i)*aj9(i)-aj3(i)*aj7(i))
5037 aji8=dett*(-aj1(i)*aj8(i)+aj2(i)*aj7(i))
5038 aji3=dett*( aj2(i)*aj6(i)-aj3(i)*aj5(i))
5039 aji6=dett*(-aj1(i)*aj6(i)+aj3(i)*aj4(i))
5040 aji9=dett*( aj1(i)*aj5(i)-aj2(i)*aj4(i))
5041C
5042 aj12=aji1-aji2
5043 aj45=aji4-aji5
5044 aj78=aji7-aji8
5045 px3(i)= aj12+aji3
5046 py3(i)= aj45+aji6
5047 pz3(i)= aj78+aji9
5048 px4(i)= aj12-aji3
5049 py4(i)= aj45-aji6
5050 pz4(i)= aj78-aji9
5051!
5052 aj12=aji1+aji2
5053 aj45=aji4+aji5
5054 aj78=aji7+aji8
5055!
5056 px1(i)=-aj12-aji3
5057 py1(i)=-aj45-aji6
5058 pz1(i)=-aj78-aji9
5059 px2(i)=-aj12+aji3
5060 py2(i)=-aj45+aji6
5061 pz2(i)=-aj78+aji9
5062 ENDDO
5063C
5064 RETURN

◆ u_from_f3()

subroutine u_from_f3 ( f,
strain,
integer nel )

Definition at line 5177 of file h3d_solid_tensor_1.F.

5178C-----------------------------------------------
5179C I m p l i c i t T y p e s
5180C-----------------------------------------------
5181#include "implicit_f.inc"
5182C-----------------------------------------------
5183C C o m m o n B l o c k s
5184C-----------------------------------------------
5185#include "mvsiz_p.inc"
5186C-----------------------------------------------
5187C D u m m y A r g u m e n t s
5188C-----------------------------------------------
5189 INTEGER NEL
5190 my_real
5191 . f(3,3,nel), strain(6,*)
5192C-----------------------------------------------
5193C L o c a l V a r i a b l e s
5194C-----------------------------------------------
5195 INTEGER I,J
5196 my_real
5197 . es1(mvsiz), es2(mvsiz), es3(mvsiz),
5198 . es4(mvsiz), es5(mvsiz), es6(mvsiz),
5199 . sv(3),ev(mvsiz,3),dirprv(mvsiz,3,3)
5200C-----------------------------------------------
5201 DO i=1,nel
5202 es1(i)=f(1,1,i)*(two+f(1,1,i))+f(1,2,i)*f(1,2,i)+f(1,3,i)*f(1,3,i)
5203 es2(i)=f(2,2,i)*(two+f(2,2,i))+f(2,1,i)*f(2,1,i)+f(2,3,i)*f(2,3,i)
5204 es3(i)=f(3,3,i)*(two+f(3,3,i))+f(3,1,i)*f(3,1,i)+f(3,2,i)*f(3,2,i)
5205 es4(i)=f(1,2,i)+f(2,1,i)+f(1,1,i)*f(2,1,i)+f(1,2,i)*f(2,2,i)+f(1,3,i)*f(2,3,i)
5206 es6(i)=f(1,3,i)+f(3,1,i)+f(1,1,i)*f(3,1,i)+f(1,2,i)*f(3,2,i)+f(1,3,i)*f(3,3,i)
5207 es5(i)=f(3,2,i)+f(2,3,i)+f(3,1,i)*f(2,1,i)+f(3,2,i)*f(2,2,i)+f(3,3,i)*f(2,3,i)
5208 ENDDO
5209 CALL princ_u1(
5210 1 nel ,es1 ,es2 ,es3 ,es4 ,
5211 2 es5 ,es6 ,ev ,dirprv )
5212C
5213 DO i=1,nel
5214 strain(1,i)= dirprv(i,1,1)*dirprv(i,1,1)*ev(i,1)
5215 . + dirprv(i,1,2)*dirprv(i,1,2)*ev(i,2)
5216 . + dirprv(i,1,3)*dirprv(i,1,3)*ev(i,3)
5217 strain(2,i)= dirprv(i,2,2)*dirprv(i,2,2)*ev(i,2)
5218 . + dirprv(i,2,3)*dirprv(i,2,3)*ev(i,3)
5219 . + dirprv(i,2,1)*dirprv(i,2,1)*ev(i,1)
5220 strain(3,i)= dirprv(i,3,3)*dirprv(i,3,3)*ev(i,3)
5221 . + dirprv(i,3,1)*dirprv(i,3,1)*ev(i,1)
5222 . + dirprv(i,3,2)*dirprv(i,3,2)*ev(i,2)
5223 strain(4,i)= dirprv(i,1,1)*dirprv(i,2,1)*ev(i,1)
5224 . + dirprv(i,1,2)*dirprv(i,2,2)*ev(i,2)
5225 . + dirprv(i,1,3)*dirprv(i,2,3)*ev(i,3)
5226 strain(5,i)= dirprv(i,2,2)*dirprv(i,3,2)*ev(i,2)
5227 . + dirprv(i,2,3)*dirprv(i,3,3)*ev(i,3)
5228 . + dirprv(i,2,1)*dirprv(i,3,1)*ev(i,1)
5229 strain(6,i)= dirprv(i,3,3)*dirprv(i,1,3)*ev(i,3)
5230 . + dirprv(i,3,1)*dirprv(i,1,1)*ev(i,1)
5231 . + dirprv(i,3,2)*dirprv(i,1,2)*ev(i,2)
5232 ENDDO
5233C
5234 RETURN
princ_u1
subroutine princ_u1(nel, es1, es2, es3, es4, es5, es6, ev, dirprv)
Definition princ_u1.F:34