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

Go to the source code of this file.

Functions/Subroutines

subroutine thsol (elbuf_tab, nthgrp2, ithgrp, iparg, ithbuf, wa, ixs, x, ipm, pm, igeo, multi_fvm, v, w, itherm, numels, nummat, numgeo, numnod, sithbuf)

Function/Subroutine Documentation

◆ thsol()

subroutine thsol ( type (elbuf_struct_), dimension(ngroup), target elbuf_tab,
integer, intent(in) nthgrp2,
integer, dimension(nithgr,*), intent(in) ithgrp,
integer, dimension(nparg,ngroup), intent(in) iparg,
integer, dimension(sithbuf), intent(in) ithbuf,
dimension(*), intent(inout) wa,
integer, dimension(nixs,numels), intent(in) ixs,
dimension(3,numnod), intent(in) x,
integer, dimension(npropmi,nummat), intent(in) ipm,
dimension(npropm,nummat), intent(in) pm,
integer, dimension(npropgi,numgeo), intent(in) igeo,
type(multi_fvm_struct), intent(in) multi_fvm,
v,
w,
integer, intent(in) itherm,
integer, intent(in) numels,
integer, intent(in) nummat,
integer, intent(in) numgeo,
integer, intent(in) numnod,
integer, intent(in) sithbuf )

Definition at line 39 of file thsol.F.

