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 40 of file thsol.F.

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