44C-----------------------------------------------
45C D e s c r i p t i o n
46C-----------------------------------------------
47C
48C /TH/BRIC : BUFFER FOR TIME HISTORY OUTPUT
49C
50C This subroutine is writing buffer related to /TH/BRIC option in
51C order to be written in Time History files : T01, T02, etc...
52C Each channel (index) is standing for a given physical quantity as desbibed below
53C Time History file is requested with Engine option /TFILE
54C
55C-------------------------
56C CHANNEL KEY DESCRIPTION [MAT LAW]
57C
58C 1 OFF
59C 2 SX SIGX
60C 3 SY SIGY
61C 4 SZ SIGZ
62C 5 SXY SIGXY
63C 6 SYZ SIGYZ
64C 7 SXZ SIGZX
65C 8 IE INTERNAL ENERGIE / VOLUME0
66C 9 DENS DENSITY
67C 10 BULK BULK VISCOSITY
68C 11 VOL VOLUME (ALE) OR INITIAL VOLUME (LAG)
69C 12 PLAS EPS PLASTIQUE [2,3,4,7,8,9,16,22,23,26,33-38]
70C 13 TEMP TEMPERATURE [4,6,7,8,9,11,16,17,26,33-38]
71C 14 PLSR STRAIN RATE [4,7,8,9,16,26,33-38]
72C 15 DAMA1 DAMAGE 1 [14]
73C 16 DAMA2 DAMAGE 2 [14]
74C 17 DAMA3 DAMAGE 3 [14]
75C 18 DAMA4 DAMAGE 4 [14]
76C 19 DAMA DAMAGE [24]
77C 20(14) SA1 STRESS RE1 [24]
78C 21(15) SA2 STRESS RE2 [24]
79C 22(16) SA3 STRESS RE3 [24]
80C 23(17) CR CRACKS VOL [24]
81C 24(18) CAP CAP PARAM [24] (ROB)
82C 25(13) K0 HARD. PARAM [24]
83C 26(12) RK TURBUL. ENER. [6,11,17] ,VK [24]
84C 27(14) TD TURBUL. DISS. [6,11,17]
85C 28(14) EFIB FIBER STRAIN [14]
86C 29(16) ISTA PHASE STATE [16]
87C 30(12) VPLA VOL. EPS PLA. [10,21]
88C 31(12) BFRAC BURN FRACTION [5,41,51,97,151]
89C 32(12) WPLA PLAS. WORK [14]
90C 35 LSX SIGMA-X IN LOCAL SYSTEM (ONLY 8-NODES BRICKS)
91C 36 LSY SIGMA-Y IN LOCAL SYSTEM (ONLY 8-NODES BRICKS)
92C 37 LSZ SIGMA-Z IN LOCAL SYSTEM (ONLY 8-NODES BRICKS)
93C 38 LSXY SIGMA-XY IN LOCAL SYSTEM (ONLY 8-NODES BRICKS)
94C 39 LSYZ SIGMA-YZ IN LOCAL SYSTEM (ONLY 8-NODES BRICKS)
95C 40 LSXZ SIGMA-XZ IN LOCAL SYSTEM (ONLY 8-NODES BRICKS)
96C ...
97C 137 UVAR User variables
98C ...
99C 239547 VX X-VELOCITY (MEAN VALUE FOR STAGGERED SCHEME, CELL VALUE FOR COLOCATED SCHEME)
100C 239548 VY Y-VELOCITY (MEAN VALUE FOR STAGGERED SCHEME, CELL VALUE FOR COLOCATED SCHEME)
101C 239549 VZ Z-VELOCITY (MEAN VALUE FOR STAGGERED SCHEME, CELL VALUE FOR COLOCATED SCHEME)
102C 239550 SSP SOUND SPEED
103C 239551 MACH MACH NUMBER
104C
105C labels are detailed in Reader subroutine : hm_read_thgrou.F
106C
107C-----------------------------------------------
108C M o d u l e s
109C-----------------------------------------------
110 USE initbuf_mod
111 USE elbufdef_mod
112 USE multi_fvm_mod
113 USE alefvm_mod , only:alefvm_param
114C-----------------------------------------------
115C I m p l i c i t T y p e s
116C-----------------------------------------------
117#include "implicit_f.inc"
118C-----------------------------------------------
119C C o m m o n B l o c k s
120C-----------------------------------------------
121#include "vect01_c.inc"
122#include "com01_c.inc"
123#include "task_c.inc"
124#include "param_c.inc"
125#include "mvsiz_p.inc"
126C-----------------------------------------------
127C D u m m y A r g u m e n t s
128C-----------------------------------------------
129 INTEGER,INTENT(IN) :: IPARG(NPARG,NGROUP),IXS(NIXS,NUMELS), IPM(NPROPMI,NUMMAT),IGEO(NPROPGI,NUMGEO)
130 INTEGER,INTENT(IN) :: NTHGRP2, NUMELS, NUMMAT, NUMGEO, NUMNOD, SITHBUF
131 INTEGER,INTENT(IN) :: ITHBUF(SITHBUF)
132 INTEGER, INTENT(IN):: ITHERM
133 INTEGER, DIMENSION(NITHGR,*), INTENT(IN) :: ITHGRP
134 my_real,INTENT(INOUT) :: wa(*)
135 my_real,INTENT(IN) :: x(3,numnod) ,pm(npropm,nummat)
136 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
137 TYPE(MULTI_FVM_STRUCT), INTENT(IN) :: MULTI_FVM
138C-----------------------------------------------
139C L o c a l V a r i a b l e s
140C-----------------------------------------------
141 INTEGER II,I,J,JJ,K,L,N, IH, NG, MTE,NEL,
142 . NUVAR, IP,IPT,ISOLNOD,ITENS,IPWWA,ISPAU,IUWWA,
143 . IT,IR,IS,J1,J2,J3,NPTG,NPTR,NPTT,NPTS,NLAY,NFAIL,NVARF,
144 . NC1,NC2,NC3,NC4,NC5,NC6,NC7,NC8,KHBE,KCVT,NUVARTH,
145 . CPT,PID,ISVIS,TSHELL,TSH_ORT,ICSIG,IVISC,NPTL,IL,KK(6)
146 INTEGER :: NITER,IADB,NN,IADV,NVAR,ITYP,IJK,IS_ALE
147 INTEGER :: NODE
148 my_real
149 . s11,s22,s33,s12,s23,s13,
150 . r11,r22,r33,r12,r21,r23,r32,r13,r31,
151 . g11,g22,g33,g12,g21,g23,g32,g13,g31,
152 . t11,t22,t33,t12,t21,t23,t32,t13,t31,
153 . l11,l22,l33,l12,l21,l23,l32,l13,l31,
154 . x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4,
155 . x5,y5,z5,x6,y6,z6,x7,y7,z7,x8,y8,z8, cs,sn,var,plag
156 my_real
157 . a_gauss(9,9),sigp(7,81,9), user(100),
158 . strain(6),gama(6),evar_tmp(6),evar(6),sigg(6),
159 . vel(3),v(3,*),w(3,*),tmp_2(mvsiz,3),bfrac,ssp
160 my_real, DIMENSION(:), ALLOCATABLE :: wwa
161 my_real :: rho0
162C----
163 TYPE(L_BUFEL_) ,POINTER :: LBUF
164 TYPE(G_BUFEL_) ,POINTER :: GBUF
165 TYPE(BUF_MAT_) ,POINTER :: MBUF
166 TYPE(FAIL_LOC_),POINTER :: FBUF
167C--------------------------------------------
168 DATA a_gauss /
169 1 0. ,0. ,0. ,
170 1 0. ,0. ,0. ,
171 1 0. ,0. ,0. ,
172 2 -.577350269189626,0.577350269189626,0. ,
173 2 0. ,0. ,0. ,
174 2 0. ,0. ,0. ,
175 3 -.774596669241483,0. ,0.774596669241483,
176 3 0. ,0. ,0. ,
177 3 0. ,0. ,0. ,
178 4 -.861136311594053,-.339981043584856,0.339981043584856,
179 4 0.861136311594053,0. ,0. ,
180 4 0. ,0. ,0. ,
181 5 -.906179845938664,-.538469310105683,0. ,
182 5 0.538469310105683,0.906179845938664,0. ,
183 5 0. ,0. ,0. ,
184 6 -.932469514203152,-.661209386466265,-.238619186083197,
185 6 0.238619186083197,0.661209386466265,0.932469514203152,
186 6 0. ,0. ,0. ,
187 7 -.949107912342759,-.741531185599394,-.405845151377397,
188 7 0. ,0.405845151377397,0.741531185599394,
189 7 0.949107912342759,0. ,0. ,
190 8 -.960289856497536,-.796666477413627,-.525532409916329,
191 8 -.183434642495650,0.183434642495650,0.525532409916329,
192 8 0.796666477413627,0.960289856497536,0. ,
193 9 -.968160239507626,-.836031107326636,-.613371432700590,
194 9 -.324253423403809,0. ,0.324253423403809,
195 9 0.613371432700590,0.836031107326636,0.968160239507626/
196C-----------------------------------------------
197C S o u r c e L i n e s
198C-----------------------------------------------
199 ALLOCATE(wwa(239555))
200
201 ijk = 0
202 DO niter=1,nthgrp2
203 ityp=ithgrp(2,niter)
204 nn =ithgrp(4,niter)
205 iadb =ithgrp(5,niter)
206 nvar=ithgrp(6,niter)
207 iadv=ithgrp(7,niter)
208 ii=0
209 IF(ityp==1)THEN
210! -------------------------------
211
212 DO j1=1,7
213 DO j2=1,9
214 DO j3=1,9
215 sigp(j1,j2,j3) = zero
216 ENDDO
217 ENDDO
218 ENDDO
219 nuvar = 0
220 ih=iadb
221
222C IH shift
223 DO WHILE((ithbuf(ih+nn) /= ispmd).AND.(ih < iadb+nn))
224 ih = ih + 1
225 ENDDO
226 IF (ih >= iadb+nn) GOTO 666
227C
228c ENDIF
229C----------------------------------------------------------
230 DO ng=1,ngroup
231 ity = iparg(5,ng)
232 isvis = iparg(60,ng)
233 ivisc = iparg(61,ng)
234c
235 IF (ity == ityp) THEN
236 gbuf => elbuf_tab(ng)%GBUF
237 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
238 mbuf => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)
239 nlay = elbuf_tab(ng)%NLAY
240 nptr = elbuf_tab(ng)%NPTR
241 npts = elbuf_tab(ng)%NPTS
242 nptt = elbuf_tab(ng)%NPTT
243 nptg = nptr * npts * nptt
244
245C------
246 CALL initbuf( iparg ,ng ,
247 2 mte ,nel ,nft ,iad ,ity ,
248 3 npt ,jale ,ismstr ,jeul ,jtur ,
249 4 jthe ,jlag ,jmult ,khbe ,jivf ,
250 5 nvaux ,jpor ,kcvt ,jclose ,jplasol ,
251 6 irep ,iint ,igtyp ,israt ,isrot ,
252 7 icsen ,isorth ,isorthg ,ifailure,jsms )
253 tshell = 0
254 tsh_ort = 0
255 IF (igtyp==20 .OR. igtyp==21 .OR. igtyp==22) tshell = 1
256 IF (igtyp==21 .OR. igtyp==22) tsh_ort = 1
257!
258 DO i=1,6
259 kk(i) = nel*(i-1)
260 ENDDO
261!
262C------
263 IF (mte /= 0 .AND. mte /= 13) THEN
264 isolnod=iparg(28,ng)
265 is_ale = iparg(7,ng)
266C
267C KCVT 0 GLOBAL FORMULATION, ISOTROPIC CASE
268C KCVT -1 GLOBAL FORMULATION, ORTHOTROPIC CASE
269C KCVT 1 CO-ROTATIONAL FORMULATION, ISOTROPIC CASE
270C KCVT 2 CO-ROTATIONAL FORMULATION, ORTHOTROPIC CASE
271 IF (kcvt == 0 .AND. isorth > 0) kcvt=-1
272 IF (kcvt == 1 .AND. isorth > 0) kcvt= 2
273 IF (mte >=28) nuvar = ipm(8,ixs(1,nft+1))
274C------------------------------------
275 IF(is_ale > 0 .AND. is_ale /= 3)THEN
276 !general ale case (law77 excluded)
277 tmp_2(1:mvsiz,1:3) = zero
278 DO j=1,8
279 DO i=1,nel
280 node = ixs(j+1,i+nft)
281 IF(node > 0 .AND. node <= numnod) THEN
282 tmp_2(i,1)=tmp_2(i,1) + v(1,ixs(j+1,i+nft))-w(1,ixs(j+1,i+nft))
283 tmp_2(i,2)=tmp_2(i,2) + v(2,ixs(j+1,i+nft))-w(2,ixs(j+1,i+nft))
284 tmp_2(i,3)=tmp_2(i,3) + v(3,ixs(j+1,i+nft))-w(3,ixs(j+1,i+nft))
285 ENDIF
286 ENDDO
287 ENDDO
288 ELSE
289 !euler, lagrange, and law77
290 tmp_2(1:mvsiz,1:3) = zero
291 DO j=1,8
292 DO i=1,nel
293 node = ixs(j+1,i+nft)
294 IF(node > 0 .AND. node <= numnod) THEN
295 tmp_2(i,1)=tmp_2(i,1)+v(1,ixs(j+1,i+nft))
296 tmp_2(i,2)=tmp_2(i,2)+v(2,ixs(j+1,i+nft))
297 tmp_2(i,3)=tmp_2(i,3)+v(3,ixs(j+1,i+nft))
298 ENDIF
299 ENDDO
300 ENDDO
301 ENDIF
302C------------------------------------
303C
304 DO i=1,nel
305 n =i+nft
306 k =ithbuf(ih)
307 ip=ithbuf(ih+nn)
308c
309 evar(1:6) = zero
310 evar_tmp(1:6) = zero
311 strain(1:6) = zero
312C
313 IF (k == n)THEN
314 ih=ih+1
315C spmd treatment
316C get related 'ii'
317 ii = ((ih-1) - iadb)*nvar
318 DO WHILE((ithbuf(ih+nn) /= ispmd) .AND. (ih < iadb+nn))
319 ih = ih + 1
320 ENDDO
321c-----------
322 IF (ih > iadb+nn) GOTO 666
323c-----------
324 DO l=1,239552
325 wwa(l)=zero
326 ENDDO
327 wwa(1) = gbuf%OFF(i)
328 wwa(8) = gbuf%EINT(i)
329c
330 IF( nfilsol /= 0 .AND. gbuf%G_FILL /= 0 ) THEN
331 wwa(8) = wwa(8) * gbuf%FILL(i)
332 ENDIF
333c
334 wwa(9) = gbuf%RHO(i)
335 IF (gbuf%G_QVIS > 0) wwa(10)= gbuf%QVIS(i)
336 wwa(11)= gbuf%VOL(i)
337 IF(jlag==1 .AND. gbuf%RHO(i)>zero)THEN
338 wwa(11)=gbuf%VOL(i) * pm(89,ixs(1,nft+i))/gbuf%RHO(i) ! GBUF%VOL(I) = V0 for lagrangian solids ; (rho is optional for void material law)
339 ENDIF
340C-----------
341C SOUND SPEED, MATERIAL VELOCITY, AND MACH NUMBER.
342C-----------
343 !general case is treated here.
344 ! specific cases may erase these values below (law151, alefvm, ...)
345 vel(1) = tmp_2(i,1)*one_over_8
346 vel(2) = tmp_2(i,2)*one_over_8
347 vel(3) = tmp_2(i,3)*one_over_8
348 wwa(239547) = vel(1)
349 wwa(239548) = vel(2)
350 wwa(239549) = vel(3)
351 wwa(239550) = zero
352 wwa(239551) = zero
353 IF(elbuf_tab(ng)%BUFLY(1)%L_SSP /= 0)THEN
354 ssp = elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)%SSP(i)
355 wwa(239550)= ssp
356 IF(ssp > zero)THEN
357 wwa(239551)= sqrt(vel(1)*vel(1)+vel(2)*vel(2)+vel(3)*vel(3))/ssp !mach number
358 ENDIF
359 ENDIF
360C-----------
361C STRESSES COMPUTED IN GLOBAL OR CONVECTED SYSTEM.
362C-----------
363 s11 = gbuf%SIG(kk(1)+i)
364 s22 = gbuf%SIG(kk(2)+i)
365 s33 = gbuf%SIG(kk(3)+i)
366 s12 = gbuf%SIG(kk(4)+i)
367 s23 = gbuf%SIG(kk(5)+i)
368 s13 = gbuf%SIG(kk(6)+i)
369C just for isotropic
370 IF (isvis == 1.AND. mte >=28 )THEN
371 s11=s11 + lbuf%SIGV(kk(1)+i)
372 s22=s22 + lbuf%SIGV(kk(2)+i)
373 s33=s33 + lbuf%SIGV(kk(3)+i)
374 s12=s12 + lbuf%SIGV(kk(4)+i)
375 s23=s23 + lbuf%SIGV(kk(5)+i)
376 s13=s13 + lbuf%SIGV(kk(6)+i)
377 ENDIF
378
379 IF (ivisc > 0 )THEN
380 s11=s11 + lbuf%VISC(kk(1)+i)
381 s22=s22 + lbuf%VISC(kk(2)+i)
382 s33=s33 + lbuf%VISC(kk(3)+i)
383 s12=s12 + lbuf%VISC(kk(4)+i)
384 s23=s23 + lbuf%VISC(kk(5)+i)
385 s13=s13 + lbuf%VISC(kk(6)+i)
386 ENDIF
387 nc1=ixs(2,n)
388 nc2=ixs(3,n)
389 nc3=ixs(4,n)
390 nc4=ixs(5,n)
391 nc5=ixs(6,n)
392 nc6=ixs(7,n)
393 nc7=ixs(8,n)
394 nc8=ixs(9,n)
395 x1=x(1,nc1)
396 y1=x(2,nc1)
397 z1=x(3,nc1)
398 x2=x(1,nc2)
399 y2=x(2,nc2)
400 z2=x(3,nc2)
401 x3=x(1,nc3)
402 y3=x(2,nc3)
403 z3=x(3,nc3)
404 x4=x(1,nc4)
405 y4=x(2,nc4)
406 z4=x(3,nc4)
407 x5=x(1,nc5)
408 y5=x(2,nc5)
409 z5=x(3,nc5)
410 x6=x(1,nc6)
411 y6=x(2,nc6)
412 z6=x(3,nc6)
413 x7=x(1,nc7)
414 y7=x(2,nc7)
415 z7=x(3,nc7)
416 x8=x(1,nc8)
417 y8=x(2,nc8)
418 z8=x(3,nc8)
419C-----------
420C TENSOR ROTATION.
421C KCVT 0 GLOBAL FORMULATION, ISOTROPIC CASE
422C KCVT -1 GLOBAL FORMULATION, ORTHOTROPIC OR ISOTROPIC CASE (gama(1)=1000)
423C KCVT 1 CO-ROTATIONAL FORMULATION, ISOTROPIC CASE
424C KCVT 2 CO-ROTATIONAL FORMULATION, ORTHOTROPIC OR ISOTROPIC CASE
425C (gama(1)=1000)
426C------------------------------------------------------------------------------
427C 1- TH tab filling with stresses in the global (WA(2:7)
428C and local system(WA(35:40)
429C------------------------------------------------------------------------------
430 IF (kcvt > 0) THEN
431C
432c ELEMENT CO-ROTATIONNEL.
433C
434 IF (igtyp == 43) THEN ! solid spotweld
435 CALL scoor431(
436 . x1, x2, x3, x4, x5, x6, x7, x8,
437 . y1, y2, y3, y4, y5, y6, y7, y8,
438 . z1, z2, z3, z4, z5, z6, z7, z8,
439 . r11, r12, r13, r21, r22, r23, r31, r32, r33)
440c
441 IF( nfilsol /= 0 .AND. gbuf%G_FILL /= 0 ) THEN
442 s11 = s11 * gbuf%FILL(i)
443 s22 = s22 * gbuf%FILL(i)
444 s33 = s33 * gbuf%FILL(i)
445 s12 = s12 * gbuf%FILL(i)
446 s23 = s23 * gbuf%FILL(i)
447 s13 = s13 * gbuf%FILL(i)
448 ENDIF
449c
450 wwa(35)=s11 ! mean stress in local skew
451 wwa(36)=s22
452 wwa(37)=s33
453 wwa(38)=s12
454 wwa(39)=s23
455 wwa(40)=s13
456 l11=s11*r11+s12*r12+s13*r13
457 l12=s11*r21+s12*r22+s13*r23
458 l13=s11*r31+s12*r32+s13*r33
459 l21=s12*r11+s22*r12+s23*r13
460 l22=s12*r21+s22*r22+s23*r23
461 l23=s12*r31+s22*r32+s23*r33
462 l31=s13*r11+s23*r12+s33*r13
463 l32=s13*r21+s23*r22+s33*r23
464 l33=s13*r31+s23*r32+s33*r33
465 s11=r11*l11+r12*l21+r13*l31
466 s22=r21*l12+r22*l22+r23*l32
467 s33=r31*l13+r32*l23+r33*l33
468 s12=r11*l12+r12*l22+r13*l32
469 s23=r21*l13+r22*l23+r23*l33
470 s13=r11*l13+r12*l23+r13*l33
471 wwa(2)=s11 ! mean stress in global skew
472 wwa(3)=s22
473 wwa(4)=s33
474 wwa(5)=s12
475 wwa(6)=s23
476 wwa(7)=s13
477 ELSEIF (khbe /= 24 .AND. khbe /= 14) THEN
478 IF (khbe /= 15) THEN
479 CALL sortho31(
480 . x1, x2, x3, x4, x5, x6, x7, x8,
481 . y1, y2, y3, y4, y5, y6, y7, y8,
482 . z1, z2, z3, z4, z5, z6, z7, z8,
483 . r11, r12, r13, r21, r22, r23, r31, r32, r33)
484 ELSE
485c KHBE=15 : mean values already in co-rot system
486 CALL scortho31(
487 . x1, x2, x3, x4, x5, x6, x7, x8,
488 . y1, y2, y3, y4, y5, y6, y7, y8,
489 . z1, z2, z3, z4, z5, z6, z7, z8,
490 . r11, r12, r13, r21, r22, r23, r31, r32, r33)
491 END IF
492c
493 IF (kcvt == 2) THEN
494 IF (isorth > 0) THEN
495c REPERE ORTHOTROPE.
496 IF (khbe /= 15) THEN
497 g11=gbuf%GAMA(kk(1)+i)
498 g21=gbuf%GAMA(kk(2)+i)
499 g31=gbuf%GAMA(kk(3)+i)
500 g12=gbuf%GAMA(kk(4)+i)
501 g22=gbuf%GAMA(kk(5)+i)
502 g32=gbuf%GAMA(kk(6)+i)
503 g13=g21*g32-g31*g22
504 g23=g31*g12-g11*g32
505 g33=g11*g22-g21*g12
506 ELSE
507 cs = gbuf%GAMA(kk(1)+i)
508 sn = gbuf%GAMA(kk(2)+i)
509 g11=cs
510 g12=sn
511 g13=zero
512 g21=-sn
513 g22=cs
514 g23=zero
515 g31=zero
516 g32=zero
517 g33=one
518 END IF
519C TRANSFER MATRIX (CHANGE OF BASIS) -> ORTHOTROPIC.
520 t11=r11*g11+r12*g21+r13*g31
521 t12=r11*g12+r12*g22+r13*g32
522 t13=r11*g13+r12*g23+r13*g33
523 t21=r21*g11+r22*g21+r23*g31
524 t22=r21*g12+r22*g22+r23*g32
525 t23=r21*g13+r22*g23+r23*g33
526 t31=r31*g11+r32*g21+r33*g31
527 t32=r31*g12+r32*g22+r33*g32
528 t33=r31*g13+r32*g23+r33*g33
529 r11=t11
530 r12=t12
531 r13=t13
532 r21=t21
533 r22=t22
534 r23=t23
535 r31=t31
536 r32=t32
537 r33=t33
538 ENDIF
539 ENDIF ! kcvt = 2
540c
541 IF( nfilsol /= 0 .AND. gbuf%G_FILL /= 0 ) THEN
542 s11 = s11 * gbuf%FILL(i)
543 s22 = s22 * gbuf%FILL(i)
544 s33 = s33 * gbuf%FILL(i)
545 s12 = s12 * gbuf%FILL(i)
546 s23 = s23 * gbuf%FILL(i)
547 s13 = s13 * gbuf%FILL(i)
548 ENDIF
549c
550 wwa(35)=s11
551 wwa(36)=s22
552 wwa(37)=s33
553 wwa(38)=s12
554 wwa(39)=s23
555 wwa(40)=s13
556 l11=s11*r11+s12*r12+s13*r13
557 l12=s11*r21+s12*r22+s13*r23
558 l13=s11*r31+s12*r32+s13*r33
559 l21=s12*r11+s22*r12+s23*r13
560 l22=s12*r21+s22*r22+s23*r23
561 l23=s12*r31+s22*r32+s23*r33
562 l31=s13*r11+s23*r12+s33*r13
563 l32=s13*r21+s23*r22+s33*r23
564 l33=s13*r31+s23*r32+s33*r33
565 s11=r11*l11+r12*l21+r13*l31
566 s22=r21*l12+r22*l22+r23*l32
567 s33=r31*l13+r32*l23+r33*l33
568 s12=r11*l12+r12*l22+r13*l32
569 s23=r21*l13+r22*l23+r23*l33
570 s13=r11*l13+r12*l23+r13*l33
571 wwa(2)=s11
572 wwa(3)=s22
573 wwa(4)=s33
574 wwa(5)=s12
575 wwa(6)=s23
576 wwa(7)=s13
577 ELSE ! khbe == 24.OR.khbe == 14
578 CALL sortho31(
579 . x1, x2, x3, x4, x5, x6, x7, x8,
580 . y1, y2, y3, y4, y5, y6, y7, y8,
581 . z1, z2, z3, z4, z5, z6, z7, z8,
582 . r12, r13, r11, r22, r23, r21, r32, r33, r31)
583 IF (kcvt == 2) THEN
584 g11=gbuf%GAMA(kk(1)+i)
585 g21=gbuf%GAMA(kk(2)+i)
586 g31=gbuf%GAMA(kk(3)+i)
587 g12=gbuf%GAMA(kk(4)+i)
588 g22=gbuf%GAMA(kk(5)+i)
589 g32=gbuf%GAMA(kk(6)+i)
590 g13=g21*g32-g31*g22
591 g23=g31*g12-g11*g32
592 g33=g11*g22-g21*g12
593C KHBE=14 : mean values are in local co-rot reference axis
594 ! transfer from local to orthotropic axis
595 IF (khbe == 14) THEN
596 l11=s11*g11+s12*g12+s13*g13
597 l12=s11*g21+s12*g22+s13*g23
598 l13=s11*g31+s12*g32+s13*g33
599 l21=s12*g11+s22*g12+s23*g13
600 l22=s12*g21+s22*g22+s23*g23
601 l23=s12*g31+s22*g32+s23*g33
602 l31=s13*g11+s23*g12+s33*g13
603 l32=s13*g21+s23*g22+s33*g23
604 l33=s13*g31+s23*g32+s33*g33
605 s11=g11*l11+g12*l21+g13*l31
606 s22=g21*l12+g22*l22+g23*l32
607 s33=g31*l13+g32*l23+g33*l33
608 s12=g11*l12+g12*l22+g13*l32
609 s23=g21*l13+g22*l23+g23*l33
610 s13=g11*l13+g12*l23+g13*l33
611 ENDIF
612C TRANSFORMATION MATRIX GLOBAL -> ORTHOTROPIC.
613 t11=r11*g11+r12*g21+r13*g31
614 t12=r11*g12+r12*g22+r13*g32
615 t13=r11*g13+r12*g23+r13*g33
616 t21=r21*g11+r22*g21+r23*g31
617 t22=r21*g12+r22*g22+r23*g32
618 t23=r21*g13+r22*g23+r23*g33
619 t31=r31*g11+r32*g21+r33*g31
620 t32=r31*g12+r32*g22+r33*g32
621 t33=r31*g13+r32*g23+r33*g33
622 r11=t11
623 r12=t12
624 r13=t13
625 r21=t21
626 r22=t22
627 r23=t23
628 r31=t31
629 r32=t32
630 r33=t33
631 END IF
632c
633 IF( nfilsol /= 0 .AND. gbuf%G_FILL /= 0 ) THEN
634 s11 = s11 * gbuf%FILL(i)
635 s22 = s22 * gbuf%FILL(i)
636 s33 = s33 * gbuf%FILL(i)
637 s12 = s12 * gbuf%FILL(i)
638 s23 = s23 * gbuf%FILL(i)
639 s13 = s13 * gbuf%FILL(i)
640 ENDIF
641c
642 wwa(35)=s11
643 wwa(36)=s22
644 wwa(37)=s33
645 wwa(38)=s12
646 wwa(39)=s23
647 wwa(40)=s13
648 l11=s11*r11+s12*r12+s13*r13
649 l12=s11*r21+s12*r22+s13*r23
650 l13=s11*r31+s12*r32+s13*r33
651 l21=s12*r11+s22*r12+s23*r13
652 l22=s12*r21+s22*r22+s23*r23
653 l23=s12*r31+s22*r32+s23*r33
654 l31=s13*r11+s23*r12+s33*r13
655 l32=s13*r21+s23*r22+s33*r23
656 l33=s13*r31+s23*r32+s33*r33
657 s11=r11*l11+r12*l21+r13*l31
658 s22=r21*l12+r22*l22+r23*l32
659 s33=r31*l13+r32*l23+r33*l33
660 s12=r11*l12+r12*l22+r13*l32
661 s23=r21*l13+r22*l23+r23*l33
662 s13=r11*l13+r12*l23+r13*l33
663 wwa(2)=s11
664 wwa(3)=s22
665 wwa(4)=s33
666 wwa(5)=s12
667 wwa(6)=s23
668 wwa(7)=s13
669 END IF ! igtyp, khbe
670C------------------------------------
671 ELSE ! KCVT <= 0
672C------------------------------
673c element non-corotationnel : no rotation SX,SY,SZ,SXY,SXZ,SYZ
674C and LSX,LSY,LSZ,LSXY,LSXZ,LSYZ are in both in global system
675 wwa(2)=s11
676 wwa(3)=s22
677 wwa(4)=s33
678 wwa(5)=s12
679 wwa(6)=s23
680 wwa(7)=s13
681c
682 wwa(35)=s11
683 wwa(36)=s22
684 wwa(37)=s33
685 wwa(38)=s12
686 wwa(39)=s23
687 wwa(40)=s13
688C--------------------------------------------------------------------------
689 ENDIF ! KCVT
690C--------------------------------------------------
691c LOOP NEL, Filling TH Buffer
692C-----------------------------------------------------
693 ! output of element temperature
694 IF (jthe /= 0 .and. jlag > 0) THEN
695 wwa(13) = gbuf%TEMP(i)
696 ELSE
697 wwa(13) = zero
698 DO il=1,nlay
699 IF (elbuf_tab(ng)%BUFLY(il)%L_TEMP > 0) THEN
700 DO it=1,elbuf_tab(ng)%BUFLY(il)%NPTT
701 DO is=1,npts
702 DO ir=1,nptr
703 wwa(13) = wwa(13)+elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)%TEMP(i)/nptg
704 ENDDO
705 ENDDO
706 ENDDO
707 ENDIF
708 ENDDO
709 ENDIF
710!--------------------------------------
711 wwa(14)=gbuf%EPSD(i)
712 IF (mte == 2) THEN
713 wwa(12) = gbuf%PLA(i)
714! WWA(13) = GBUF%TEMP(I)
715 ELSEIF (mte == 3) THEN
716 wwa(12)=gbuf%PLA(i)
717! WWA(13)=GBUF%TEMP(I)
718 ELSEIF (mte == 4) THEN
719 wwa(12)=gbuf%PLA(i)
720! WWA(13)=GBUF%TEMP(I)
721 ELSEIF (mte == 5 .OR. mte == 41 .OR. mte == 97) THEN
722! WWA(13)=GBUF%TEMP(I)
723 wwa(31)=gbuf%BFRAC(i)
724 ELSEIF (mte == 6) THEN
725! WWA(13)=GBUF%TEMP(I)
726 wwa(26)=lbuf%RK(i)
727 wwa(27)=lbuf%RE(i)
728 ELSEIF (mte == 7.OR.mte == 8.OR.mte == 9) THEN
729 wwa(12)=zero
730 wwa(13)=zero
731 ELSEIF (mte == 10) THEN
732 wwa(12)=gbuf%PLA(i) !/TH (EPSP)
733 wwa(30)=gbuf%EPSQ(i) !/TH (VPLA)
734 ELSEIF (mte == 11) THEN
735! WWA(13)=LBUF%TEMP(I)
736 wwa(26)=lbuf%RK(i)
737 wwa(27)=lbuf%RE(i)
738 ELSEIF (mte == 14) THEN
739 wwa(32)=lbuf%PLA(i) !N1
740 wwa(33)=lbuf%SIGF(i) !N2
741 wwa(28)=lbuf%EPSF(i) !N3
742 wwa(15)=lbuf%DAM(kk(1)+i) !N4
743 wwa(16)=lbuf%DAM(kk(2)+i)
744 wwa(17)=lbuf%DAM(kk(3)+i)
745 wwa(18)=lbuf%DAM(kk(4)+i)
746 wwa(34)=lbuf%DAM(kk(5)+i)
747 ELSEIF (mte == 16) THEN
748 wwa(12)=lbuf%PLA(i) !N1
749! WWA(13)=LBUF%TEMP(I) !N2
750 ELSEIF (mte == 17) THEN
751! IF (ITHERM > 0) WWA(13)=LBUF%TEMP(I)
752 wwa(26)=lbuf%RK(i)
753 wwa(27)=lbuf%RE(i)
754 ELSEIF (mte == 18) THEN
755! WWA(13)=LBUF%TEMP(I)
756 ELSEIF (mte == 20) THEN
757 wwa(12)=zero
758 wwa(13)=zero
759 ELSEIF (mte == 21) THEN
760 wwa(12)=gbuf%PLA(i)
761 wwa(30)=gbuf%EPSQ(i)
762 ELSEIF (mte == 22.OR.mte == 23) THEN
763 wwa(12)=lbuf%PLA(i)
764 ELSEIF (mte == 24) THEN
765 wwa(15)=lbuf%DAM(kk(1)+i)
766 wwa(16)=lbuf%DAM(kk(2)+i)
767 wwa(17)=lbuf%DAM(kk(3)+i)
768 wwa(19)=lbuf%DAM(kk(1)+i)+lbuf%DAM(kk(2)+i)+lbuf%DAM(kk(3)+i)
769 wwa(20)=lbuf%SIGA(kk(1)+i)
770 wwa(21)=lbuf%SIGA(kk(2)+i)
771 wwa(22)=lbuf%SIGA(kk(3)+i)
772 wwa(23)=lbuf%CRAK(kk(1)+i)+lbuf%CRAK(kk(2)+i)+lbuf%CRAK(kk(3)+i)
773 wwa(24)=lbuf%ROB(i)
774 wwa(25)=lbuf%VK(i) ! K0 in /TH/BRICK
775 wwa(239552)=lbuf%RK(i) ! VK in /TH/BRICK
776 wwa(12)=lbuf%PLA(i)
777 wwa(30)=gbuf%PLA(i)
778 ELSEIF (mte == 25) THEN
779 wwa(32)=lbuf%PLA(i) !WPLA
780 ELSEIF (mte == 26) THEN
781 wwa(12)=lbuf%PLA(i)
782! WWA(13)=LBUF%TEMP(I)
783 wwa(14)=lbuf%Z(i)
784 ELSEIF (mte == 32.OR.mte == 43) THEN ! not solid compatible !!
785 wwa(12)=zero
786 wwa(13)=zero
787 ELSEIF (mte == 46.OR.mte == 47) THEN
788 wwa(12)=mbuf%VAR(i)
789 ELSEIF (mte == 49) THEN
790 wwa(12)=lbuf%PLA(i)
791! WWA(13)=LBUF%TEMP(I)
792 wwa(14)=lbuf%EPSD(i)
793 ELSEIF (mte == 28) THEN
794 ELSEIF (mte == 33) THEN
795 ELSEIF (mte == 51) THEN
796 IF(gbuf%G_PLA>0) wwa(12)=gbuf%PLA(i)
797 wwa(13)=gbuf%TEMP(i)
798 IF(gbuf%G_EPSD>0) wwa(14)=gbuf%EPSD(i)
799 IF(gbuf%G_BFRAC>0)wwa(31)=gbuf%BFRAC(i)
800 IF(gbuf%G_EPSQ>0) wwa(30)=gbuf%EPSQ(i)
801 ELSEIF (mte == 59) THEN
802C Solid spotwelds : damage DAMA1 ...DAMA4
803 nfail = elbuf_tab(ng)%BUFLY(1)%NFAIL
804 DO j=1,nptr
805 DO k=1,nfail
806 fbuf => elbuf_tab(ng)%BUFLY(1)%FAIL(j,1,1)%FLOC(k)
807 nvarf = fbuf%NVAR
808 DO l=1,nvarf
809 var = fbuf%VAR((l-1)*nel+i)
810 wwa(136+l) = max(wwa(136+l), var)
811 ENDDO
812 ENDDO
813 ENDDO
814 var = max(wwa(15),wwa(16))
815 var = max(wwa(17),var)
816 var = max(wwa(18),var)
817 wwa(19) = var ! DAMA = max(dama1,dama2,dama3,dama4)
818
819 ELSEIF (mte == 83) THEN
820 wwa(12)=gbuf%PLA(i)
821 nuvar = elbuf_tab(ng)%BUFLY(1)%NVAR_MAT
822 DO j=1,nptr
823 mbuf => elbuf_tab(ng)%BUFLY(1)%MAT(j,1,1)
824 DO l=1,nuvar
825 var = mbuf%VAR((l-1)*nel+i)
826 wwa(136+l) = max(wwa(136+l), var)
827 ENDDO
828 ENDDO
829 ELSEIF (mte == 116) THEN
830 wwa(12) = gbuf%PLA(i)
831 nuvar = elbuf_tab(ng)%BUFLY(1)%NVAR_MAT
832 DO j=1,nptr
833 mbuf => elbuf_tab(ng)%BUFLY(1)%MAT(j,1,1)
834 DO l=1,nuvar
835 var = mbuf%VAR((l-1)*nel+i)
836 wwa(136+l) = max(wwa(136+l), var)
837 ENDDO
838 ENDDO
839 ELSEIF (mte == 67) THEN
840C Temperature
841 wwa(12)=zero
842! WWA(13)=MBUF%VAR(I)
843 ELSEIF (mte == 103) THEN
844C Hensel Spittel
845 wwa(12)=lbuf%PLA(i)
846! wwa(13)=mbuf%VAR(i)
847 wwa(14)=lbuf%EPSD(i)
848 ELSEIF (mte > 28) THEN
849 IF (elbuf_tab(ng)%BUFLY(1)%L_PLA > 0)THEN
850 wwa(12)=lbuf%PLA(i)
851 ELSE
852 wwa(12)=zero
853 ENDIF
854! IF (ELBUF_TAB(NG)%BUFLY(1)%L_TEMP > 0)THEN
855! WWA(13)=LBUF%TEMP(I)
856! ELSE
857! WWA(13)=ZERO
858! ENDIF
859! IF (ELBUF_TAB(NG)%BUFLY(1)%L_EPSD > 0)THEN
860! WWA(14)=LBUF%EPSD(I)
861! ENDIF
862C User laws for solids
863C User laws for solids - max 60 user variables.
864 nuvarth = min(60,nuvar)
865 DO j=1,nuvarth
866 wwa(136+j)=mbuf%VAR((j-1)*nel+i)
867 ENDDO
868 ENDIF
869C------------------------------------------------------------------------------
870C
871 IF (mte==151) THEN !specific buffer with colocated scheme, generic storage from above are erased
872C BFRAC
873 IF(ALLOCATED(multi_fvm%BFRAC))THEN
874 bfrac = zero
875 DO ir=1,multi_fvm%NBMAT
876 bfrac = max(bfrac, multi_fvm%BFRAC(ir,n))
877 ENDDO
878 wwa(31)=bfrac
879 ENDIF
880C VX / VY / VZ
881 wwa(239547)= multi_fvm%VEL(1, n)
882 wwa(239548)= multi_fvm%VEL(2, n)
883 wwa(239549)= multi_fvm%VEL(3, n)
884C SSP
885 wwa(239550)= multi_fvm%SOUND_SPEED(n)
886C MACH NUMBER
887 wwa(239551)= sqrt(multi_fvm%VEL(1, n)*multi_fvm%VEL(1, n)+
888 . multi_fvm%VEL(2, n)*multi_fvm%VEL(2, n)+
889 . multi_fvm%VEL(3, n)*multi_fvm%VEL(3, n)) /
890 . multi_fvm%SOUND_SPEED(n)
891
892 ELSEIF(alefvm_param%ISOLVER>1)THEN !specific buffer (ALEFVM, obsolete)
893C SSP
894 ssp = lbuf%SSP(i)
895 wwa(239550)= ssp
896 IF(elbuf_tab(ng)%BUFLY(1)%L_SSP /= 0)THEN
897 vel(1) = gbuf%MOM(i) / gbuf%RHO(i)
898 vel(2) = gbuf%MOM(nel + i) / gbuf%RHO(i)
899 vel(3) = gbuf%MOM(2*nel+ i) / gbuf%RHO(i)
900 wwa(239547)= vel(1)
901 wwa(239548)= vel(2)
902 wwa(239549)= vel(3)
903 IF(ssp > zero)THEN
904 wwa(239551)= sqrt(vel(1)*vel(1)+vel(2)*vel(2)+vel(3)*vel(3))/ssp
905 ENDIF
906 ENDIF
907
908 ELSE
909 !other cases already treated above
910 ENDIF
911c
912 ! Non-local plastic strain and non-local plastic strain rate
913 IF (gbuf%G_PLANL > 0) THEN
914 nptg = nptr * npts * nptt
915 wwa(239553) = zero
916 DO ir=1,nptr
917 DO is=1,npts
918 DO it=1,nptt
919 wwa(239553) = wwa(239553) + elbuf_tab(ng)%BUFLY(1)%LBUF(ir,is,it)%PLANL(i)/nptg
920 ENDDO
921 ENDDO
922 ENDDO
923 ENDIF
924 IF (gbuf%G_EPSDNL > 0) THEN
925 nptg = nptr * npts * nptt
926 wwa(239554) = zero
927 DO ir=1,nptr
928 DO is=1,npts
929 DO it=1,nptt
930 wwa(239554) = wwa(239554) + elbuf_tab(ng)%BUFLY(1)%LBUF(ir,is,it)%EPSDNL(i)/nptg
931 ENDDO
932 ENDDO
933 ENDDO
934 ENDIF
935
936 !VOLUMETRIC STRAIN (MU)
937 rho0 = pm(01,ixs(1,nft+i))
938 IF(rho0 > zero)THEN
939 wwa(239555) = elbuf_tab(ng)%GBUF%RHO(i) / rho0 - one
940 ELSE
941 wwa(239555) = zero
942 ENDIF
943
944C------------------------------------------------------------------------------
945C 2- TH tab filling with stresses and stain in element
946C and per integration point
947C *** Property Type22: output SIG_IK_J => WA(120338)
948C EPS_IK_J => WA(1646)
949C *** Solid 16 nodes, 20nodes, 8 nodes (KHBE 14,17), 8 nodes and 6 nodes
950C SXIJK,SYIJK,SZIJK,SXYIJK,SXZIJK,SYZIIJK EPIJK => WA(196)
951C EPSXIJK,EPSYIJK,EPSZIJK,EPSXYIJK,EPSXZIJK,EPSYZIIJK => WWA(239060)
952C *** All solids
953C EPSXX,EPSYY,EPSZZ,EPSXY,EPSXZ,EPSYZ => WWA(1618)
954C L_EPSXX,L_EPSYY,L_EPSZZ,L_EPSXY,LEPSXZ,LEPSYZ => WWA(239030)
955C------------------------------------------------------------------------------
956 IF (kcvt > 0) THEN
957C
958c ELEMENT CO-ROTATIONNEL.
959C
960 IF (isolnod == 4) THEN
961C
962 ELSEIF (isolnod == 10) THEN
963C
964 ELSEIF (isolnod == 8.AND. igtyp == 43) THEN
965c----------------------------------------------------------------------------
966C------------------------Output EPS L_EPS---------------------
967C---------------------------------------------------------------------------
968 DO ipt=1,npt
969 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ipt,1,1)
970 DO j=1,3
971 strain(j) = strain(j) + lbuf%EPE(kk(j)+i)/npt
972 ENDDO
973 ENDDO
974
975 wwa(239030 + 3) = strain(3) ! mean strain in local skew
976 wwa(239030 + 2) = strain(2)
977 wwa(239030 + 1) = strain(1)
978c---------------------Rotation to the global system for EPSXX.. ------
979 gama(1)=one
980 gama(2)=zero
981 gama(3)=zero
982 gama(4)=zero
983 gama(5)=one
984 gama(6)=zero
985
986 CALL srota6(x,ixs(1,n),kcvt,strain,gama,khbe,igtyp,isorth)
987
988 DO j=1,3
989 wwa(1618 + j) = strain(j) ! mean stress in global skew
990 ENDDO
991c---------------
992 ELSEIF (isolnod==8 .AND. khbe/=14 .AND. khbe/=15 .AND. khbe/=17) THEN
993c----------------------------------------------------------------------------
994C------------------------Output SIJK EPS L_EPS-------------------------------
995C---------------------------------------------------------------------------
996c 8-node bricks (std)
997c---------------
998 IF (npt == 8)THEN
999 jj = 6*(i-1)
1000 IF (elbuf_tab(ng)%BUFLY(1)%L_SIGL > 0) THEN
1001 DO ipt=1,npt
1002 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ipt,1,1)
1003C-----------------------------------
1004c CO-ROTATIONAL FORMULATION ONLY:
1005c 88+I LSX at Gauss point I
1006c 96+I LSY at Gauss point I
1007c 104+I LSZ at Gauss point I
1008c 112+I LSXY at Gauss point I
1009c 120+I LSYZ at Gauss point I
1010c 128+I LSXZ at Gauss point I
1011C-----------------------------------
1012 wwa( 88+ipt) = lbuf%SIGL(kk(1)+i)
1013 wwa( 96+ipt) = lbuf%SIGL(kk(2)+i)
1014 wwa(104+ipt) = lbuf%SIGL(kk(3)+i)
1015 wwa(112+ipt) = lbuf%SIGL(kk(4)+i)
1016 wwa(120+ipt) = lbuf%SIGL(kk(5)+i)
1017 wwa(128+ipt) = lbuf%SIGL(kk(6)+i)
1018 ENDDO
1019 ELSE IF(khbe == 12)THEN
1020 DO ipt=1,npt
1021 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,ipt)
1022 wwa( 88+ipt) = lbuf%SIG(kk(1)+i)
1023 wwa( 96+ipt) = lbuf%SIG(kk(2)+i)
1024 wwa(104+ipt) = lbuf%SIG(kk(3)+i)
1025 wwa(112+ipt) = lbuf%SIG(kk(4)+i)
1026 wwa(120+ipt) = lbuf%SIG(kk(5)+i)
1027 wwa(128+ipt) = lbuf%SIG(kk(6)+i)
1028 ENDDO
1029 IF(ivisc > 0 ) THEN
1030 DO ipt=1,npt
1031 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,ipt)
1032 wwa( 88+ipt) =wwa( 88+ipt) + lbuf%VISC(kk(1)+i)
1033 wwa( 96+ipt) =wwa( 96+ipt) + lbuf%VISC(kk(2)+i)
1034 wwa(104+ipt) =wwa(104+ipt) + lbuf%VISC(kk(3)+i)
1035 wwa(112+ipt) =wwa(112+ipt) + lbuf%VISC(kk(4)+i)
1036 wwa(120+ipt) =wwa(120+ipt) + lbuf%VISC(kk(5)+i)
1037 wwa(128+ipt) =wwa(128+ipt) + lbuf%VISC(kk(6)+i)
1038 ENDDO
1039 ENDIF
1040 ELSE
1041 DO ipt=1,npt
1042 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ipt,1,1)
1043 wwa( 88+ipt) = lbuf%SIG(kk(1)+i)
1044 wwa( 96+ipt) = lbuf%SIG(kk(2)+i)
1045 wwa(104+ipt) = lbuf%SIG(kk(3)+i)
1046 wwa(112+ipt) = lbuf%SIG(kk(4)+i)
1047 wwa(120+ipt) = lbuf%SIG(kk(5)+i)
1048 wwa(128+ipt) = lbuf%SIG(kk(6)+i)
1049 ENDDO
1050 IF(ivisc > 0 ) THEN
1051 DO ipt=1,npt
1052 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ipt,1,1)
1053 wwa( 88+ipt) =wwa( 88+ipt) + lbuf%VISC(kk(1)+i)
1054 wwa( 96+ipt) =wwa( 96+ipt) + lbuf%VISC(kk(2)+i)
1055 wwa(104+ipt) =wwa(104+ipt) + lbuf%VISC(kk(3)+i)
1056 wwa(112+ipt) =wwa(112+ipt) + lbuf%VISC(kk(4)+i)
1057 wwa(120+ipt) =wwa(120+ipt) + lbuf%VISC(kk(5)+i)
1058 wwa(128+ipt) =wwa(128+ipt) + lbuf%VISC(kk(6)+i)
1059 ENDDO
1060 ENDIF
1061 ENDIF
1062 IF(khbe == 12)THEN
1063 DO ipt=1,npt
1064 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,ipt)
1065 IF (elbuf_tab(ng)%BUFLY(1)%L_STRA > 0) THEN
1066 strain(1) = strain(1) + lbuf%STRA(kk(1)+i)*one_over_8
1067 strain(2) = strain(2) + lbuf%STRA(kk(2)+i)*one_over_8
1068 strain(3) = strain(3) + lbuf%STRA(kk(3)+i)*one_over_8
1069 strain(4) = strain(4) + lbuf%STRA(kk(4)+i)*one_over_8
1070 strain(5) = strain(5) + lbuf%STRA(kk(5)+i)*one_over_8
1071 strain(6) = strain(6) + lbuf%STRA(kk(6)+i)*one_over_8
1072 ENDIF
1073 ENDDO
1074 ELSE
1075 DO ipt=1,npt
1076 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ipt,1,1)
1077 IF (elbuf_tab(ng)%BUFLY(1)%L_STRA > 0) THEN
1078 strain(1) = strain(1) + lbuf%STRA(kk(1)+i)*one_over_8
1079 strain(2) = strain(2) + lbuf%STRA(kk(2)+i)*one_over_8
1080 strain(3) = strain(3) + lbuf%STRA(kk(3)+i)*one_over_8
1081 strain(4) = strain(4) + lbuf%STRA(kk(4)+i)*one_over_8
1082 strain(5) = strain(5) + lbuf%STRA(kk(5)+i)*one_over_8
1083 strain(6) = strain(6) + lbuf%STRA(kk(6)+i)*one_over_8
1084 ENDIF
1085 ENDDO
1086 ENDIF
1087C-----------------in local ref : L_EPSX............-----------
1088 DO j= 1,6
1089 wwa(239030 + j) = strain(j)
1090 ENDDO
1091C-----------------in global ref : EPSX............-----------
1092 IF(kcvt==2)THEN
1093 gama(1)=gbuf%GAMA(kk(1) + i)
1094 gama(2)=gbuf%GAMA(kk(2) + i)
1095 gama(3)=gbuf%GAMA(kk(3) + i)
1096 gama(4)=gbuf%GAMA(kk(4) + i)
1097 gama(5)=gbuf%GAMA(kk(5) + i)
1098 gama(6)=gbuf%GAMA(kk(6) + i)
1099 ELSE
1100 gama(1)=one
1101 gama(2)=zero
1102 gama(3)=zero
1103 gama(4)=zero
1104 gama(5)=one
1105 gama(6)=zero
1106 END IF
1107
1108 CALL srota6(x,ixs(1,n),kcvt,strain,gama,khbe,igtyp,isorth)
1109
1110 DO j=1,3
1111 wwa(1618 + j) = strain(j) ! mean strain in global skew
1112 ENDDO
1113C Problem of order of output EPSZX before EPSYZ (see THGROU)
1114 wwa(1618 + 4) = strain(4)
1115 wwa(1618 + 5) = strain(6)
1116 wwa(1618 + 6) = strain(5)
1117
1118c--------
1119 ELSEIF (npt == 1) THEN
1120c--------
1121 DO j=1,6
1122 strain(j) = zero
1123 ENDDO
1124 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
1125 IF (mte == 12 .OR. mte == 14) THEN
1126 DO j= 1,3
1127 wwa(239030 + j) = lbuf%EPE(kk(j)+i)
1128 strain(j) = lbuf%EPE(kk(j)+i)
1129 ENDDO
1130 ELSEIF (elbuf_tab(ng)%BUFLY(1)%L_STRA > 0) THEN
1131 DO j= 1,3
1132 wwa(239030 + j) = lbuf%STRA(kk(j)+i)
1133 strain(j) = lbuf%STRA(kk(j)+i)
1134 ENDDO
1135 DO j= 4,6
1136 wwa(239030 + j) = lbuf%STRA(kk(j)+i)*half
1137 strain(j) = lbuf%STRA(kk(j)+i)*half
1138 ENDDO
1139
1140 ENDIF
1141
1142C-----------------in local ref : L_EPSX............-----------
1143 DO j= 1,6
1144 wwa(239030 + j) = strain(j)
1145 ENDDO
1146C-----------------in global ref : EPSX............-----------
1147 IF(kcvt==2)THEN
1148 gama(1)=gbuf%GAMA(kk(1) + i)
1149 gama(2)=gbuf%GAMA(kk(2) + i)
1150 gama(3)=gbuf%GAMA(kk(3) + i)
1151 gama(4)=gbuf%GAMA(kk(4) + i)
1152 gama(5)=gbuf%GAMA(kk(5) + i)
1153 gama(6)=gbuf%GAMA(kk(6) + i)
1154 ELSE
1155 gama(1)=one
1156 gama(2)=zero
1157 gama(3)=zero
1158 gama(4)=zero
1159 gama(5)=one
1160 gama(6)=zero
1161 END IF
1162
1163 CALL srota6(x,ixs(1,n),kcvt,strain,gama,khbe,igtyp,isorth)
1164
1165 DO j=1,3
1166 wwa(1618 + j) = strain(j) ! mean stress in global skew
1167 ENDDO
1168C Problem of order of output EPSZX before EPSYZ (see THGROU)
1169 wwa(1618 + 4) = strain(4)
1170 wwa(1618 + 5) = strain(6)
1171 wwa(1618 + 6) = strain(5)
1172
1173 ENDIF ! NPT
1174c---------------
1175c ELSEIF((ISOLNOD == 16.OR.(ISOLNOD == 8 .AND.KHBE == 14)
1176c . .OR.((ISOLNOD == 6.OR. ISOLNOD == 8).AND.KHBE == 15))
1177c . .AND. IGTYP == 22) THEN
1178
1179 ELSEIF (tshell == 1) THEN
1180c----------------------------------------------------------------------------
1181C------------------------Output SIG_IK_J SIJK EPS L_EPS---------------------
1182C---------------------------------------------------------------------------
1183
1184 pid=ixs(10,1 + nft)
1185 nptg = nptr * npts * nlay
1186 jj = 6*(i-1)
1187 DO ir=1,nptr
1188 DO is=1,npts
1189 DO it=1,nlay
1190 IF (mte == 12 .OR. mte == 14)THEN
1191 DO j=1,3
1192 evar_tmp(j) = lbuf%EPE(kk(j)+i)
1193 ENDDO
1194 evar_tmp(3:6) = zero
1195 ENDIF
1196
1197 ipt = ir + ( (is-1) + (it-1)*npts )*nptr
1198
1199 IF (ipt <= nptg .AND. ir <= nptr .AND. is <= npts .AND. it <= nlay) THEN
1200 IF (elbuf_tab(ng)%BUFLY(it)%L_STRA > 0) THEN
1201 lbuf => elbuf_tab(ng)%BUFLY(it)%LBUF(ir,is,1)
1202 evar_tmp(1) = lbuf%STRA(kk(1)+i)
1203 evar_tmp(2) = lbuf%STRA(kk(2)+i)
1204 evar_tmp(3) = lbuf%STRA(kk(3)+i)
1205 evar_tmp(4) = lbuf%STRA(kk(4)+i)*half
1206 evar_tmp(5) = lbuf%STRA(kk(5)+i)*half
1207 evar_tmp(6) = lbuf%STRA(kk(6)+i)*half
1208 ENDIF
1209
1210 DO j = 1, 6
1211 strain(j) = strain(j) + evar_tmp(j)/nptg
1212 ENDDO
1213
1214C STRAIN TENSOR IN GLOBAL SYSTEM
1215 icsig=iparg(17,ng)
1216 IF (khbe == 14.AND.icsig > 0) THEN
1217 SELECT CASE (icsig)
1218 CASE (1)
1219 IF(kcvt==2)THEN
1220 gama(1)= zero
1221 gama(2)= lbuf%GAMA(kk(1)+i)
1222 gama(3)= lbuf%GAMA(kk(2)+i)
1223 gama(4)= zero
1224 gama(5)=-gama(2)
1225 gama(6)= gama(1)
1226 ELSE
1227 gama(1)=one
1228 gama(2)=zero
1229 gama(3)=zero
1230 gama(4)=zero
1231 gama(5)=one
1232 gama(6)=zero
1233 END IF
1234 CASE (10)
1235 IF(kcvt==2)THEN
1236 gama(1)= lbuf%GAMA(kk(1)+i)
1237 gama(2)= lbuf%GAMA(kk(2)+i)
1238 gama(3)= zero
1239 gama(4)=-gama(2)
1240 gama(5)= gama(1)
1241 gama(6)= zero
1242 ELSE
1243 gama(1)=one
1244 gama(2)=zero
1245 gama(3)=zero
1246 gama(4)=zero
1247 gama(5)=one
1248 gama(6)=zero
1249 END IF
1250 CASE (100)
1251 IF(kcvt==2)THEN
1252 gama(1)= lbuf%GAMA(kk(2)+i)
1253 gama(2)= zero
1254 gama(3)= lbuf%GAMA(kk(1)+i)
1255 gama(4)= gama(3)
1256 gama(5)= zero
1257 gama(6)=-gama(1)
1258 ELSE
1259 gama(1)=one
1260 gama(2)=zero
1261 gama(3)=zero
1262 gama(4)=zero
1263 gama(5)=one
1264 gama(6)=zero
1265 END IF
1266 END SELECT
1267 ELSE
1268
1269 IF(kcvt==2)THEN
1270 gama(1)=gbuf%GAMA(kk(1) + i)
1271 gama(2)=gbuf%GAMA(kk(2) + i)
1272 gama(3)=gbuf%GAMA(kk(3) + i)
1273 gama(4)=gbuf%GAMA(kk(4) + i)
1274 gama(5)=gbuf%GAMA(kk(5) + i)
1275 gama(6)=gbuf%GAMA(kk(6) + i)
1276 ELSE
1277 gama(1)=one
1278 gama(2)=zero
1279 gama(3)=zero
1280 gama(4)=zero
1281 gama(5)=one
1282 gama(6)=zero
1283 END IF
1284
1285 ENDIF
1286
1287 CALL srota6(x,ixs(1,n),kcvt,evar_tmp,gama,khbe,igtyp,isorth)
1288
1289 DO j = 1, 6
1290 evar(j) = evar(j) + evar_tmp(j)/nptg
1291 ENDDO
1292C
1293 IF(igtyp == 22) THEN
1294C------------------------Output SIG_IK_J---------------------
1295 mbuf => elbuf_tab(ng)%BUFLY(it)%MAT(ir,is,1)
1296 cpt=(it-1)*9*9*6+((ir-1)*9+is-1)*6
1297c S11
1298 wwa(98846+cpt+1) = lbuf%SIG(kk(1)+i)
1299c S12
1300 wwa(98846+cpt+2) = lbuf%SIG(kk(4)+i)
1301c S13
1302 wwa(98846+cpt+3) = lbuf%SIG(kk(6)+i)
1303c S22
1304 wwa(98846+cpt+4) = lbuf%SIG(kk(2)+i)
1305c S23
1306 wwa(98846+cpt+5) = lbuf%SIG(kk(5)+i)
1307c S33
1308 wwa(98846+cpt+6) = lbuf%SIG(kk(3)+i)
1309 IF(ivisc > 0) THEN
1310 wwa(98846+cpt+1)=wwa(98846+cpt+1) + lbuf%VISC(kk(1)+i)
1311 wwa(98846+cpt+2)=wwa(98846+cpt+2) + lbuf%VISC(kk(4)+i)
1312 wwa(98846+cpt+3)=wwa(98846+cpt+3) + lbuf%VISC(kk(6)+i)
1313 wwa(98846+cpt+4)=wwa(98846+cpt+4) + lbuf%VISC(kk(2)+i)
1314 wwa(98846+cpt+5)=wwa(98846+cpt+5) + lbuf%VISC(kk(5)+i)
1315 wwa(98846+cpt+6)=wwa(98846+cpt+6) + lbuf%VISC(kk(3)+i)
1316 ENDIF
1317 IF (mte == 12 .OR. mte == 14) THEN
1318 wwa(1646+cpt+1) = lbuf%EPE(kk(1)+i) !NB14
1319 wwa(1646+cpt+2) = lbuf%EPE(kk(2)+i)
1320 wwa(1646+cpt+3) = lbuf%EPE(kk(3)+i)
1321 ELSEIF (elbuf_tab(ng)%BUFLY(it)%L_STRA > 0) THEN
1322 wwa(1646+cpt+1) = lbuf%STRA(kk(1)+i) ! NB13
1323 wwa(1646+cpt+2) = lbuf%STRA(kk(2)+i)
1324 wwa(1646+cpt+3) = lbuf%STRA(kk(3)+i)
1325 wwa(1646+cpt+4) = lbuf%STRA(kk(4)+i)*half
1326 wwa(1646+cpt+5) = lbuf%STRA(kk(5)+i)*half
1327 wwa(1646+cpt+6) = lbuf%STRA(kk(6)+i)*half
1328 ELSE
1329 wwa(1646+cpt+1) = zero
1330 wwa(1646+cpt+2) = zero
1331 wwa(1646+cpt+3) = zero
1332 wwa(1646+cpt+4) = zero
1333 wwa(1646+cpt+5) = zero
1334 wwa(1646+cpt+6) = zero
1335 ENDIF
1336C
1337 ELSE ! No IGTYP 22
1338C------------------------Output SIJK---------------------
1339
1340 mbuf => elbuf_tab(ng)%BUFLY(it)%MAT(ir,is,1)
1341 ipwwa = (ir-1)*3*9*7 + (it-1)*3*7 + (is-1)*7
1342 DO j=1,6
1343 sigg(j) = lbuf%SIG(kk(j)+i)
1344 ENDDO
1345 IF(ivisc > 0) THEN
1346 DO j=1,6
1347 sigg(j) = sigg(j) + lbuf%VISC(kk(j)+i)
1348 ENDDO
1349 ENDIF
1350
1351C Deformation plastique
1352 IF (mte >= 28) THEN
1353 IF (nuvar > 0) THEN
1354 plag = mbuf%VAR(i)
1355 ENDIF
1356 ELSE
1357 IF (elbuf_tab(ng)%BUFLY(1)%L_PLA > 0) THEN
1358 plag = lbuf%PLA(i)
1359 ENDIF
1360 ENDIF
1361
1362 CALL srota6(x,ixs(1,n),kcvt,sigg,gama,khbe,igtyp,isorth)
1363
1364C-----------------in global ref : SXIJK............-----------
1365 DO j=1,6
1366 wwa(196+ipwwa +j) = sigg(j)
1367 ENDDO
1368C-----------------in global ref : PLAIJK............-----------
1369 wwa(196+ipwwa +7) = plag
1370C-----------------in global ref : EPSIJK............-----------
1371 DO j=1,6
1372 wwa(239060+ipwwa +j) = evar_tmp(j)
1373 ENDDO
1374
1375 ENDIF
1376 ELSE
1377 wwa(196+cpt +1) = zero
1378 wwa(196+cpt +2) = zero
1379 wwa(196+cpt +3) = zero
1380 wwa(196+cpt +4) = zero
1381 wwa(196+cpt +5) = zero
1382 wwa(196+cpt +6) = zero
1383
1384 wwa(1646+cpt+1) = zero
1385 wwa(1646+cpt+2) = zero
1386 wwa(1646+cpt+3) = zero
1387 wwa(1646+cpt+4) = zero
1388 wwa(1646+cpt+5) = zero
1389 wwa(1646+cpt+6) = zero
1390
1391 wwa(120338+cpt+1)= zero
1392 wwa(120338+cpt+2)= zero
1393 wwa(120338+cpt+3)= zero
1394 wwa(120338+cpt+4)= zero
1395 wwa(120338+cpt+5)= zero
1396 wwa(120338+cpt+6)= zero
1397 ENDIF
1398
1399 ENDDO
1400 ENDDO
1401 ENDDO
1402C-----------------in local ref : L_EPSX............-----------
1403 DO j= 1,6
1404 wwa(239036+j) = strain(j)
1405 ENDDO
1406C-----------------in global ref : EPSX............-----------
1407
1408 DO j= 1,3
1409 wwa(1618+j) = evar(j)
1410 ENDDO
1411C Problem of order of output EPSZX before EPSYZ (see THGROU)
1412 wwa(1618 + 4) = evar(4)
1413 wwa(1618 + 5) = evar(6)
1414 wwa(1618 + 6) = evar(5)
1415
1416c---------------
1417 ELSEIF (isolnod == 8.AND.(khbe == 14.OR.khbe == 17))THEN
1418c----------------------------------------------------------------------------
1419C------------------------Output SIJK EPS L_EPS---------------------
1420C---------------------------------------------------------------------------
1421c---------------
1422 jj = 6*(i-1)
1423 nptg=nptt*npts*nptr
1424 DO j=1, 100
1425 user(j) = zero
1426 ENDDO
1427C-----------------
1428
1429 DO is=1,npts
1430 ispau= 1
1431 DO it=1,nptt
1432 DO ir=1,nptr
1433c
1434 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ir,is,it)
1435 mbuf => elbuf_tab(ng)%BUFLY(1)%MAT(ir,is,it)
1436c
1437C IPWWA calcule sur la base de 3*9*3 points d'integration (r*s*t)
1438 ipt = ir + ( (is-1) + (it-1)*npts )*nptr
1439C IPWWA calcule sur la base de 3*9*3 points d'integration (s*t*r)
1440 ipwwa = (ir-1)*3*9*7 + (it-1)*3*7 + (is-1)*7
1441 iuwwa = (ir-1)*3*9*9 + (it-1)*3*9 + (is-1)*9
1442c
1443 DO itens=1,6
1444c WWA(196+IPWWA+ITENS)=LBUF%SIG(KK(ITENS)+I)
1445 sigp(itens,ispau,is)=lbuf%SIG(kk(itens)+i)
1446 sigg(itens) = lbuf%SIG(kk(itens)+i)
1447 ENDDO
1448
1449 IF(ivisc > 0) then
1450 DO itens=1,6
1451 sigp(itens,ispau,is)=sigp(itens,ispau,is) + lbuf%VISC(kk(itens)+i)
1452 sigg(itens) = sigg(itens) + lbuf%VISC(kk(itens)+i)
1453 ENDDO
1454 ENDIF
1455c
1456C Deformation plastique
1457 IF (mte >= 28) THEN
1458 IF (nuvar > 0) THEN
1459 sigp(7,ispau,is) = mbuf%VAR(i)
1460 plag = mbuf%VAR(i)
1461 ENDIF
1462C
1463C we can get just 9 user variables by integration point
1464 nuvarth = min(9,nuvar)
1465 DO j = 1,nuvarth
1466 wwa(889+j+iuwwa) = mbuf%VAR((j-1)*nel+i)
1467 ENDDO
1468C we can get just 60 average user variables
1469 nuvarth = min(60,nuvar)
1470 DO j=1, nuvarth
1471 user(j) = user(j) + mbuf%VAR(i + (j-1)*nel )/npt
1472 wwa(889 + j + iuwwa) = mbuf%VAR(i + (j-1)*nel )
1473 ENDDO
1474
1475 IF (elbuf_tab(ng)%BUFLY(1)%L_STRA > 0) THEN
1476 evar_tmp(1) = lbuf%STRA(kk(1)+i)
1477 evar_tmp(2) = lbuf%STRA(kk(2)+i)
1478 evar_tmp(3) = lbuf%STRA(kk(3)+i)
1479 evar_tmp(4) = lbuf%STRA(kk(4)+i)*half
1480 evar_tmp(5) = lbuf%STRA(kk(5)+i)*half
1481 evar_tmp(6) = lbuf%STRA(kk(6)+i)*half
1482 ENDIF
1483 ELSE
1484 IF (elbuf_tab(ng)%BUFLY(1)%L_PLA > 0) THEN
1485 sigp(7,ispau,is) = lbuf%PLA(i)
1486 plag= lbuf%PLA(i)
1487 ENDIF
1488
1489 IF (mte == 12 .OR. mte == 14)THEN
1490 DO j=1,3
1491 evar_tmp(j) = lbuf%EPE(kk(j)+i)
1492 ENDDO
1493 evar_tmp(3:6) = zero
1494 ELSEIF (elbuf_tab(ng)%BUFLY(1)%L_STRA > 0) THEN
1495 evar_tmp(1) = lbuf%STRA(kk(1)+i)
1496 evar_tmp(2) = lbuf%STRA(kk(2)+i)
1497 evar_tmp(3) = lbuf%STRA(kk(3)+i)
1498 evar_tmp(4) = lbuf%STRA(kk(4)+i)*half
1499 evar_tmp(5) = lbuf%STRA(kk(5)+i)*half
1500 evar_tmp(6) = lbuf%STRA(kk(6)+i)*half
1501 ENDIF
1502 ENDIF
1503 ispau=ispau+1
1504
1505 DO j = 1, 6
1506 strain(j) = strain(j) + evar_tmp(j)/nptg
1507 ENDDO
1508C-----------------in global ref : SXIJK EPIJK............-----------
1509
1510 icsig=iparg(17,ng)
1511 IF (khbe == 14.AND.icsig > 0) THEN
1512 SELECT CASE (icsig)
1513 CASE (1)
1514 IF(kcvt==2)THEN
1515 gama(1)= zero
1516 gama(2)= lbuf%GAMA(kk(1)+i)
1517 gama(3)= lbuf%GAMA(kk(2)+i)
1518 gama(4)= zero
1519 gama(5)=-gama(2)
1520 gama(6)= gama(1)
1521 ELSE
1522 gama(1)=one
1523 gama(2)=zero
1524 gama(3)=zero
1525 gama(4)=zero
1526 gama(5)=one
1527 gama(6)=zero
1528 END IF
1529 CASE (10)
1530 IF(kcvt==2)THEN
1531 gama(1)= lbuf%GAMA(kk(1)+i)
1532 gama(2)= lbuf%GAMA(kk(2)+i)
1533 gama(3)= zero
1534 gama(4)=-gama(2)
1535 gama(5)= gama(1)
1536 gama(6)= zero
1537 ELSE
1538 gama(1)=one
1539 gama(2)=zero
1540 gama(3)=zero
1541 gama(4)=zero
1542 gama(5)=one
1543 gama(6)=zero
1544 END IF
1545 CASE (100)
1546 IF(kcvt==2)THEN
1547 gama(1)= lbuf%GAMA(kk(2)+i)
1548 gama(2)= zero
1549 gama(3)= lbuf%GAMA(kk(1)+i)
1550 gama(4)= gama(3)
1551 gama(5)= zero
1552 gama(6)=-gama(1)
1553 ELSE
1554 gama(1)=one
1555 gama(2)=zero
1556 gama(3)=zero
1557 gama(4)=zero
1558 gama(5)=one
1559 gama(6)=zero
1560 END IF
1561 END SELECT
1562
1563 ELSE
1564
1565 IF(kcvt==2)THEN
1566 gama(1)=gbuf%GAMA(kk(1) + i)
1567 gama(2)=gbuf%GAMA(kk(2) + i)
1568 gama(3)=gbuf%GAMA(kk(3) + i)
1569 gama(4)=gbuf%GAMA(kk(4) + i)
1570 gama(5)=gbuf%GAMA(kk(5) + i)
1571 gama(6)=gbuf%GAMA(kk(6) + i)
1572 ELSE
1573 gama(1)=one
1574 gama(2)=zero
1575 gama(3)=zero
1576 gama(4)=zero
1577 gama(5)=one
1578 gama(6)=zero
1579 END IF
1580
1581
1582 ENDIF
1583
1584 CALL srota6(x,ixs(1,n),kcvt,sigg ,gama,khbe,igtyp,isorth)
1585 CALL srota6(x,ixs(1,n),kcvt,evar_tmp,gama,khbe,igtyp,isorth)
1586
1587C-----------------in global ref : SXIJK............-----------
1588 DO j=1,6
1589 wwa(196+ipwwa+j) = sigg(j)
1590 ENDDO
1591C-----------------in global ref : PLAIJK............-----------
1592 wwa(196+ipwwa +7) = plag
1593C-----------------in global ref : EPSIJK............-----------
1594 DO j=1,6
1595 wwa(239060+ipwwa+j) = evar_tmp(j)
1596 ENDDO
1597
1598 DO j = 1, 6
1599 evar(j) = evar(j) + evar_tmp(j)/nptg
1600 ENDDO
1601
1602 ENDDO
1603 ENDDO
1604 ENDDO
1605C-----------------
1606 IF (mte >= 28)THEN
1607C we can get just 60 user variables
1608 nuvarth = min(60,nuvar)
1609 DO j=1, nuvarth
1610 wwa(136 + j) = user(j)
1611 ENDDO
1612 ENDIF
1613
1614
1615C
1616C-----------------in local ref : L_EPSX............-----------
1617 DO j = 1, 6
1618 wwa(239030 + j) = strain(j)
1619 ENDDO
1620C-----------------in global ref : EPSX............-----------
1621 DO j = 1, 3
1622 wwa(1618 + j) = evar(j)
1623 ENDDO
1624C Problem of order of output EPSZX before EPSYZ (see THGROU)
1625 wwa(1618 + 4) = evar(4)
1626 wwa(1618 + 5) = evar(6)
1627 wwa(1618 + 6) = evar(5)
1628C----------------------------------------
1629 ENDIF
1630C-----------------------------------
1631 ELSE ! kcvt = 0
1632C-----------------------------------
1633C GLOBAL FORMULATION ONLY :
1634C 40+I SX at Gauss point I
1635C 48+I SY at Gauss point I
1636C 56+I SZ at Gauss point I
1637C 64+I SXY at Gauss point I
1638C 72+I SYZ at Gauss point I
1639C 80+I SXZ at Gauss point I
1640C-----------------------------------
1641 IF (isolnod == 4) THEN
1642c----------------------------------------------------------------------------
1643C------------------------Output SXI .. EPSXI.. EPS L_EPS---------------------
1644C---------------------------------------------------------------------------
1645 IF(isrot == 1 )THEN
1646 jj = 6*(i-1)
1647 DO ipt=1,npt
1648 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ipt,1,1)
1649 mbuf => elbuf_tab(ng)%BUFLY(1)%MAT(ipt,1,1)
1650 wwa(40+ipt)=lbuf%SIG(kk(1)+i)
1651 wwa(48+ipt)=lbuf%SIG(kk(2)+i)
1652 wwa(56+ipt)=lbuf%SIG(kk(3)+i)
1653 wwa(64+ipt)=lbuf%SIG(kk(4)+i)
1654 wwa(72+ipt)=lbuf%SIG(kk(5)+i)
1655 wwa(80+ipt)=lbuf%SIG(kk(6)+i)
1656 IF(ivisc > 0 ) THEN
1657 wwa(40+ipt)=wwa(40+ipt) + lbuf%VISC(kk(1)+i)
1658 wwa(48+ipt)=wwa(48+ipt) + lbuf%VISC(kk(2)+i)
1659 wwa(56+ipt)=wwa(56+ipt) + lbuf%VISC(kk(3)+i)
1660 wwa(64+ipt)=wwa(64+ipt) + lbuf%VISC(kk(4)+i)
1661 wwa(72+ipt)=wwa(72+ipt) + lbuf%VISC(kk(5)+i)
1662 wwa(80+ipt)=wwa(80+ipt) + lbuf%VISC(kk(6)+i)
1663 ENDIF
1664
1665 IF(mte == 12 .OR. mte == 14) THEN
1666 DO j = 1, 3
1667 strain(j) = strain(j) + lbuf%EPE(kk(j)+i)/npt !NB14
1668 ENDDO
1669 wwa(239036+ipt)=lbuf%STRA(kk(1)+i)
1670 wwa(239040+ipt)=lbuf%STRA(kk(2)+i)
1671 wwa(239044+ipt)=lbuf%STRA(kk(3)+i)
1672 ELSEIF (elbuf_tab(ng)%BUFLY(1)%L_STRA > 0) THEN
1673 DO j = 1, 6
1674 strain(j)= strain(j) + lbuf%STRA(kk(j)+i)/npt
1675 ENDDO
1676C-----------------in global ref : EPSXI............-----------
1677 wwa(239036+ipt)=lbuf%STRA(kk(1)+i)
1678 wwa(239040+ipt)=lbuf%STRA(kk(2)+i)
1679 wwa(239044+ipt)=lbuf%STRA(kk(3)+i)
1680 wwa(239048+ipt)=lbuf%STRA(kk(4)+i) *half
1681 wwa(239052+ipt)=lbuf%STRA(kk(5)+i) *half
1682 wwa(239056+ipt)=lbuf%STRA(kk(6)+i) *half
1683 ENDIF ! MTN
1684 ENDDO ! LOOP OVER NPT, ISOLNOD = 4 and Isrot =
1685c
1686
1687C-----------------in Global ref : EPSX............-----------
1688 DO j = 1, 3
1689 wwa(1618 + j) = strain(j)
1690 ENDDO
1691C Problem of order of output EPSZX before EPSYZ (see THGROU)
1692 wwa(1618 + 4) = strain(4)
1693 wwa(1618 + 5) = strain(6)
1694 wwa(1618 + 6) = strain(5)
1695C-----------------in local ref : L_EPSX............-----------
1696 DO j = 1, 6
1697 wwa(239030 + j) = strain(j)
1698 ENDDO
1699c----
1700
1701 ELSEIF(isrot == 0) THEN
1702 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
1703c
1704 IF (mte == 12 .OR. mte == 14) THEN
1705 DO j= 1,3
1706 strain(j) = lbuf%EPE(kk(j)+i)
1707 ENDDO
1708 ELSEIF (elbuf_tab(ng)%BUFLY(1)%L_STRA > 0) THEN
1709 DO j= 1,6
1710 strain(j) = lbuf%STRA(kk(j)+i)
1711 ENDDO
1712 ENDIF
1713
1714C-----------------in Global ref : EPSX............-----------
1715 DO j = 1, 3
1716 wwa(1618 + j) = strain(j)
1717 ENDDO
1718C Problem of order of output EPSZX before EPSYZ (see THGROU)
1719 wwa(1618 + 4) = strain(4)
1720 wwa(1618 + 5) = strain(6)
1721 wwa(1618 + 6) = strain(5)
1722C-----------------in local ref : L_EPSX............-----------
1723 DO j = 1, 6
1724 wwa(239030 + j) = strain(j)
1725 ENDDO
1726
1727 ENDIF
1728c----
1729 ELSEIF (isolnod == 10) THEN
1730c----------------------------------------------------------------------------
1731C------------------------Output SXI .. EPSXI.. EPS L_EPS---------------------
1732C---------------------------------------------------------------------------
1733 jj = 6*(i-1)
1734 DO j=1,100
1735 user(j) = zero
1736 ENDDO
1737
1738 DO ipt=1,npt
1739 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ipt,1,1)
1740 mbuf => elbuf_tab(ng)%BUFLY(1)%MAT(ipt,1,1)
1741 wwa(40+ipt)=lbuf%SIG(kk(1)+i)
1742 wwa(48+ipt)=lbuf%SIG(kk(2)+i)
1743 wwa(56+ipt)=lbuf%SIG(kk(3)+i)
1744 wwa(64+ipt)=lbuf%SIG(kk(4)+i)
1745 wwa(72+ipt)=lbuf%SIG(kk(5)+i)
1746 wwa(80+ipt)=lbuf%SIG(kk(6)+i)
1747 IF(ivisc > 0 ) THEN
1748 wwa(40+ipt)=wwa(40+ipt) + lbuf%VISC(kk(1)+i)
1749 wwa(48+ipt)=wwa(48+ipt) + lbuf%VISC(kk(2)+i)
1750 wwa(56+ipt)=wwa(56+ipt) + lbuf%VISC(kk(3)+i)
1751 wwa(64+ipt)=wwa(64+ipt) + lbuf%VISC(kk(4)+i)
1752 wwa(72+ipt)=wwa(72+ipt) + lbuf%VISC(kk(5)+i)
1753 wwa(80+ipt)=wwa(80+ipt) + lbuf%VISC(kk(6)+i)
1754 ENDIF
1755 IF (mte >= 28) THEN
1756 nuvarth = min(60,nuvar)
1757 DO j=1, nuvarth
1758 user(j) = user(j) +
1759 . mbuf%VAR(i + (j-1)*nel )/npt
1760 ENDDO
1761 IF (elbuf_tab(ng)%BUFLY(1)%L_STRA > 0) THEN
1762 DO j = 1, 6
1763 strain(j)= strain(j) + lbuf%STRA(kk(j)+i)/npt
1764 ENDDO
1765 wwa(239036+ipt)=lbuf%STRA(kk(1)+i)
1766 wwa(239040+ipt)=lbuf%STRA(kk(2)+i)
1767 wwa(239044+ipt)=lbuf%STRA(kk(3)+i)
1768 wwa(239048+ipt)=lbuf%STRA(kk(4)+i) *half
1769 wwa(239052+ipt)=lbuf%STRA(kk(5)+i) *half
1770 wwa(239056+ipt)=lbuf%STRA(kk(6)+i) *half
1771 ENDIF
1772 ELSEIF(mte == 12 .OR. mte == 14) THEN
1773 DO j = 1, 3
1774 strain(j) = strain(j) + lbuf%EPE(kk(j)+i)/npt !NB14
1775 ENDDO
1776 wwa(239036+ipt)=lbuf%EPE(kk(1)+i)
1777 wwa(239040+ipt)=lbuf%EPE(kk(2)+i)
1778 wwa(239044+ipt)=lbuf%EPE(kk(3)+i)
1779 ELSEIF (elbuf_tab(ng)%BUFLY(1)%L_STRA > 0) THEN
1780 DO j= 1,6
1781 strain(j) = strain(j) + lbuf%STRA(kk(j)+i)/nptg
1782 ENDDO
1783
1784 wwa(239036+ipt)=lbuf%STRA(kk(1)+i)
1785 wwa(239040+ipt)=lbuf%STRA(kk(2)+i)
1786 wwa(239044+ipt)=lbuf%STRA(kk(3)+i)
1787 wwa(239048+ipt)=lbuf%STRA(kk(4)+i) *half
1788 wwa(239052+ipt)=lbuf%STRA(kk(5)+i) *half
1789 wwa(239056+ipt)=lbuf%STRA(kk(6)+i) *half
1790 ENDIF ! MTN
1791 ENDDO ! LOOP OVER NPT, ISOLNOD = 10
1792c
1793 IF ( mte >= 28) THEN
1794C User laws for solids we can have just 60 user variables.
1795 nuvarth = min(60,nuvar)
1796 DO j=1,nuvarth
1797 wwa(136+j)= user(j)
1798 ENDDO
1799 ENDIF
1800
1801C-----------------in Global ref : EPSX............-----------
1802 DO j = 1, 3
1803 wwa(1618 + j) = strain(j)
1804 ENDDO
1805C Problem of order of output EPSZX before EPSYZ (see THGROU)
1806 wwa(1618 + 4) = strain(4)
1807 wwa(1618 + 5) = strain(6)
1808 wwa(1618 + 6) = strain(5)
1809C-----------------in local ref : L_EPSX............-----------
1810 DO j = 1, 6
1811 wwa(239030 + j) = strain(j)
1812 ENDDO
1813
1814c----
1815 ELSEIF( isolnod == 16 .OR. isolnod == 20 .OR. (isolnod == 8.AND.(khbe == 14.OR.khbe == 17)))THEN
1816c----------------------------------------------------------------------------
1817C------------------------Output SIJK EPS L_EPS---------------------
1818C---------------------------------------------------------------------------
1819c
1820
1821 jj = 6*(i-1)
1822 nptg=nptt*npts*nptr*nlay
1823 DO j=1, 100
1824 user(j) = zero
1825 ENDDO
1826
1827 DO il =1,nlay
1828
1829 DO is=1,npts
1830 ispau= 1
1831 DO it=1,nptt
1832 DO ir=1,nptr
1833 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)
1834 mbuf => elbuf_tab(ng)%BUFLY(il)%MAT(ir,is,it)
1835c
1836C IPWWA calcule sur la base de 3*9*3 points d'integration (r*s*t)
1837 cpt=(it-1)*99*6+((ir-1)*9+is-1)*6
1838
1839 ipt = ir + ( (is-1) + (it-1)*npts )*nptr
1840 ipwwa = (it-1)*3*9*7 + (is-1)*3*7 + (ir-1)*7
1841 iuwwa = (it-1)*3*9*9 + (is-1)*3*9 + (ir-1)*9
1842 IF(isolnod == 8)THEN
1843 ipwwa = (ir-1)*3*9*7 + (it-1)*3*7 + (is-1)*7
1844 iuwwa = (ir-1)*3*9*9 + (it-1)*3*9 + (is-1)*9
1845 ENDIF
1846 IF(isolnod == 16)THEN
1847 ipt = ir + ( (il-1) + (it-1)*nlay )*nptr
1848 ipwwa = (it-1)*3*9*7 + (il-1)*3*7 + (ir-1)*7
1849 iuwwa = (it-1)*3*9*9 + (il-1)*3*9 + (ir-1)*9
1850 ENDIF
1851c
1852 DO itens=1,6
1853 wwa(196+ipwwa+itens) = lbuf%SIG(kk(itens)+i)
1854 sigp(itens,ispau,is) = lbuf%SIG(kk(itens)+i)
1855 ENDDO
1856C Deformation plastique
1857 IF (mte >= 28) THEN
1858 IF (nuvar > 0) THEN
1859 wwa(196+ipwwa+7) = mbuf%VAR(i)
1860 sigp(7,ispau,is) = mbuf%VAR(i)
1861 ENDIF
1862C just 9 user variables by integration point
1863 nuvarth = min(9,nuvar)
1864 DO j=1, nuvarth
1865 wwa(889 + j + iuwwa) = mbuf%VAR(i+(j-1)*nel)
1866 ENDDO
1867C 60 average user variable
1868 nuvarth = min(60,nuvar)
1869 DO j=1, nuvarth
1870 user(j) = user(j)+mbuf%VAR(i+(j-1)*nel)/nptg
1871 wwa(889+j+iuwwa) =mbuf%VAR(i+(j-1)*nel)
1872 ENDDO
1873 IF (elbuf_tab(ng)%BUFLY(1)%L_STRA > 0)THEN
1874 DO j = 1, 3
1875 strain(j) = strain(j) + lbuf%STRA(kk(j)+i)/nptg
1876 wwa(239060+ipwwa+j)=lbuf%STRA(kk(j)+i)
1877 ENDDO
1878 DO j = 4, 6
1879 strain(j) = strain(j) + lbuf%STRA(kk(j)+i)*half/nptg
1880 wwa(239060+ipwwa+j)=lbuf%STRA(kk(j)+i) *half
1881 ENDDO
1882 ENDIF
1883c
1884 ELSE ! IF MTE
1885c
1886 IF (elbuf_tab(ng)%BUFLY(1)%L_PLA > 0) THEN
1887 wwa(196 + ipwwa + 7)=lbuf%PLA(i)
1888 sigp(7,ispau,is)= lbuf%PLA(i)
1889 ENDIF
1890 IF (mte==12 .OR. mte == 14) THEN
1891 DO j=1,3
1892 strain(j) = strain(j) + lbuf%EPE(kk(j)+i)/nptg
1893 wwa(239060+ipwwa+j)=lbuf%EPE(kk(j)+i)
1894 ENDDO
1895 ELSEIF (elbuf_tab(ng)%BUFLY(1)%L_STRA > 0)THEN
1896 DO j = 1, 3
1897 strain(j) = strain(j) + lbuf%STRA(kk(j)+i)/nptg
1898 wwa(239060+ipwwa+j)=lbuf%STRA(kk(j)+i)
1899 ENDDO
1900 DO j = 4, 6
1901 strain(j) = strain(j) + lbuf%STRA(kk(j)+i)*half/nptg
1902 wwa(239060+ipwwa+j)=lbuf%STRA(kk(j)+i) *half
1903 ENDDO
1904 ENDIF
1905 ENDIF
1906 ispau=ispau+1
1907 ENDDO
1908 ENDDO
1909 ENDDO
1910 ENDDO
1911
1912
1913 IF (mte >= 28) THEN
1914C just 60 average user variable
1915 nuvarth = min(60,nuvar)
1916 DO j=1, nuvarth
1917 wwa(136 + j) = user(j)
1918 ENDDO
1919 ENDIF
1920C-----------------in local ref : L_EPSX............-----------
1921 IF (khbe == 17) THEN
1922 IF (kcvt==-1)THEN
1923 gama(1)=gbuf%GAMA(kk(1) + i)
1924 gama(2)=gbuf%GAMA(kk(2) + i)
1925 gama(3)=gbuf%GAMA(kk(3) + i)
1926 gama(4)=gbuf%GAMA(kk(4) + i)
1927 gama(5)=gbuf%GAMA(kk(5) + i)
1928 gama(6)=gbuf%GAMA(kk(6) + i)
1929 CALL srota6(x,ixs(1,n),2,strain,gama,khbe,igtyp,isorth)
1930 ENDIF
1931 ENDIF
1932 DO j = 1, 6
1933 wwa(239030 + j) = strain(j)
1934 ENDDO
1935C-----------------in Global ref : EPSX............-----------
1936 DO j = 1, 3
1937 wwa(1618 + j) = strain(j)
1938 ENDDO
1939C Problem of order of output EPSZX before EPSYZ (see THGROU)
1940 wwa(1618 + 4) = strain(4)
1941 wwa(1618 + 5) = strain(6)
1942 wwa(1618 + 6) = strain(5)
1943C
1944C STRESS VALUES AT FACES (TOP & BOTTOM)
1945C
1946 IF(isolnod == 16 ) THEN
1947 nptl = nlay
1948 ELSE
1949 nptl= npts
1950 ENDIF
1951
1952
1953 IF (npt < 0) THEN
1954C LOBATTO INTEGRATION POINTS
1955 ispau=1
1956 DO it=1,nptt
1957 DO ir=1,nptr
1958 ipwwa = (it-1)*3*7 + (ir-1)*7
1959 DO itens=1,7
1960 wwa(826+itens+ipwwa) = sigp(itens,ispau,1)
1961 wwa(763+itens+ipwwa) = sigp(itens,ispau,npts)
1962 ENDDO
1963 ispau=ispau+1
1964 ENDDO
1965 ENDDO
1966 ELSE
1967 IF (nptl > 2) THEN
1968 ispau=1
1969 DO it=1,nptt
1970 DO ir=1,nptr
1971 ipwwa = (it-1)*3*7 + (ir-1)*7
1972 DO itens=1,7
1973c
1974 wwa(826+itens+ipwwa) = sigp(itens,ispau,1)
1975 . +(sigp(itens,ispau,2)-sigp(itens,ispau,1))
1976 . *(-1 - a_gauss(1,nptl))
1977 . /(a_gauss(2,nptl)-a_gauss(1,nptl))
1978c
1979 wwa(763+itens+ipwwa)= sigp(itens,ispau,nptl-1)
1980 . +(sigp(itens,ispau,nptl)
1981 . - sigp(itens,ispau,nptl-1))
1982 . *(1 - a_gauss(nptl-1,nptl))
1983 . /(a_gauss(nptl,nptl)-a_gauss(nptl-1,nptl))
1984c
1985 ENDDO
1986 ispau=ispau+1
1987 ENDDO
1988 ENDDO
1989 ELSE
1990 ispau=1
1991 DO it=1,nptt
1992 DO ir=1,nptr
1993 ipwwa = (it-1)*3*7 + (ir-1)*7
1994 DO itens=1,7
1995c
1996 wwa(826+itens+ipwwa)
1997 . = sigp(itens,ispau,1)
1998 . +(sigp(itens,ispau,2)-sigp(itens,ispau,1))
1999 . *(-1 - a_gauss(1,nptl))
2000 . /(a_gauss(2,nptl)-a_gauss(1,nptl))
2001c
2002 wwa(763 + itens + ipwwa)
2003 . = sigp(itens,ispau,1)
2004 . +(sigp(itens,ispau,2)-sigp(itens,ispau,1))
2005 . *(1 - a_gauss(1,nptl))
2006 . /(a_gauss(2,nptl)-a_gauss(1,nptl))
2007c
2008 ENDDO
2009 ispau=ispau+1
2010 ENDDO
2011 ENDDO
2012 ENDIF
2013 ENDIF
2014
2015c---------------
2016 ELSEIF ((isolnod==6 .OR. isolnod==8) .AND. khbe==15) THEN
2017c----------------------------------------------------------------------------
2018C------------------------Output SIJK EPS L_EPS---------------------
2019C---------------------------------------------------------------------------
2020C
2021 jj = 6*(i-1)
2022 DO j=1, 100
2023 user(j) = zero
2024 ENDDO
2025 npts = npt
2026C
2027 DO ipt=1,npts
2028 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ipt,1,1)
2029 mbuf => elbuf_tab(ng)%BUFLY(1)%MAT(ipt,1,1)
2030c IPWWA calculated using 3*9*3 integration points (r*s*t)
2031c for this type of elem output are in 1*NPTS*1, NPTS = 9 (max)
2032 ipwwa = (ipt-1)*3*7
2033 iuwwa = (ipt-1)*3*9
2034 DO itens=1,6
2035 wwa(196+ipwwa+itens)=lbuf%SIG(kk(itens)+i)
2036 sigp(itens,1,ipt)= lbuf%SIG(kk(itens)+i)
2037 ENDDO
2038 IF(ivisc > 0 ) THEN
2039 DO itens=1,6
2040 wwa(196+ipwwa+itens)= wwa(196+ipwwa+itens) + lbuf%VISC(kk(itens)+i)
2041 sigp(itens,1,ipt)= sigp(itens,1,ipt)+ lbuf%VISC(kk(itens)+i)
2042 ENDDO
2043 ENDIF
2044c PLastic Deformation
2045 IF (mte >= 28) THEN
2046 IF (nuvar > 0) THEN
2047 wwa(196+ipwwa+7) = mbuf%VAR(i)
2048 sigp(7, 1 ,ipt)= mbuf%VAR(i)
2049 ENDIF
2050C just 9 user variables par integration point
2051 nuvarth = min(9,nuvar)
2052 DO j=1, nuvarth
2053 wwa(889 + j + iuwwa) = mbuf%VAR(i + (j-1)*nel )
2054 ENDDO
2055C just 60 average user variables
2056 nuvarth = min(60,nuvar)
2057 DO j=1, nuvarth
2058 user(j) = user(j) + mbuf%VAR(i+(j-1)*nel)/npt
2059 wwa(889+j+iuwwa) = mbuf%VAR(i+(j-1)*nel)
2060 ENDDO
2061 IF (elbuf_tab(ng)%BUFLY(1)%L_STRA > 0) THEN
2062 DO j= 1,3
2063 strain(j) = strain(j) + lbuf%STRA(kk(j)+i)/npt
2064 wwa(239060+ipwwa+j)=lbuf%STRA(kk(j)+i)
2065 ENDDO
2066 DO j= 4,6
2067 strain(j) = strain(j) + lbuf%STRA(kk(j)+i)*half/npt
2068 wwa(239060+ipwwa+j)=lbuf%STRA(kk(j)+i)*half
2069 ENDDO
2070 ENDIF
2071 ELSE ! mte < 28
2072 IF (elbuf_tab(ng)%BUFLY(1)%L_PLA > 0) THEN
2073 wwa(196 + ipwwa + 7)= lbuf%PLA(i)
2074 sigp(7, 1 ,ipt) = lbuf%PLA(i)
2075 ENDIF
2076 IF (mte == 12 .OR. mte == 14) THEN
2077 DO j=1,3
2078 strain(j) = strain(j) + lbuf%EPE(kk(j)+i)/npt
2079 wwa(239060+ipwwa+j)=lbuf%EPE(kk(j)+i)
2080 ENDDO
2081 ELSEIF (elbuf_tab(ng)%BUFLY(1)%L_STRA > 0) THEN
2082 DO j= 1,3
2083 strain(j) = strain(j) + lbuf%STRA(kk(j)+i)/npt
2084 wwa(239060+ipwwa+j)=lbuf%STRA(kk(j)+i)
2085 ENDDO
2086 DO j= 4,6
2087 strain(j) = strain(j) + lbuf%STRA(kk(j)+i)*half/npt
2088 wwa(239060+ipwwa+j)=lbuf%STRA(kk(j)+i)*half
2089 ENDDO
2090 ENDIF
2091 ENDIF ! mte < 28
2092 ENDDO ! IPT
2093C
2094 IF (mte >= 28)THEN
2095C we can get just 60 average user variables
2096 nuvarth = min(60,nuvar)
2097 DO j=1, nuvarth
2098 wwa(136 + j) = user(j)
2099 ENDDO
2100 ENDIF
2101C-----------------in Global ref : EPSX............-----------
2102 DO j = 1, 3
2103 wwa(1618 + j) = strain(j)
2104 ENDDO
2105C Problem of order of output EPSZX before EPSYZ (see THGROU)
2106 wwa(1618 + 4) = strain(4)
2107 wwa(1618 + 5) = strain(6)
2108 wwa(1618 + 6) = strain(5)
2109C-----------------in local ref : L_EPSX............-----------
2110 DO j = 1, 6
2111 wwa(239030 + j) = strain(j)
2112 ENDDO
2113CC
2114 IF(npts > 2) THEN
2115 ipwwa = 0
2116 DO itens=1,7
2117 wwa(826+itens + ipwwa) = sigp(itens,1,1)
2118 . +(sigp(itens,1,2)-sigp(itens,1,1))
2119 . *(-1 - a_gauss(1,npts))
2120 . /(a_gauss(2,npts)-a_gauss(1,npts))
2121 wwa(763+itens+ipwwa) = sigp(itens,1,npts-1)
2122 . +(sigp(itens,1,npts)
2123 . - sigp(itens,1,npts-1))
2124 . *(1 - a_gauss(npts-1,npts))
2125 . /(a_gauss(npts,npts)-a_gauss(npts-1,npts))
2126 ENDDO
2127 ELSE
2128 ipwwa = 0
2129 DO itens=1,7
2130 wwa(826+itens+ipwwa) = sigp(itens,1,1)
2131 . +(sigp(itens,1,2)-sigp(itens,1,1))
2132 . *(-1 - a_gauss(1,npts))
2133 . /(a_gauss(2,npts)-a_gauss(1,npts))
2134 wwa(763 + itens + ipwwa) = sigp(itens,1,1)
2135 . +(sigp(itens,1,2)-sigp(itens,1,1))
2136 . *(1 - a_gauss(1,npts))
2137 . /(a_gauss(2,npts)-a_gauss(1,npts))
2138 ENDDO
2139 ENDIF
2140c
2141 ELSEIF (isolnod == 8.AND.khbe /= 14.AND.khbe /= 24) THEN
2142c
2143 jj = 6*(i-1)
2144 IF (npt == 8) THEN
2145 nlay = elbuf_tab(ng)%NLAY
2146 nptr = elbuf_tab(ng)%NPTR
2147 npts = elbuf_tab(ng)%NPTS
2148 nptt = elbuf_tab(ng)%NPTT
2149 npt = nptr * npts * nptt * nlay
2150 DO it=1,nptt !1,2
2151 DO is=1,npts !1,2
2152 DO ir=1,nptr !1,2
2153 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(ir,is,it)
2154 mbuf => elbuf_tab(ng)%BUFLY(1)%MAT(ir,is,it)
2155 ipt = ir + ( (is-1) + (it-1)*npts )*nptr
2156 wwa(40+ipt)=lbuf%SIG(kk(1)+i)
2157 wwa(48+ipt)=lbuf%SIG(kk(2)+i)
2158 wwa(56+ipt)=lbuf%SIG(kk(3)+i)
2159 wwa(64+ipt)=lbuf%SIG(kk(4)+i)
2160 wwa(72+ipt)=lbuf%SIG(kk(5)+i)
2161 wwa(80+ipt)=lbuf%SIG(kk(6)+i)
2162 IF(ivisc > 0 ) THEN
2163 wwa(40+ipt)=wwa(40+ipt) + lbuf%VISC(kk(1)+i)
2164 wwa(48+ipt)=wwa(48+ipt) + lbuf%VISC(kk(2)+i)
2165 wwa(56+ipt)=wwa(56+ipt) + lbuf%VISC(kk(3)+i)
2166 wwa(64+ipt)=wwa(64+ipt) + lbuf%VISC(kk(4)+i)
2167 wwa(72+ipt)=wwa(72+ipt) + lbuf%VISC(kk(5)+i)
2168 wwa(80+ipt)=wwa(80+ipt) + lbuf%VISC(kk(6)+i)
2169 ENDIF
2170 !tenseur de contrainte sur chaque points de gauss
2171 ipwwa = (it-1)*3*9*7 + (is-1)*3*7 + (ir-1)*7
2172 iuwwa = (it-1)*3*9*9 + (is-1)*3*9 + (ir-1)*9
2173 DO itens = 1,6
2174 jj = 6*(i-1)
2175 wwa(196+ipwwa+itens)=lbuf%SIG(kk(itens)+i)
2176 ENDDO
2177 IF(ivisc > 0 ) THEN
2178 DO itens = 1,6
2179 jj = 6*(i-1)
2180 wwa(196+ipwwa+itens)=wwa(196+ipwwa+itens) + lbuf%VISC(kk(itens)+i)
2181 ENDDO
2182 ENDIF
2183 IF (elbuf_tab(ng)%BUFLY(1)%L_PLA > 0)
2184 . wwa(196+ipwwa+ 7 ) = lbuf%PLA(i)
2185 IF (mte >= 28) THEN
2186 IF (nuvar>0) THEN
2187 wwa(196+ipwwa+ 7 ) = mbuf%VAR(i)
2188 ENDIF
2189C we can get just 9 user variables by integration point
2190 nuvarth = min(9,nuvar)
2191 DO j=1,nuvarth
2192 wwa(889 + iuwwa + j) = mbuf%VAR(i+(j-1)*nel)
2193 ENDDO
2194 IF (elbuf_tab(ng)%BUFLY(1)%L_STRA > 0) THEN
2195 strain(1)=strain(1) + lbuf%STRA(kk(1)+i)*one_over_8
2196 strain(2)=strain(2) + lbuf%STRA(kk(2)+i)*one_over_8
2197 strain(3)=strain(3) + lbuf%STRA(kk(3)+i)*one_over_8
2198 strain(4)=strain(4) + lbuf%STRA(kk(4)+i)*one_over_8
2199 strain(5)=strain(5) + lbuf%STRA(kk(5)+i)*one_over_8
2200 strain(6)=strain(6) + lbuf%STRA(kk(6)+i)*one_over_8
2201 ENDIF
2202 ENDIF
2203 ENDDO
2204 ENDDO
2205 ENDDO
2206c
2207 ELSEIF(npt == 1)THEN
2208 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
2209c
2210 IF (mte == 12 .OR. mte == 14) THEN
2211 DO j= 1,3
2212 strain(j) = lbuf%EPE(kk(j)+i)
2213 ENDDO
2214
2215 ELSEIF (elbuf_tab(ng)%BUFLY(1)%L_STRA > 0) THEN
2216 DO j= 1,3
2217 strain(j) = lbuf%STRA(kk(j)+i)
2218 ENDDO
2219 DO j= 4,6
2220 strain(j) = lbuf%STRA(kk(j)+i) *half
2221 ENDDO
2222 ENDIF
2223 ENDIF ! NPT
2224
2225C-----------------in local ref : L_EPSX............-----------
2226 IF (kcvt==-1) THEN
2227 gama(1)=gbuf%GAMA(kk(1) + i)
2228 gama(2)=gbuf%GAMA(kk(2) + i)
2229 gama(3)=gbuf%GAMA(kk(3) + i)
2230 gama(4)=gbuf%GAMA(kk(4) + i)
2231 gama(5)=gbuf%GAMA(kk(5) + i)
2232 gama(6)=gbuf%GAMA(kk(6) + i)
2233 CALL srota6(
2234 1 x , ixs(1,n), 2 , strain,
2235 2 gama, khbe , igtyp, isorth)
2236 ENDIF
2237 DO j = 1, 6
2238 wwa(239030 + j) = strain(j)
2239 ENDDO
2240C-----------------in Global ref : EPSX............-----------
2241 DO j = 1, 3
2242 wwa(1618 + j) = strain(j)
2243 ENDDO
2244C Problem of order of output EPSZX before EPSYZ (see THGROU)
2245 wwa(1618 + 4) = strain(4)
2246 wwa(1618 + 5) = strain(6)
2247 wwa(1618 + 6) = strain(5)
2248
2249 ENDIF ! ISOLNOD
2250C---
2251 ENDIF ! KCVT
2252C---
2253 DO l=iadv,iadv+nvar-1
2254 k=ithbuf(l)
2255 ijk=ijk+1
2256 wa(ijk)=wwa(k)
2257 ENDDO
2258 ijk=ijk+1
2259 wa(ijk) = ii
2260
2261C -----
2262 ENDIF ! element = ITHBUF()
2263 ENDDO ! NEL
2264 isorthg = isorth
2265C -----
2266 ENDIF ! mte /= 13
2267 ENDIF ! ITY
2268 ENDDO ! groupe
2269 666 continue
2270! -------------------------------
2271 ENDIF
2272 ENDDO
2273 DEALLOCATE(wwa)
2274C-----------
2275 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
alefvm_mod
Definition alefvm_mod.F:88
alefvm_mod::alefvm_param
type(alefvm_param_), target alefvm_param
Definition alefvm_mod.F:121
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
nvar
integer function nvar(text)
Definition nvar.F:32
scoor431
subroutine scoor431(x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z)
Definition scoor431.F:34
scortho31
subroutine scortho31(x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z)
Definition scortho31.F:33
sortho31
subroutine sortho31(x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z)
Definition sortho31.F:34
srota6
subroutine srota6(x, ixs, kcvt, tens, gama)
Definition srota6.F:32