OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
tensorc.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| tensorc ../engine/source/output/anim/generate/tensorc.F
25!||--- called by ------------------------------------------------------
26!|| genani ../engine/source/output/anim/generate/genani.F
27!||--- calls -----------------------------------------------------
28!|| layini ../engine/source/elements/shell/coque/layini.F
29!|| spmd_r4get_partn ../engine/source/mpi/anim/spmd_r4get_partn.F
30!|| uroto_tens2d ../engine/source/materials/tools/uroto_tens2d.F
31!|| uroto_tens2d_aniso ../engine/source/materials/tools/uroto_tens2d_aniso.F
32!|| write_r_c ../common_source/tools/input_output/write_routtines.c
33!||--- uses -----------------------------------------------------
34!|| drape_mod ../engine/share/modules/drape_mod.F
35!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
36!|| matparam_def_mod ../common_source/modules/mat_elem/matparam_def_mod.F90
37!|| my_alloc_mod ../common_source/tools/memory/my_alloc.F90
38!|| stack_mod ../engine/share/modules/stack_mod.F
39!||====================================================================
40 SUBROUTINE tensorc(ELBUF_TAB,IPARG ,ITENS ,INVERT,NELCUT,
41 . EL2FA ,NBF ,TENS ,EPSDOT,IADP ,
42 . NBF_L ,NBPART,IADG ,X ,IXC ,
43 . IGEO ,IXTG ,IPM ,STACK ,MAT_PARAM,
44 . GEO ,DRAPE_SH4N, DRAPE_SH3N, DRAPEG)
45C-----------------------------------------------
46C M o d u l e s
47C-----------------------------------------------
48 USE elbufdef_mod
49 USE stack_mod
50 USE matparam_def_mod
51 USE my_alloc_mod
52 USE drape_mod
53C-----------------------------------------------
54C I m p l i c i t T y p e s
55C-----------------------------------------------
56#include "implicit_f.inc"
57C-----------------------------------------------
58C C o m m o n B l o c k s
59C-----------------------------------------------
60#include "mvsiz_p.inc"
61C-----------------------------------------------
62#include "com01_c.inc"
63#include "com04_c.inc"
64#include "param_c.inc"
65#include "scr25_c.inc"
66#include "spmd_c.inc"
67#include "task_c.inc"
68C-----------------------------------------------
69C D u m m y A r g u m e n t s
70C-----------------------------------------------
71 INTEGER IPARG(NPARG,*),ITENS,INVERT(*),
72 . EL2FA(*),IXC(NIXC,*), IGEO(NPROPGI,*),
73 . NELCUT,NBF,IADP(*),NBF_L,NBPART,IADG(NSPMD,*),
74 . IXTG(NIXTG,*),IPM(NPROPMI,*)
75C REAL
76 my_real tens(3,*),epsdot(6,*),x(3,*)
77 my_real, INTENT(IN) :: geo(npropg,numgeo)
78 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
79 TYPE (STACK_PLY) :: STACK
80 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(IN) :: MAT_PARAM
81 TYPE (DRAPE_) , INTENT(IN) :: DRAPE_SH4N(NUMELC_DRAPE)
82 TYPE (DRAPE_) , INTENT(IN) :: DRAPE_SH3N(NUMELTG_DRAPE)
83 TYPE (DRAPEG_), INTENT(IN) :: DRAPEG
84C-----------------------------------------------
85C L o c a l V a r i a b l e s
86C-----------------------------------------------
87C REAL
88 my_real
89 . a1,a2,a3,thk
90 REAL R4(18)
91 INTEGER I,NG,NEL,NFT,ITY,LFT,NPT,MPT,IPT,
92 . n,j,llt,mlw,istrain,il,ir,is,it,nptr,npts,nlay,
93 . ipid,i1,i2,ns1,ns2,istre,input_error,
94 . nn1,nn2,nn3,nn4,nn5,nn6,nn7,nn8,nn9,nn10,nni,n0,
95 . ihbe,buf,npg,k,isrot,nuvarv,ivisc,
96 . ipmat,igtyp,isubstack,iigeo,iadi,ipmat_iply,ixfem,ixlay,
97 . npt_all,nptt,ilay,ius,id_ply,iply,ipang,ippos,ipthk,jj(8),
98 . idx,idx_mstress,idx_idply_mstress,igmat,idrape,idir,imat,mat_orth
99 INTEGER PID(MVSIZ),MAT(MVSIZ)
100 my_real ,DIMENSION(:,:) , ALLOCATABLE :: SIGE
101C
102 TYPE(BUF_LAY_) ,POINTER :: BUFLY
103 TYPE(g_bufel_) ,POINTER :: GBUF
104 TYPE(l_bufel_) ,POINTER :: LBUF
105 TYPE(L_BUFEL_DIR_) ,POINTER :: LBUF_DIR
106C
107 my_real, DIMENSION(:), POINTER :: dir_a,dir_b
108 REAL,DIMENSION(:),ALLOCATABLE :: WA
109 !
110 INTEGER :: NLAY_MAX,LAYNPT_MAX,NUMEL_DRAPE,SEDRAPE
111 INTEGER, DIMENSION(:) , ALLOCATABLE :: MATLY !! MATLY(MVSIZ*LAY_MAX)
112 my_real, DIMENSION(:) , ALLOCATABLE :: thkly !! THKLY(MVSIZ*LAY_MAX*LAYNPT_MAX)
113 my_real, DIMENSION(:,:), ALLOCATABLE :: posly,thk_ly
114C-----------------------------------------------
115 CALL my_alloc(wa,3*nbf_l)
116!
117 DO j=1,18
118 r4(j) = zero
119 ENDDO
120C
121 npg = 1
122 nn1 = 1
123 nn2 = nn1
124 nn3 = nn2
125 nn4 = nn3 + numelq
126 nn5 = nn4 + numelc
127 nn6 = nn5 + numeltg
128 nn7 = nn6
129 nn8 = nn7
130 nn9 = nn8
131 nn10= nn9
132C
133C
134 DO 490 ng=1,ngroup
135C IF(ANIM_K == 0.AND.IPARG(8,NG) == 1)GOTO 490
136 mlw = iparg(1,ng)
137 nel = iparg(2,ng)
138 nft = iparg(3,ng)
139 ity = iparg(5,ng)
140 igtyp = iparg(38,ng)
141 isrot = iparg(41,ng)
142 istrain = iparg(44,ng)
143 isubstack = iparg(71,ng)
144 igmat = iparg(75,ng)
145 idrape = elbuf_tab(ng)%IDRAPE
146 lft=1
147 llt=nel
148!
149 DO i=1,8 ! length max of GBUF%G_STRA = 8
150 jj(i) = nel*(i-1)
151 ENDDO
152!
153 IF (ALLOCATED(sige)) DEALLOCATE(sige)
154 ALLOCATE(sige(nel,3))
155 sige(1:nel,1:3) = zero
156!
157 IF (mlw /= 13) THEN
158C-----------------------------------------------
159C QUAD
160C-----------------------------------------------
161 IF(ity == 2)THEN
162 DO i=lft,llt
163 n = i + nft
164 tens(1,el2fa(nn3+n)) = zero
165 tens(2,el2fa(nn3+n)) = zero
166 tens(3,el2fa(nn3+n)) = zero
167 ENDDO
168C-----------------------------------------------
169C COQUES
170C-----------------------------------------------
171 ELSEIF (ity == 3 .OR. ity == 7) THEN
172 gbuf => elbuf_tab(ng)%GBUF
173 nptr = elbuf_tab(ng)%NPTR
174 npts = elbuf_tab(ng)%NPTS
175 nptt = elbuf_tab(ng)%NPTT
176 nlay = elbuf_tab(ng)%NLAY
177 npg = nptr*npts
178C
179 ihbe = iparg(23,ng)
180 IF (ity == 3) THEN
181 n0 = 0
182 nni = nn4
183 IF (ihbe == 11) npg = 4
184 ipid = ixc(6,nft+1)
185 DO i=lft,llt
186 mat(i)=ixc(1,nft+i)
187 pid(i)=ixc(6,nft+i)
188 ENDDO
189 ELSE
190 n0 = numelc
191 nni = nn5
192 IF (ihbe == 11) npg = 3
193 ipid = ixtg(5,nft+1)
194 DO i=lft,llt
195 mat(i)=ixtg(1,nft+i)
196 pid(i)=ixtg(5,nft+i)
197 ENDDO
198 ENDIF
199c
200 DO i=lft,llt
201 n = i + nft
202 tens(1,el2fa(nni+n)) = zero
203 tens(2,el2fa(nni+n)) = zero
204 tens(3,el2fa(nni+n)) = zero
205 ENDDO
206C
207 IF (mlw == 0) GOTO 490
208C
209 input_error = 0
210 a1 = zero
211 a2 = zero
212 a3 = zero
213 istre = 1
214 ipt = 1
215 npt = iabs(iparg(6,ng))
216 mpt = max(1,npt)
217!
218 laynpt_max = 1
219 IF (igtyp == 51 .OR. igtyp == 52) THEN
220 DO ilay=1,nlay
221 laynpt_max = max(laynpt_max ,elbuf_tab(ng)%BUFLY(ilay)%NPTT)
222 ENDDO
223 ENDIF
224 ixfem = 0
225 ixlay = 0
226 nlay_max = max(nlay,npt)
227 ALLOCATE(matly(mvsiz*nlay_max))
228 ALLOCATE(thkly(mvsiz*nlay_max*laynpt_max))
229 ALLOCATE(posly(mvsiz,nlay_max*laynpt_max))
230 ALLOCATE(thk_ly(nel ,nlay_max*laynpt_max))
231 matly(:) = 0
232 thkly(:) = zero
233 posly(:,:) = zero
234 thk_ly(:,:) = zero
235 ! computing position of slice or Ply
236 IF (ity == 7) THEN
237 numel_drape = numeltg_drape
238 sedrape = stdrape
239 CALL layini(
240 . elbuf_tab(ng),1 ,nel ,geo ,igeo ,
241 . mat ,pid ,thkly ,matly ,posly ,
242 . igtyp ,ixfem ,ixlay ,nlay ,npt ,
243 . isubstack,stack ,drape_sh3n ,nft ,gbuf%THK ,
244 . nel ,thk_ly ,drapeg%INDX_SH3N,sedrape,numel_drape)
245 ELSE ! ITY = 3
246 numel_drape = numelc_drape
247 sedrape = scdrape
248 CALL layini(
249 . elbuf_tab(ng),1 ,nel ,geo ,igeo ,
250 . mat ,pid ,thkly ,matly ,posly ,
251 . igtyp ,ixfem ,ixlay ,nlay ,npt ,
252 . isubstack,stack ,drape_sh4n ,nft ,gbuf%THK ,
253 . nel ,thk_ly ,drapeg%INDX_SH4N,sedrape,numel_drape)
254 ENDIF
255C
256 IF (igtyp == 51 .OR. igtyp == 52) THEN
257 npt_all = 0
258 DO ipt=1,nlay
259 npt_all = npt_all + elbuf_tab(ng)%BUFLY(ipt)%NPTT
260 ENDDO
261 IF (nlay == 1) mpt = max(1,npt_all)
262 ENDIF
263 idx_mstress = 3120 + 3*mx_ply_anim
264 idx_idply_mstress = idx_mstress + 103
265C------------------------
266C STRESS 1:mem, 2:bend, 3:upper, 4: lower
267C------------------------
268 IF (itens == 1) THEN
269 ns1 = 5
270 ns2 = 3
271 a1 = one
272 a2 = zero
273 ELSEIF (itens == 2) THEN
274 ns1 = 5
275 ns2 = 3
276 a1 = zero
277 a2 = one
278 ELSEIF (itens == 3) THEN
279 ns1 = 5
280 ns2 = 3
281 ipt = mpt
282 il = nlay
283 IF (mlw == 1) THEN
284 a1 = one
285c A2 = 0
286 a2 = six
287 ELSEIF (mlw == 2 .OR. mlw == 19 .OR.
288 . mlw == 15 .OR.
289 . mlw == 22 .OR. mlw == 25 .OR.
290 . mlw == 27 .OR. mlw == 32 .OR.
291 . mlw >= 28) THEN
292 a1 = one
293 a2 = zero
294 ELSEIF (mlw == 3 .OR. mlw == 23) THEN
295 a1 = one
296 a2 = zero
297 ENDIF
298 ELSEIF (itens == 4) THEN
299 ns1 = 5
300 ns2 = 3
301 ipt = 1
302 il = 1
303 IF (mlw == 1) THEN
304 a1 = one
305 a2 = -six
306 ELSEIF (mlw == 2 .OR. mlw == 19 .OR.
307 . mlw == 15 .OR.
308 . mlw == 22 .OR. mlw == 25.OR.
309 . mlw == 27 .OR. mlw == 32.OR.
310 . mlw >= 28) THEN
311 a1 = one
312 a2 = zero
313 ELSEIF (mlw == 3 .OR. mlw == 23) THEN
314 a1 = one
315 a2 = zero
316 ENDIF
317 ELSEIF (itens > 100 .AND. itens < 201) THEN
318 ns1 = 5
319 ns2 = 3
320 ipt = min(mpt,itens-100)
321 IF (itens - 100 > mpt) THEN
322 a1 = zero
323 a2 = zero
324 ELSEIF (mlw == 1 .OR. mlw == 3 .OR. mlw == 23) THEN
325 a1 = one
326 a2 = zero
327 ELSEIF (mlw == 2 .OR. mlw == 19 .OR.
328 . mlw == 15 .OR.
329 . mlw == 22 .OR. mlw == 25 .OR.
330 . mlw == 27 .OR. mlw == 32 .OR.
331 . mlw >= 28) THEN
332 a1 = one
333 a2 = zero
334 ENDIF
335 ELSEIF (itens > 400 .AND. itens < 501) THEN
336C upper stress within each layer (PID51)
337 ns1 = 5
338 ns2 = 3
339cc IPT = MIN(MPT,ITENS-100)
340C-----
341 ilay = mod((itens - 400), 100)
342 IF (ilay == 0) ilay = 100
343C-----
344 IF (ilay > mpt) THEN
345 a1 = zero
346 a2 = zero
347 ELSEIF (mlw == 1 .OR. mlw == 3 .OR. mlw == 23) THEN
348 a1 = one
349 a2 = zero
350 ELSEIF (mlw == 2 .OR. mlw == 19 .OR.
351 . mlw == 15 .OR.
352 . mlw == 22 .OR. mlw == 25 .OR.
353 . mlw == 27 .OR. mlw == 32 .OR.
354 . mlw >= 28) THEN
355 a1 = one
356 a2 = zero
357 ENDIF
358 ELSEIF (itens > 500 .AND. itens < 601) THEN
359C lower stress within each layer (PID51)
360 ns1 = 5
361 ns2 = 3
362cc IPT = MIN(MPT,ITENS-100)
363C-----
364 ilay = mod((itens - 500), 100)
365 IF (ilay == 0) ilay = 100
366C-----
367 IF (ilay > mpt) THEN
368 a1 = zero
369 a2 = zero
370 ELSEIF (mlw == 1 .OR. mlw == 3 .OR. mlw == 23) THEN
371 a1 = one
372 a2 = zero
373 ELSEIF (mlw == 2 .OR. mlw == 19 .OR.
374 . mlw == 15 .OR.
375 . mlw == 22 .OR. mlw == 25 .OR.
376 . mlw == 27 .OR. mlw == 32 .OR.
377 . mlw >= 28) THEN
378 a1 = one
379 a2 = zero
380 ENDIF
381 ELSEIF (itens > 600 .AND. itens < 1611) THEN
382C all stresses within each layer for all NPTT (PID51)
383 ns1 = 5
384 ns2 = 3
385cc IPT = MIN(MPT,ITENS-100)
386C-----
387 ius = itens - 600
388 ilay = int((ius - 1)/10)
389 IF (ilay == 0) ilay = 100
390C-----
391 IF (ilay > mpt) THEN
392 a1 = zero
393 a2 = zero
394 ELSEIF (mlw == 1 .OR. mlw == 3 .OR. mlw == 23) THEN
395 a1 = one
396 a2 = zero
397 ELSEIF (mlw == 2 .OR. mlw == 19 .OR.
398 . mlw == 15 .OR.
399 . mlw == 22 .OR. mlw == 25 .OR.
400 . mlw == 27 .OR. mlw == 32 .OR.
401 . mlw >= 28) THEN
402 a1 = one
403 a2 = zero
404 ENDIF
405C------------------------
406C STRAIN
407C------------------------
408 ELSEIF (itens == 5) THEN ! membrane
409 istre = 0
410 ns1 = 8
411 ns2 = 8
412 IF (istrain == 1) THEN
413 a1 = one
414 a2 = zero
415 ELSE
416 a1 = zero
417 a2 = zero
418 ENDIF
419 ELSEIF (itens == 6) THEN ! bend
420 istre = 0
421 ns1 = 8
422 ns2 = 8
423 a1 = zero
424 a2 = one
425 ELSEIF (itens == 7) THEN ! upper
426 istre = 0
427 ns1 = 8
428 ns2 = 8
429 ipt = mpt
430 a1 = one
431 a2 = half
432 ELSEIF (itens == 8) THEN ! lower
433 istre = 0
434 ns1 = 8
435 ns2 = 8
436 ipt = 1
437 a1 = one
438 a2 = -half
439 ELSEIF (itens > 200 .AND. itens < 301) THEN ! layer
440 istre = 0
441 ns1 = 8
442 ns2 = 8
443 ipt = min(mpt,itens-200)
444 IF ((itens - 200 > mpt) .OR. igtyp == 51 .OR. igtyp == 52 .OR. igtyp == 17) THEN
445 a1 = zero
446 a2 = zero
447 ELSE IF (igtyp == 11) THEN
448 ipt = itens-200
449 a1 = one
450 a2 = posly(1,ipt)
451 ELSE
452 a1 = one
453 a2 = half*(((2*ipt-one)/mpt)-one)
454 ENDIF
455 ELSEIF (itens > 1610+ mx_ply_anim .AND. itens < 1611 + 2*mx_ply_anim ) THEN
456 il = itens - (1610+ mx_ply_anim)
457 istre = 0
458 a1 = zero
459 a2 = zero
460 ns1 = 8
461 ns2 = 8
462 IF (igtyp == 17 .OR. igtyp == 51 .OR. igtyp == 52) THEN
463 IF (ply_anim_strain( 3 * (il - 1) + 2) == 3 )THEN
464 ipang = 1
465 ipthk = ipang + nlay
466 ippos = ipthk + nlay
467 ipt = ply_anim_strain( 3 * (il - 1) + 3)
468 DO j=1,nlay
469 bufly => elbuf_tab(ng)%BUFLY(j)
470 nptt = bufly%NPTT
471 IF (igtyp == 17 .OR. igtyp == 51) THEN
472 id_ply = igeo(1,stack%IGEO(2+j,isubstack))
473 ELSEIF (igtyp == 52) THEN
474 id_ply = ply_info(1,stack%IGEO(2+j,isubstack)-numstack)
475 ENDIF
476 IF (id_ply == ply_anim_strain( 3 * (il - 1) + 1) .AND.
477 . ipt <= nptt ) THEN
478 a1 = one
479c A2 = STACK%GEO(IPPOS+J,ISUBSTACK)
480 a2 = stack%GEO(ippos+j,isubstack)+
481 . half*(((2*ipt-one)/nptt)-one) *
482 . stack%GEO(ipthk+j,isubstack)
483 ENDIF
484 ENDDO
485 ENDIF
486 ELSE
487 istre = 0
488 a1 = zero
489 a2 = zero
490 ENDIF
491!
492 ELSEIF (itens > 1610 + 3*mx_ply_anim .AND.
493 . itens < 1711 + 3*mx_ply_anim) THEN
494!-------------------
495 ! STRAIN/ILAY/UPPER -> UPPER strain within each layer (PID51,52)
496!-------------------
497 istre = 0
498 a1 = zero
499 a2 = zero
500 ns1 = 8
501 ns2 = 8
502 IF (igtyp == 51 .OR. igtyp == 52) THEN
503!
504 idx = 1610 + 3*mx_ply_anim
505!
506 ilay = mod((itens - idx),100)
507 IF (ilay == 0) ilay = 100
508 IF (nlay > 1) THEN
509 il = max(1,ilay)
510 ELSE
511 il = 1
512 ENDIF
513 bufly => elbuf_tab(ng)%BUFLY(il)
514 nptt = bufly%NPTT
515 it = max(1,nptt)
516!
517 ipang = 1
518 ipthk = ipang + nlay
519 ippos = ipthk + nlay
520!
521 IF (il <= nlay) THEN
522 a1 = one
523 a2 = stack%GEO(ippos+il,isubstack)+
524 . half*(((2*it-one)/nptt)-one) *
525 . stack%GEO(ipthk+il,isubstack)
526 ENDIF
527 ENDIF ! IF (IGTYP == 51 .OR. IGTYP == 52)
528!
529 ELSEIF (itens > 1710 + 3*mx_ply_anim .AND.
530 . itens < 1811 + 3*mx_ply_anim) THEN
531!-------------------
532 ! STRAI/ILAY/LOWER -> LOWER strain within each layer (PID51,52)
533!-------------------
534 istre = 0
535 a1 = zero
536 a2 = zero
537 ns1 = 8
538 ns2 = 8
539 IF (igtyp == 51 .OR. igtyp == 52) THEN
540!
541 idx = 1710 + 3*mx_ply_anim
542!
543 ilay = mod((itens - idx),100)
544 IF (ilay == 0) ilay = 100
545 IF (nlay > 1) THEN
546 il = max(1,ilay)
547 ELSE
548 il = 1
549 ENDIF
550 bufly => elbuf_tab(ng)%BUFLY(il)
551 nptt = bufly%NPTT
552 it = 1
553!
554 ipang = 1
555 ipthk = ipang + nlay
556 ippos = ipthk + nlay
557!
558 IF (il <= nlay) THEN
559 a1 = one
560 a2 = stack%GEO(ippos+il,isubstack)+
561 . half*(((2*it-one)/nptt)-one) *
562 . stack%GEO(ipthk+il,isubstack)
563 ENDIF
564 ENDIF ! IF (IGTYP == 51 .OR. IGTYP == 52)
565!
566 ELSEIF (itens > 1810 + 3*mx_ply_anim .AND.
567 . itens < 2821 + 3*mx_ply_anim) THEN
568!-------------------
569 ! STRAI/ILAY/IT -> all strain within each layer (PID51,52)
570!-------------------
571 istre = 0
572 a1 = zero
573 a2 = zero
574 ns1 = 8
575 ns2 = 8
576 IF (igtyp == 51 .OR. igtyp == 52) THEN
577!
578 idx = 1810 + 3*mx_ply_anim
579!
580 ius = itens - idx
581 ilay = int((ius - 1)/10)
582 IF (ilay == 0) ilay = 100
583 il = ilay
584 it = ius - 10*il
585!
586 ipang = 1
587 ipthk = ipang + nlay
588 ippos = ipthk + nlay
589!
590 IF (il <= nlay) THEN
591 bufly => elbuf_tab(ng)%BUFLY(il)
592 nptt = bufly%NPTT
593 IF (it <= nptt) THEN
594 a1 = one
595 a2 = stack%GEO(ippos+il,isubstack)+
596 . half*(((2*it-one)/nptt)-one) *
597 . stack%GEO(ipthk+il,isubstack)
598 ENDIF
599 ENDIF ! IF (IL <= NLAY)
600 ENDIF ! IF (IGTYP == 51 .OR. IGTYP == 52)
601C------------------------
602C STRAIN RATE
603C------------------------
604 ELSEIF (itens == 91) THEN
605 istre = 2
606 a1 = one
607 a2 = zero
608 ELSEIF (itens == 92) THEN
609 istre = 2
610 a1 = zero
611 a2 = one
612 ELSEIF (itens == 93) THEN
613 istre = 2
614 a1 = one
615 a2 = half
616 ELSEIF (itens == 94) THEN
617 istre = 2
618 a1 = one
619 a2 = -half
620 ELSEIF (itens > 300 .AND. itens < 401) THEN
621 istre = 2
622 ipt = min(mpt,itens - 300)
623 IF (itens - 300 > mpt) THEN
624 a1 = zero
625 a2 = zero
626 ELSEIF (npt /= 0) THEN
627 a1 = one
628 a2 = half*(((2*ipt-one)/mpt)-one)
629 ELSE
630 a1 = one
631 a2 = zero
632 ENDIF
633 ELSEIF (itens > 1610+ 2*mx_ply_anim .AND. itens < 1611 + 3*mx_ply_anim ) THEN
634 il = itens - (1610+ 2*mx_ply_anim)
635 istre = 2
636 a1 = zero
637 a2 = zero
638 IF (igtyp == 17 .OR. igtyp == 51 .OR. igtyp == 52) THEN
639 IF (ply_anim_epsdot( 3 * (il - 1) + 2) == 6 )THEN
640 ipang = 1
641 ipthk = ipang + nlay
642 ippos = ipthk + nlay
643 ipt = ply_anim_epsdot( 3 * (il - 1) + 3)
644 DO j=1,nlay
645 bufly => elbuf_tab(ng)%BUFLY(j)
646 nptt = bufly%NPTT
647 IF (igtyp == 17 .OR. igtyp == 51) THEN
648 id_ply = igeo(1,stack%IGEO(2+j,isubstack))
649 ELSEIF (igtyp == 52) THEN
650 id_ply = ply_info(1,stack%IGEO(2+j,isubstack)-numstack)
651 ENDIF
652 IF (id_ply == ply_anim_epsdot( 3 * (il - 1) + 1) ) THEN
653 a1 = one
654c A2 = STACK%GEO(IPPOS+J,ISUBSTACK)
655 a2 = stack%GEO(ippos+j,isubstack)+
656 . half*(((2*ipt-one)/nptt)-one) *
657 . stack%GEO(ipthk+j,isubstack)
658 ENDIF
659 ENDDO
660 ENDIF
661 ELSE
662 istre = 2
663 a1 = zero
664 a2 = zero
665 ENDIF
666!
667 ELSEIF (itens > 2820 + 3*mx_ply_anim .AND.
668 . itens < 2921 + 3*mx_ply_anim) THEN
669!-------------------
670 ! EPSDOT/ILAY/UPPER -> UPPER epsdot within each layer (PID51,52)
671!-------------------
672 istre = 2
673 a1 = zero
674 a2 = zero
675 IF (igtyp == 51 .OR. igtyp == 52) THEN
676!
677 idx = 2820 + 3*mx_ply_anim
678!
679 ilay = mod((itens - idx),100)
680 IF (ilay == 0) ilay = 100
681 IF (nlay > 1) THEN
682 il = max(1,ilay)
683 ELSE
684 il = 1
685 ENDIF
686 bufly => elbuf_tab(ng)%BUFLY(il)
687 nptt = bufly%NPTT
688 it = max(1,nptt)
689!
690 ipang = 1
691 ipthk = ipang + nlay
692 ippos = ipthk + nlay
693!
694 IF (il <= nlay) THEN
695 a1 = one
696 a2 = stack%GEO(ippos+il,isubstack)+
697 . half*(((2*it-one)/nptt)-one) *
698 . stack%GEO(ipthk+il,isubstack)
699 ENDIF
700 ENDIF ! IF (IGTYP == 51 .OR. IGTYP == 52)
701!
702 ELSEIF (itens > 2920 + 3*mx_ply_anim .AND.
703 . itens < 3021 + 3*mx_ply_anim) THEN
704!-------------------
705 ! EPSDOT/ILAY/LOWER -> LOWER epsdot within each layer (PID51,52)
706!-------------------
707 istre = 2
708 a1 = zero
709 a2 = zero
710 IF (igtyp == 51 .OR. igtyp == 52) THEN
711!
712 idx = 2920 + 3*mx_ply_anim
713!
714 ilay = mod((itens - idx),100)
715 IF (ilay == 0) ilay = 100
716 IF (nlay > 1) THEN
717 il = max(1,ilay)
718 ELSE
719 il = 1
720 ENDIF
721 bufly => elbuf_tab(ng)%BUFLY(il)
722 nptt = bufly%NPTT
723 it = 1
724!
725 ipang = 1
726 ipthk = ipang + nlay
727 ippos = ipthk + nlay
728!
729 IF (il <= nlay) THEN
730 a1 = one
731 a2 = stack%GEO(ippos+il,isubstack)+
732 . half*(((2*it-one)/nptt)-one) *
733 . stack%GEO(ipthk+il,isubstack)
734 ENDIF
735 ENDIF ! IF (IGTYP == 51 .OR. IGTYP == 52)
736!
737 ELSEIF (itens > 3020 + 3*mx_ply_anim .AND.
738 . itens < 4031 + 3*mx_ply_anim) THEN
739!-------------------
740 ! EPSDOT/ILAY/IT -> all epsdot within each layer (PID51,52)
741!-------------------
742 istre = 2
743 a1 = zero
744 a2 = zero
745 IF (igtyp == 51 .OR. igtyp == 52) THEN
746!
747 idx = 3020 + 3*mx_ply_anim
748!
749 ius = itens - idx
750 ilay = int((ius - 1)/10)
751 IF (ilay == 0) ilay = 100
752 il = ilay
753 it = ius - 10*il
754!
755 ipang = 1
756 ipthk = ipang + nlay
757 ippos = ipthk + nlay
758!
759 IF (il <= nlay) THEN
760 bufly => elbuf_tab(ng)%BUFLY(il)
761 nptt = bufly%NPTT
762 IF (it <= nptt) THEN
763 a1 = one
764 a2 = stack%GEO(ippos+il,isubstack)+
765 . half*(((2*it-one)/nptt)-one) *
766 . stack%GEO(ipthk+il,isubstack)
767 ENDIF
768 ENDIF ! IF (IL <= NLAY)
769 ENDIF ! IF (IGTYP == 51 .OR. IGTYP == 52)
770!
771 !ELSEIF (ITENS > 4030 + 3*MX_PLY_ANIM) THEN --> see /EPSDOT/ALL/ALL
772 !next available animation file
773 ENDIF ! IF (ITENS == 1)
774c-----------------------------------------------------------
775c-----------------------------------------------------------
776!
777 IF (istre == 1) THEN
778C------------------------
779C STRESS
780C------------------------
781 ivisc = 0
782
783C----------
784 IF (itens == 1) THEN
785 ! /TENS/STRESS/MEMB
786 DO i=lft,llt
787 n = i + nft
788 r4(1) = gbuf%FOR(jj(1)+i)
789 r4(2) = gbuf%FOR(jj(2)+i)
790 r4(3) = gbuf%FOR(jj(3)+i)
791 r4(3) = r4(3) * invert(el2fa(nni+n))
792 tens(1,el2fa(nni+n)) = r4(1)
793 tens(2,el2fa(nni+n)) = r4(2)
794 tens(3,el2fa(nni+n)) = r4(3)
795 ENDDO
796c
797 ELSE IF (itens == 2) THEN
798 ! /TENS/STRESS/BEND
799c
800 DO i=lft,llt
801 n = i + nft
802 r4(1) = gbuf%MOM(jj(1)+i)
803 r4(2) = gbuf%MOM(jj(2)+i)
804 r4(3) = gbuf%MOM(jj(3)+i)
805 r4(3) = r4(3) * invert(el2fa(nni+n))
806 tens(1,el2fa(nni+n)) = r4(1)
807 tens(2,el2fa(nni+n)) = r4(2)
808 tens(3,el2fa(nni+n)) = r4(3)
809 ENDDO
810c
811 ELSE IF (itens == 3 .OR. itens == 4) THEN
812 ! /TENS/STRESS/UPPER
813 ! /TENS/STRESS/LOWER
814 IF (npt /= 0) THEN
815 IF (itens == 3) THEN ! upper
816 IF (igtyp == 1 .OR. igtyp == 9) THEN
817 il = 1
818 ipt = elbuf_tab(ng)%BUFLY(il)%NPTT
819 ELSE IF (igtyp == 10 .OR. igtyp == 11 .OR. igtyp == 16) THEN
820 il = elbuf_tab(ng)%NLAY
821 ipt = 1
822 ELSE IF (igtyp == 17 .OR. igtyp == 51 .OR. igtyp == 52) THEN
823 il = elbuf_tab(ng)%NLAY
824 ipt = elbuf_tab(ng)%BUFLY(il)%NPTT
825 END IF
826 ELSE IF (itens == 4) THEN ! lower
827 ipt = 1
828 il = 1
829 END IF
830 imat = elbuf_tab(ng)%BUFLY(il)%IMAT
831 ivisc = mat_param(imat)%IVISC
832 DO i=1,nel
833 DO ir=1,nptr
834 DO is=1,npts
835 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,ipt)
836 sige(i,1) = sige(i,1) + lbuf%SIG(jj(1) + i) / npg
837 sige(i,2) = sige(i,2) + lbuf%SIG(jj(2) + i) / npg
838 sige(i,3) = sige(i,3) + lbuf%SIG(jj(3) + i) / npg
839 ENDDO
840 ENDDO
841 ENDDO
842 IF (ivisc > 0) THEN
843 DO i=1,nel
844 DO ir=1,nptr
845 DO is=1,npts
846 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,ipt)
847 sige(i,1) = sige(i,1) + lbuf%VISC(jj(1) + i) / npg
848 sige(i,2) = sige(i,2) + lbuf%VISC(jj(2) + i) / npg
849 sige(i,3) = sige(i,3) + lbuf%VISC(jj(3) + i) / npg
850 ENDDO
851 ENDDO
852 ENDDO
853 END IF
854 mat_orth = mat_param(imat)%ORTHOTROPY
855 IF (mat_orth == 2) THEN
856 IF(idrape > 0 .AND. (igtyp == 51 .OR. igtyp ==52)) THEN
857 dir_a => elbuf_tab(ng)%BUFLY(il)%LBUF_DIR(ipt)%DIRA
858 ELSE
859 dir_a => elbuf_tab(ng)%BUFLY(il)%DIRA
860 ENDIF
861 CALL uroto_tens2d(nel,sige,dir_a)
862 END IF
863 ELSE
864 a2 = zero
865 IF (itens == 3) a2 = six ! upper
866 IF (itens == 4) a2 = -six ! lower
867 DO i=1,nel
868 sige(i,1) = gbuf%FOR(jj(1)+i) + gbuf%MOM(jj(1)+i) * a2
869 sige(i,2) = gbuf%FOR(jj(2)+i) + gbuf%MOM(jj(2)+i) * a2
870 sige(i,3) = gbuf%FOR(jj(3)+i) + gbuf%MOM(jj(3)+i) * a2
871 ENDDO
872 ENDIF
873c
874 DO i=lft,llt
875 n = i + nft
876 r4(1) = sige(i,1)
877 r4(2) = sige(i,2)
878 r4(3) = sige(i,3)
879 r4(3) = r4(3) * invert(el2fa(nni+n))
880 tens(1,el2fa(nni+n)) = r4(1)
881 tens(2,el2fa(nni+n)) = r4(2)
882 tens(3,el2fa(nni+n)) = r4(3)
883 ENDDO
884c
885 ELSE IF (itens > 100 .AND. itens < 201) THEN
886 ! /TENS/STRESS/NPT <=> IGTYP = 1,9
887 ! /TENS/STRESS/ILAY <=> IGTYP = 10,11,16
888 ! /TENS/STRESS/PLY_ID <=> IGTYP = 17
889
890 ipt = itens-100
891 IF (igtyp == 51 .OR. igtyp == 52 .OR. igtyp == 17) THEN
892 input_error = 1 ! IGTYP 51,52 does not support this syntax
893 ELSE
894 IF (npt /= 0) THEN
895 IF (igtyp == 1 .OR. igtyp == 9) THEN
896 il = 1
897 ipt = min(ipt, elbuf_tab(ng)%BUFLY(1)%NPTT)
898 ELSE IF (igtyp == 10 .OR. igtyp == 11 .OR. igtyp == 16) THEN
899 il = min(ipt, elbuf_tab(ng)%NLAY)
900 ipt = 1
901 END IF
902c
903 imat = elbuf_tab(ng)%BUFLY(il)%IMAT
904 ivisc = mat_param(imat)%IVISC
905 DO i=1,nel
906 DO ir=1,nptr
907 DO is=1,npts
908 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,ipt)
909 sige(i,1) = sige(i,1) + lbuf%SIG(jj(1) + i) / npg
910 sige(i,2) = sige(i,2) + lbuf%SIG(jj(2) + i) / npg
911 sige(i,3) = sige(i,3) + lbuf%SIG(jj(3) + i) / npg
912 ENDDO
913 ENDDO
914 ENDDO
915 IF (ivisc > 0) THEN
916 DO i=1,nel
917 DO ir=1,nptr
918 DO is=1,npts
919 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,ipt)
920 sige(i,1) = sige(i,1) + lbuf%VISC(jj(1) + i) / npg
921 sige(i,2) = sige(i,2) + lbuf%VISC(jj(2) + i) / npg
922 sige(i,3) = sige(i,3) + lbuf%VISC(jj(3) + i) / npg
923 ENDDO
924 ENDDO
925 ENDDO
926 END IF
927 mat_orth = mat_param(imat)%ORTHOTROPY
928 IF (mat_orth == 2) THEN
929 dir_a => elbuf_tab(ng)%BUFLY(il)%DIRA
930 CALL uroto_tens2d(nel,sige,dir_a)
931 END IF
932 ELSE
933 DO i=1,nel
934 sige(i,1) = gbuf%FOR(jj(1)+i)
935 sige(i,2) = gbuf%FOR(jj(2)+i)
936 sige(i,3) = gbuf%FOR(jj(3)+i)
937 ENDDO
938 ENDIF
939c
940 DO i=lft,llt
941 n = i + nft
942 r4(1) = sige(i,1)
943 r4(2) = sige(i,2)
944 r4(3) = sige(i,3)
945 r4(3) = r4(3) * invert(el2fa(nni+n))
946 tens(1,el2fa(nni+n)) = r4(1)
947 tens(2,el2fa(nni+n)) = r4(2)
948 tens(3,el2fa(nni+n)) = r4(3)
949 ENDDO
950 END IF
951
952C----------
953 ELSEIF (itens > 400 .AND. itens < 501) THEN
954 ! /TENS/STRESS/PLY_ID/UPPER
955C-----
956 iply = itens - 400
957 IF (igtyp == 17 .OR. igtyp == 51 .OR. igtyp == 52) THEN
958 il = elbuf_tab(ng)%NLAY
959 ipt = elbuf_tab(ng)%BUFLY(il)%NPTT
960 DO j=1,nlay
961 id_ply = igeo(1,stack%IGEO(2+j,isubstack))
962 IF (id_ply == iply) THEN
963 il = j
964 ipt = elbuf_tab(ng)%BUFLY(il)%NPTT
965 EXIT
966 END IF
967 END DO
968 imat = elbuf_tab(ng)%BUFLY(il)%IMAT
969 ivisc = mat_param(imat)%IVISC
970C
971 sige(1:nel,1:3) = zero
972 DO i=1,nel
973 DO ir=1,nptr
974 DO is=1,npts
975 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,ipt)
976 sige(i,1) = sige(i,1) + lbuf%SIG(jj(1) + i) / npg
977 sige(i,2) = sige(i,2) + lbuf%SIG(jj(2) + i) / npg
978 sige(i,3) = sige(i,3) + lbuf%SIG(jj(3) + i) / npg
979 ENDDO
980 ENDDO
981 ENDDO
982c
983 IF (ivisc > 0) THEN
984 DO i=1,nel
985 DO ir=1,nptr
986 DO is=1,npts
987 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,ipt)
988 sige(i,1) = sige(i,1) + lbuf%VISC(jj(1) + i) / npg
989 sige(i,2) = sige(i,2) + lbuf%VISC(jj(2) + i) / npg
990 sige(i,3) = sige(i,3) + lbuf%VISC(jj(3) + i) / npg
991 ENDDO
992 ENDDO
993 ENDDO
994 END IF
995c
996 mat_orth = mat_param(imat)%ORTHOTROPY
997 IF (mat_orth == 2) THEN
998 dir_a => elbuf_tab(ng)%BUFLY(il)%DIRA
999 CALL uroto_tens2d(nel,sige,dir_a)
1000 END IF
1001C
1002 DO i=lft,llt
1003 n = nft + i
1004 r4(1) = sige(i,1)
1005 r4(2) = sige(i,2)
1006 r4(3) = sige(i,3)
1007 r4(3) = r4(3) * invert(el2fa(nni+n))
1008 tens(1,el2fa(nni+n)) = r4(1)
1009 tens(2,el2fa(nni+n)) = r4(2)
1010 tens(3,el2fa(nni+n)) = r4(3)
1011 ENDDO
1012 END IF
1013C-----
1014 ELSEIF (itens > 500 .AND. itens < 601 .AND.
1015 . (igtyp == 17 .OR. igtyp == 51 .OR. igtyp == 52)) THEN
1016 ! /TENS/STRESS/PLY_ID/LOWER
1017 il = 1
1018 ipt = 1
1019 iply = itens - 500
1020 DO j=1,nlay
1021 id_ply = igeo(1,stack%IGEO(2+j,isubstack))
1022 IF (id_ply == iply) THEN
1023 il = j
1024 EXIT
1025 END IF
1026 END DO
1027 imat = elbuf_tab(ng)%BUFLY(il)%IMAT
1028 ivisc = mat_param(imat)%IVISC
1029C
1030 sige(1:nel,1:3) = zero
1031 DO i=1,nel
1032 DO ir=1,nptr
1033 DO is=1,npts
1034 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,ipt)
1035 sige(i,1) = sige(i,1) + lbuf%SIG(jj(1) + i) / npg
1036 sige(i,2) = sige(i,2) + lbuf%SIG(jj(2) + i) / npg
1037 sige(i,3) = sige(i,3) + lbuf%SIG(jj(3) + i) / npg
1038 ENDDO
1039 ENDDO
1040 ENDDO
1041c
1042 IF (ivisc > 0) THEN
1043 DO i=1,nel
1044 DO ir=1,nptr
1045 DO is=1,npts
1046 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,ipt)
1047 sige(i,1) = sige(i,1) + lbuf%VISC(jj(1) + i) / npg
1048 sige(i,2) = sige(i,2) + lbuf%VISC(jj(2) + i) / npg
1049 sige(i,3) = sige(i,3) + lbuf%VISC(jj(3) + i) / npg
1050 ENDDO
1051 ENDDO
1052 ENDDO
1053 END IF
1054c
1055 mat_orth = mat_param(imat)%ORTHOTROPY
1056 IF (mat_orth == 2) THEN
1057 dir_a => elbuf_tab(ng)%BUFLY(il)%DIRA
1058 CALL uroto_tens2d(nel,sige,dir_a)
1059 END IF
1060C
1061 DO i=lft,llt
1062 n = nft + i
1063 r4(1) = sige(i,1)
1064 r4(2) = sige(i,2)
1065 r4(3) = sige(i,3)
1066 r4(3) = r4(3) * invert(el2fa(nni+n))
1067 tens(1,el2fa(nni+n)) = r4(1)
1068 tens(2,el2fa(nni+n)) = r4(2)
1069 tens(3,el2fa(nni+n)) = r4(3)
1070 ENDDO
1071c
1072 ELSE IF (itens > 600 .AND. itens < 1611) THEN
1073c /TENS/STRESS/ILAY - only compatible with IGTYP 10,11,16
1074 IF ((igtyp == 10 .OR. igtyp == 11 .OR. igtyp == 16)) THEN
1075 ius = itens - 600
1076 ilay = int((ius - 1)/10)
1077 IF (ilay == 0) ilay = 100
1078 il = min(ilay, elbuf_tab(ng)%NLAY)
1079c IT = IUS - 10*IL
1080 ipt = 1
1081 imat = elbuf_tab(ng)%BUFLY(il)%IMAT
1082 ivisc = mat_param(imat)%IVISC
1083C
1084 sige(1:nel,1:3) = zero
1085 DO i=1,nel
1086 DO ir=1,nptr
1087 DO is=1,npts
1088 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,ipt)
1089 sige(i,1) = sige(i,1) + lbuf%SIG(jj(1) + i) / npg
1090 sige(i,2) = sige(i,2) + lbuf%SIG(jj(2) + i) / npg
1091 sige(i,3) = sige(i,3) + lbuf%SIG(jj(3) + i) / npg
1092 ENDDO
1093 ENDDO
1094 ENDDO
1095c
1096 IF (ivisc > 0) THEN
1097 DO i=1,nel
1098 DO ir=1,nptr
1099 DO is=1,npts
1100 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,ipt)
1101 sige(i,1) = sige(i,1) + lbuf%VISC(jj(1) + i) / npg
1102 sige(i,2) = sige(i,2) + lbuf%VISC(jj(2) + i) / npg
1103 sige(i,3) = sige(i,3) + lbuf%VISC(jj(3) + i) / npg
1104 ENDDO
1105 ENDDO
1106 ENDDO
1107 END IF
1108c
1109 mat_orth = mat_param(imat)%ORTHOTROPY
1110 IF (mat_orth == 2) THEN
1111 dir_a => elbuf_tab(ng)%BUFLY(il)%DIRA
1112 CALL uroto_tens2d(nel,sige,dir_a)
1113 END IF
1114C
1115 DO i=lft,llt
1116 n = nft + i
1117 r4(1) = sige(i,1)
1118 r4(2) = sige(i,2)
1119 r4(3) = sige(i,3)
1120 r4(3) = r4(3) * invert(el2fa(nni+n))
1121 tens(1,el2fa(nni+n)) = r4(1)
1122 tens(2,el2fa(nni+n)) = r4(2)
1123 tens(3,el2fa(nni+n)) = r4(3)
1124 ENDDO
1125 END IF
1126c------------------------------------
1127 ELSEIF (itens > 1610 .AND. itens < 1611 + mx_ply_anim ) THEN
1128 ! /IDPLY/STRESS/PLY_ID/IPT : output in element coordinate system
1129
1130 IF (igtyp == 17 .or. igtyp == 51 .or. igtyp == 52) THEN
1131 sige(1:nel,1:3) = zero
1132 iply = itens - 1610
1133 IF (ply_anim_stress(3*(iply - 1) + 2) == 2) THEN
1134 ipt = ply_anim_stress(3*(iply - 1) + 3)
1135c
1136 DO il=1,nlay
1137 IF (igtyp == 17 .OR. igtyp == 51) THEN
1138 id_ply = igeo(1,stack%IGEO(2+il,isubstack))
1139 ELSE IF (igtyp == 52) THEN
1140 id_ply = ply_info(1,stack%IGEO(2+il,isubstack) - numstack)
1141 END IF
1142 IF (id_ply == ply_anim_stress(3*(iply - 1) + 1)) THEN
1143 imat = elbuf_tab(ng)%BUFLY(il)%IMAT
1144 ivisc = mat_param(imat)%IVISC
1145 IF (ipt <= elbuf_tab(ng)%BUFLY(il)%NPTT) THEN
1146 DO i=1,nel
1147 DO ir=1,nptr
1148 DO is=1,npts
1149 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,ipt)
1150 sige(i,1) = sige(i,1) + lbuf%SIG(jj(1) + i) / npg
1151 sige(i,2) = sige(i,2) + lbuf%SIG(jj(2) + i) / npg
1152 sige(i,3) = sige(i,3) + lbuf%SIG(jj(3) + i) / npg
1153 ENDDO
1154 ENDDO
1155 ENDDO
1156c
1157 mat_orth = mat_param(imat)%ORTHOTROPY
1158 IF (mat_orth > 0) THEN
1159 IF (idrape > 0 .AND. (igtyp == 51 .OR. igtyp ==52) ) THEN
1160 dir_a => elbuf_tab(ng)%BUFLY(il)%LBUF_DIR(ipt)%DIRA
1161 dir_b => elbuf_tab(ng)%BUFLY(il)%LBUF_DIR(ipt)%DIRB
1162 ELSE
1163 dir_a => elbuf_tab(ng)%BUFLY(il)%DIRA
1164 dir_b => elbuf_tab(ng)%BUFLY(il)%DIRB
1165 ENDIF
1166 END IF
1167 IF (mat_orth == 2) THEN
1168 CALL uroto_tens2d(nel,sige,dir_a)
1169 ELSE IF (mat_orth == 3) THEN ! anisotropic (law 58,158 only)
1170 CALL uroto_tens2d_aniso(nel,sige,dir_a,dir_b)
1171 END IF
1172c
1173 DO i=1,nel
1174 n = nft + i
1175 r4(1) = sige(i,1)
1176 r4(2) = sige(i,2)
1177 r4(3) = sige(i,3)
1178 r4(3) = r4(3) * invert(el2fa(nni+n))
1179 tens(1,el2fa(nni+n)) = r4(1)
1180 tens(2,el2fa(nni+n)) = r4(2)
1181 tens(3,el2fa(nni+n)) = r4(3)
1182 ENDDO
1183c
1184 EXIT
1185 ENDIF ! ID_PLY == IPLY
1186 ENDIF ! IPT <== NPTT
1187 ENDDO ! NLAY
1188 END IF
1189 END IF ! IGTYP
1190c
1191 ELSE IF (itens == idx_mstress+2 .OR. itens == idx_mstress+3) THEN
1192 ! /TENS/MSTRESS/UPPER
1193 ! /TENS/MSTRESS/LOWER
1194
1195 IF (itens == idx_mstress+2) THEN ! upper
1196 IF (igtyp == 1 .OR. igtyp == 9) THEN
1197 il = 1
1198 ipt = elbuf_tab(ng)%BUFLY(il)%NPTT
1199 ELSE IF (igtyp == 10 .OR. igtyp == 11 .OR. igtyp == 16) THEN
1200 il = elbuf_tab(ng)%NLAY
1201 ipt = 1
1202 ELSE IF (igtyp == 17 .OR. igtyp == 51 .OR. igtyp == 52) THEN
1203 il = elbuf_tab(ng)%NLAY
1204 ipt = elbuf_tab(ng)%BUFLY(il)%NPTT
1205 END IF
1206 ELSE IF (itens == idx_mstress+3) THEN ! lower
1207 ipt = 1
1208 il = 1
1209 END IF
1210c
1211 imat = elbuf_tab(ng)%BUFLY(il)%IMAT
1212 ivisc = mat_param(imat)%IVISC
1213 DO i=1,nel
1214 DO ir=1,nptr
1215 DO is=1,npts
1216 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,ipt)
1217 sige(i,1) = sige(i,1) + lbuf%SIG(jj(1) + i) / npg
1218 sige(i,2) = sige(i,2) + lbuf%SIG(jj(2) + i) / npg
1219 sige(i,3) = sige(i,3) + lbuf%SIG(jj(3) + i) / npg
1220 ENDDO
1221 ENDDO
1222 ENDDO
1223 IF (ivisc > 0) THEN
1224 DO i=1,nel
1225 DO ir=1,nptr
1226 DO is=1,npts
1227 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,ipt)
1228 sige(i,1) = sige(i,1) + lbuf%VISC(jj(1) + i) / npg
1229 sige(i,2) = sige(i,2) + lbuf%VISC(jj(2) + i) / npg
1230 sige(i,3) = sige(i,3) + lbuf%VISC(jj(3) + i) / npg
1231 ENDDO
1232 ENDDO
1233 ENDDO
1234 END IF
1235c
1236 DO i=lft,llt
1237 n = i + nft
1238 r4(1) = sige(i,1)
1239 r4(2) = sige(i,2)
1240 r4(3) = sige(i,3)
1241 r4(3) = r4(3) * invert(el2fa(nni+n))
1242 tens(1,el2fa(nni+n)) = r4(1)
1243 tens(2,el2fa(nni+n)) = r4(2)
1244 tens(3,el2fa(nni+n)) = r4(3)
1245 ENDDO
1246c
1247 ELSE IF (itens > idx_mstress+3 .AND. itens < idx_mstress+103) THEN
1248 ! /TENS/MSTRESS/NPT <=> IGTYP = 1,9
1249 ! /TENS/MSTRESS/ILAY <=> IGTYP = 10,11,16
1250 ! /TENS/MSTRESS/PLY_ID <=> IGTYP = 17
1251
1252 ipt = itens-100
1253 IF (igtyp == 51 .OR. igtyp == 52) THEN
1254 input_error = 1 ! IGTYP 51,52 does not support this syntax
1255 ELSE
1256 IF (igtyp == 1 .OR. igtyp == 9) THEN
1257 il = 1
1258 ipt = min(ipt, elbuf_tab(ng)%BUFLY(1)%NPTT)
1259 ELSE IF (igtyp == 10 .OR. igtyp == 11 .OR. igtyp == 16) THEN
1260 ipt = 1
1261 il = min(ipt, elbuf_tab(ng)%NLAY)
1262 ELSE IF (igtyp == 17) THEN ! defined by ply ID
1263 iply = ipt
1264 ipt = 1
1265 il = 1
1266 DO j=1,nlay
1267 id_ply = igeo(1,stack%IGEO(2+j,isubstack))
1268 IF (id_ply == iply) THEN
1269 il = j
1270 EXIT
1271 END IF
1272 END DO
1273 END IF
1274 imat = elbuf_tab(ng)%BUFLY(il)%IMAT
1275 ivisc = mat_param(imat)%IVISC
1276 DO i=1,nel
1277 DO ir=1,nptr
1278 DO is=1,npts
1279 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,ipt)
1280 sige(i,1) = sige(i,1) + lbuf%SIG(jj(1) + i) / npg
1281 sige(i,2) = sige(i,2) + lbuf%SIG(jj(2) + i) / npg
1282 sige(i,3) = sige(i,3) + lbuf%SIG(jj(3) + i) / npg
1283 ENDDO
1284 ENDDO
1285 ENDDO
1286 IF (ivisc > 0) THEN
1287 DO i=1,nel
1288 DO ir=1,nptr
1289 DO is=1,npts
1290 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,ipt)
1291 sige(i,1) = sige(i,1) + lbuf%VISC(jj(1) + i) / npg
1292 sige(i,2) = sige(i,2) + lbuf%VISC(jj(2) + i) / npg
1293 sige(i,3) = sige(i,3) + lbuf%VISC(jj(3) + i) / npg
1294 ENDDO
1295 ENDDO
1296 ENDDO
1297 END IF
1298c
1299 DO i=lft,llt
1300 n = i + nft
1301 r4(1) = sige(i,1)
1302 r4(2) = sige(i,2)
1303 r4(3) = sige(i,3)
1304 r4(3) = r4(3) * invert(el2fa(nni+n))
1305 tens(1,el2fa(nni+n)) = r4(1)
1306 tens(2,el2fa(nni+n)) = r4(2)
1307 tens(3,el2fa(nni+n)) = r4(3)
1308 ENDDO
1309 END IF
1310c
1311c------------------------------------
1312 ELSEIF (itens > idx_idply_mstress .AND.
1313 . itens < idx_idply_mstress + mx_ply_anim ) THEN
1314 ! /ANIM/SHELL/IDPLY/MSTRESS/PLY_ID/IPT : output in material coordinate system
1315
1316 IF (igtyp == 17 .or. igtyp == 51 .or. igtyp == 52) THEN
1317 sige(1:nel,1:3) = zero
1318 iply = itens - idx_idply_mstress
1319 IF (ply_anim_stress(3*(iply - 1) + 2) == 3) THEN
1320c
1321 ipt = ply_anim_stress(3*(iply - 1) + 3)
1322 DO il=1,nlay
1323 IF (igtyp == 17 .OR. igtyp == 51) THEN
1324 id_ply = igeo(1,stack%IGEO(2+il,isubstack))
1325 ELSE IF (igtyp == 52) THEN
1326 id_ply = ply_info(1,stack%IGEO(2+il,isubstack) - numstack)
1327 END IF
1328 IF (id_ply == iply) THEN
1329 imat = elbuf_tab(ng)%BUFLY(il)%IMAT
1330 ivisc = mat_param(imat)%IVISC
1331 IF (ipt <= elbuf_tab(ng)%BUFLY(il)%NPTT) THEN
1332 DO i=1,nel
1333 DO ir=1,nptr
1334 DO is=1,npts
1335 lbuf => elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,ipt)
1336 sige(i,1) = sige(i,1) + lbuf%SIG(jj(1) + i) / npg
1337 sige(i,2) = sige(i,2) + lbuf%SIG(jj(2) + i) / npg
1338 sige(i,3) = sige(i,3) + lbuf%SIG(jj(3) + i) / npg
1339 ENDDO
1340 ENDDO
1341 ENDDO
1342c
1343 DO i=1,nel
1344 n = nft + i
1345 r4(1) = sige(i,1)
1346 r4(2) = sige(i,2)
1347 r4(3) = sige(i,3)
1348 r4(3) = r4(3) * invert(el2fa(nni+n))
1349 tens(1,el2fa(nni+n)) = r4(1)
1350 tens(2,el2fa(nni+n)) = r4(2)
1351 tens(3,el2fa(nni+n)) = r4(3)
1352 ENDDO
1353c
1354 EXIT
1355 ENDIF ! ID_PLY == IPLY
1356 ENDIF ! IPT <== NPTT
1357 ENDDO ! NLAY
1358 END IF
1359 END IF ! IGTYP
1360C----------
1361 ELSE IF (itens >= 1 .and. itens <= 4) THEN
1362 ! ITENS=1,2 (membrane, bending) 3,4 ,NPT=0 IGTYP=1
1363 DO i=lft,llt
1364 n = i + nft
1365 DO j=1,3
1366 r4(j) = a1 * gbuf%FOR(jj(j)+i) + a2 * gbuf%MOM(jj(j)+i)
1367 ENDDO
1368 r4(3) = r4(3) * invert(el2fa(nni+n))
1369 tens(1,el2fa(nni+n)) = r4(1)
1370 tens(2,el2fa(nni+n)) = r4(2)
1371 tens(3,el2fa(nni+n)) = r4(3)
1372 ENDDO
1373 ENDIF ! STRESS
1374C------------------------
1375 ELSEIF (istre == 0 .AND. istrain > 0) THEN ! strain
1376C--------
1377C STRAIN 5:mem,6:bend,7:upper,8:lower
1378C--------
1379 IF (itens == 5) THEN
1380 DO i=lft,llt
1381 n = i + nft
1382 thk = gbuf%THK(i)
1383 j = el2fa(nni+n)
1384 r4(1) = gbuf%STRA(jj(1)+i)
1385 r4(2) = gbuf%STRA(jj(2)+i)
1386 r4(3) = gbuf%STRA(jj(3)+i) * invert(j)*half
1387 tens(1,j) = r4(1)
1388 tens(2,j) = r4(2)
1389 tens(3,j) = r4(3)
1390 ENDDO
1391 ELSE
1392 DO i=lft,llt
1393 n = i + nft
1394 thk = gbuf%THK(i)
1395 j = el2fa(nni+n)
1396 r4(1) = a1*gbuf%STRA(jj(1)+i) + a2*gbuf%STRA(jj(6)+i) * thk
1397 r4(2) = a1*gbuf%STRA(jj(2)+i) + a2*gbuf%STRA(jj(7)+i) * thk
1398 r4(3) = a1*gbuf%STRA(jj(3)+i) + a2*gbuf%STRA(jj(8)+i) * thk
1399 r4(3) = r4(3) * invert(j) * half
1400 tens(1,j) = r4(1)
1401 tens(2,j) = r4(2)
1402 tens(3,j) = r4(3)
1403 ENDDO
1404 ENDIF
1405C------------------------
1406 ELSEIF (istre == 2) THEN
1407C---------
1408C STRAIN RATE
1409C---------
1410c------------------------------------
1411 DO i=lft,llt
1412 n = i + nft
1413 thk = gbuf%THK(i)
1414 IF (itens /= 92) THEN
1415 DO j=1,3
1416 r4(j) = a1*epsdot(j,n+n0) + a2*epsdot(j+3,n+n0)*thk
1417 ENDDO
1418 ELSE
1419 DO j=1,3
1420 r4(j) = epsdot(j+3,n+n0)
1421 ENDDO
1422 ENDIF
1423 r4(3) = r4(3) * invert(el2fa(nni+n)) * half
1424 tens(1,el2fa(nni+n)) = r4(1)
1425 tens(2,el2fa(nni+n)) = r4(2)
1426 tens(3,el2fa(nni+n)) = r4(3)
1427 ENDDO
1428 ENDIF ! (STRESS) ISTRE == 1
1429 ENDIF ! IF (MLW /= 13)
1430 ENDIF ! IF(ITY == 2)
1431c
1432 IF(ALLOCATED(matly)) DEALLOCATE(matly)
1433 IF(ALLOCATED(thkly)) DEALLOCATE(thkly)
1434 IF(ALLOCATED(posly)) DEALLOCATE(posly)
1435 IF(ALLOCATED(thk_ly)) DEALLOCATE(thk_ly)
1436C-----------------------------------------------
1437 490 CONTINUE ! NGROUP
1438 500 CONTINUE
1439C-----------------------------------------------
1440 IF (nspmd == 1)THEN
1441 DO n=1,nbf
1442 r4(1) = tens(1,n)
1443 r4(2) = tens(2,n)
1444 r4(3) = tens(3,n)
1445 CALL write_r_c(r4,3)
1446 ENDDO
1447 ELSE
1448 DO n = 1, nbf_l
1449 wa(3*n-2) = tens(1,n)
1450 wa(3*n-1) = tens(2,n)
1451 wa(3*n ) = tens(3,n)
1452 ENDDO
1453 IF (ispmd == 0) THEN
1454 buf = (numelqg+numelcg+numeltgg)*3
1455 ELSE
1456 buf = 1
1457 ENDIF
1458 CALL spmd_r4get_partn(3,3*nbf_l,nbpart,iadg,wa,buf)
1459 ENDIF
1460C-----------------------------------------------
1461 IF (nelcut > 0) THEN
1462 IF (nspmd == 1) THEN
1463 DO i=1,nelcut
1464 CALL write_r_c(r4,3)
1465 ENDDO
1466 ELSEIF (ispmd == 0) THEN
1467C verifier l'interet de ce qui est fait ci-dessus !!!!!!!!!!!!!!
1468 DO i=1,nelcut
1469 CALL write_r_c(wa(3*nbf_l-2),3)
1470 ENDDO
1471 ENDIF
1472 ENDIF
1473C
1474 DEALLOCATE(wa)
1475 RETURN
1476 END
1477!||====================================================================
1478!|| tencgps1 ../engine/source/output/anim/generate/tensorc.F
1479!||--- called by ------------------------------------------------------
1480!|| genani ../engine/source/output/anim/generate/genani.F
1481!||--- calls -----------------------------------------------------
1482!|| shlrotg ../engine/source/output/anim/generate/tensor6.F
1483!||--- uses -----------------------------------------------------
1484!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
1485!||====================================================================
1486 SUBROUTINE tencgps1(ELBUF_TAB ,IPARG,ITENS,TENS1 ,TENS2 ,
1487 . X ,IXC ,IGEO ,IXTG ,ITAGPS )
1488C-----------------------------------------------
1489C M o d u l e s
1490C-----------------------------------------------
1491 USE elbufdef_mod
1492C-----------------------------------------------
1493C I m p l i c i t T y p e s
1494C-----------------------------------------------
1495#include "implicit_f.inc"
1496C-----------------------------------------------
1497C C o m m o n B l o c k s
1498C-----------------------------------------------
1499#include "mvsiz_p.inc"
1500C-----------------------------------------------
1501#include "com01_c.inc"
1502#include "param_c.inc"
1503C-----------------------------------------------
1504C D u m m y A r g u m e n t s
1505C-----------------------------------------------
1506 INTEGER IPARG(NPARG,*),ITENS, IGEO(NPROPGI,*),
1507 . IXC(NIXC,*),IXTG(NIXTG,*),ITAGPS(*)
1508C REAL
1509 my_real
1510 . TENS1(3,*),TENS2(3,*), X(3,*)
1511 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
1512C-----------------------------------------------
1513C L o c a l V a r i a b l e s
1514C-----------------------------------------------
1515C REAL
1516 my_real
1517 . off, fac, a1, a2, a3, thk, evar(6,mvsiz),area(mvsiz)
1518 INTEGER I, NG, NEL, NFT, ITY, LFT, NPT, IPT,
1519 . N, J, LLT, MLW,K,
1520 . IPID, I1, I2, IAD2, NS1, NS2 , IALEL, ISTRE,
1521 . nn1,nn2,nn3,nn4,nn5,nn6,nn7,nn8,nn9,nn10,nni,n0,
1522 . ii, ii_l, kk ,inc,ihbe,len ,irep,buf,nnod,
1523 . nc(20,mvsiz),isrot,jj(5)
1524 TYPE(g_bufel_) ,POINTER :: GBUF
1525C-----------------------------------------------
1526 DO 490 NG=1,ngroup
1527 gbuf => elbuf_tab(ng)%GBUF
1528 ii = 0
1529 mlw =iparg(1,ng)
1530 nel =iparg(2,ng)
1531 nft =iparg(3,ng)
1532 ity =iparg(5,ng)
1533 lft=1
1534 llt=nel
1535 ihbe = iparg(23,ng)
1536 nnod = 0
1537!
1538 DO i=1,5
1539 jj(i) = nel*(i-1)
1540 ENDDO
1541!
1542C-----------------------------------------------
1543C COQUES
1544C-----------------------------------------------
1545 IF(ity == 3.OR.ity == 7)THEN
1546 a1 = zero
1547 a2 = zero
1548 a3 = zero
1549C------------------------
1550C STRESS
1551C------------------------
1552C-----upper----
1553 IF(itens == 1)THEN
1554 ns1 = 5
1555 ns2 = 3
1556 IF(mlw == 1)THEN
1557 a1 = one
1558 a2 = six
1559 ELSEIF(mlw == 2.OR.mlw == 19.OR.
1560 . mlw == 15.OR.
1561 . mlw == 22.OR.mlw == 25.OR.
1562 . mlw == 27.OR.mlw == 32.OR.
1563 . mlw>=28)THEN
1564 a1 = one
1565 a2 = zero
1566 ELSEIF(mlw == 3.OR.mlw == 23)THEN
1567 a1 = one
1568 a2 = zero
1569 ENDIF
1570C-----lower----
1571 ELSEIF(itens == 2)THEN
1572 ns1 = 5
1573 ns2 = 3
1574 IF(mlw == 1)THEN
1575 a1 = one
1576 a2 = -six
1577 ELSEIF(mlw == 2.OR.mlw == 19.OR.
1578 . mlw == 15.OR.
1579 . mlw == 22.OR.mlw == 25.OR.
1580 . mlw == 27.OR.mlw == 32.OR.
1581 . mlw>=28)THEN
1582 a1 = one
1583 a2 = zero
1584 ELSEIF(mlw == 3.OR.mlw == 23)THEN
1585 a1 = one
1586 a2 = zero
1587 ENDIF
1588 ENDIF
1589C------------------------
1590 DO i=lft,llt
1591 DO j = 1,2
1592 evar(j,i) = a1 * gbuf%FOR(jj(j)+i) + a2 * gbuf%MOM(jj(j)+i)
1593 ENDDO
1594 evar(3,i) = zero
1595 evar(4,i) = a1 * gbuf%FOR(jj(3)+i) + a2 * gbuf%MOM(jj(3)+i)
1596 evar(5,i) = a1 * gbuf%FOR(jj(4)+i)
1597 evar(6,i) = a1 * gbuf%FOR(jj(5)+i)
1598 ENDDO
1599 CALL shlrotg(lft ,llt ,nft ,x ,evar ,
1600 1 ity ,ixc ,ixtg ,ihbe ,area )
1601 IF(ity == 7)THEN
1602 nnod=3
1603 DO i=lft,llt
1604 n = i + nft
1605 DO j = 1,nnod
1606 nc(j,i) = ixtg(j+1,n)
1607 ENDDO
1608 ENDDO
1609 ELSEIF(ity == 3)THEN
1610 nnod=4
1611 DO i=lft,llt
1612 n = i + nft
1613 DO j = 1,nnod
1614 nc(j,i) = ixc(j+1,n)
1615 ENDDO
1616 ENDDO
1617 ENDIF
1618C-----------------------------------------------
1619 ELSE
1620 ENDIF
1621 DO i=lft,llt
1622 DO j = 1,nnod
1623 n = nc(j,i)
1624 IF (n>0)THEN
1625 DO k = 1,3
1626 tens1(k,n) = tens1(k,n)+evar(k,i)
1627 tens2(k,n) = tens2(k,n)+evar(k+3,i)
1628 ENDDO
1629 itagps(n) = itagps(n)+1
1630 ENDIF
1631 ENDDO
1632 ENDDO
1633 490 CONTINUE
1634C-----------------------------------------------
1635C
1636 RETURN
1637 END
1638!||====================================================================
1639!|| tencgps2 ../engine/source/output/anim/generate/tensorc.F
1640!||--- called by ------------------------------------------------------
1641!|| genani ../engine/source/output/anim/generate/genani.F
1642!||--- calls -----------------------------------------------------
1643!|| shlrotg ../engine/source/output/anim/generate/tensor6.F
1644!||--- uses -----------------------------------------------------
1645!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
1646!||====================================================================
1647 SUBROUTINE tencgps2(ELBUF_TAB ,IPARG,ITENS,TENS1 ,TENS2 ,
1648 . X ,IXC ,IGEO ,IXTG ,GEO ,
1649 . VGPS )
1650C-----------------------------------------------
1651C M o d u l e s
1652C-----------------------------------------------
1653 USE elbufdef_mod
1654C-----------------------------------------------
1655C I m p l i c i t T y p e s
1656C-----------------------------------------------
1657#include "implicit_f.inc"
1658C-----------------------------------------------
1659C C o m m o n B l o c k s
1660C-----------------------------------------------
1661#include "mvsiz_p.inc"
1662C-----------------------------------------------
1663#include "com01_c.inc"
1664#include "param_c.inc"
1665C-----------------------------------------------
1666C D u m m y A r g u m e n t s
1667C-----------------------------------------------
1668 INTEGER IPARG(NPARG,*),ITENS, IGEO(NPROPGI,*),
1669 . IXC(NIXC,*),IXTG(NIXTG,*)
1670C REAL
1671 my_real
1672 . TENS1(3,*),TENS2(3,*), X(3,*),GEO(NPROPG,*),VGPS(*)
1673 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
1674C-----------------------------------------------
1675C L o c a l V a r i a b l e s
1676C-----------------------------------------------
1677C REAL
1678 my_real
1679 . off, fac, a1, a2, a3, thk0, evar(6,mvsiz),area(mvsiz),
1680 . vol(mvsiz)
1681 INTEGER I, NG, NEL, NFT, ITY, LFT, NPT, IPT,
1682 . N, J, LLT, MLW,K,
1683 . IPID, I1, I2, IAD2, NS1, NS2 , IALEL, ISTRE,
1684 . NN1,NN2,NN3,NN4,NN5,NN6,NN7,NN8,NN9,NN10,NNI,N0,
1685 . ii, ii_l, kk ,inc,ihbe,len ,irep,buf,nnod,
1686 . nc(20,mvsiz),isrot,jj(5)
1687 TYPE(g_bufel_) ,POINTER :: GBUF
1688C-----------------------------------------------
1689 DO 490 ng=1,ngroup
1690 gbuf => elbuf_tab(ng)%GBUF
1691 ii = 0
1692 mlw =iparg(1,ng)
1693 nel =iparg(2,ng)
1694 nft =iparg(3,ng)
1695 ity =iparg(5,ng)
1696 lft=1
1697 llt=nel
1698 nnod = 0
1699!
1700 DO i=1,5
1701 jj(i) = nel*(i-1)
1702 ENDDO
1703!
1704C-----------------------------------------------
1705C COQUES
1706C-----------------------------------------------
1707 IF (ity == 3.OR.ity == 7) THEN
1708 a1 = zero
1709 a2 = zero
1710 a3 = zero
1711C------------------------
1712C STRESS
1713C------------------------
1714C-----upper----
1715 IF(itens == 1)THEN
1716 ns1 = 5
1717 ns2 = 3
1718 IF(mlw == 1)THEN
1719 a1 = one
1720 a2 = six
1721 ELSEIF(mlw == 2.OR.mlw == 19.OR.
1722 . mlw == 15.OR.
1723 . mlw == 22.OR.mlw == 25.OR.
1724 . mlw == 27.OR.mlw == 32.OR.
1725 . mlw>=28)THEN
1726 a1 = one
1727 a2 = zero
1728 ELSEIF(mlw == 3.OR.mlw == 23)THEN
1729 a1 = one
1730 a2 = zero
1731 ENDIF
1732C-----lower----
1733 ELSEIF(itens == 2)THEN
1734 ns1 = 5
1735 ns2 = 3
1736 IF(mlw == 1)THEN
1737 a1 = one
1738 a2 = -six
1739 ELSEIF(mlw == 2.OR.mlw == 19.OR.
1740 . mlw == 15.OR.
1741 . mlw == 22.OR.mlw == 25.OR.
1742 . mlw == 27.OR.mlw == 32.OR.
1743 . mlw>=28)THEN
1744 a1 = one
1745 a2 = zero
1746 ELSEIF(mlw == 3.OR.mlw == 23)THEN
1747 a1 = one
1748 a2 = zero
1749 ENDIF
1750 ENDIF
1751C------------------------
1752 DO i=lft,llt
1753 DO j = 1,2
1754 evar(j,i) = a1 * gbuf%FOR(jj(j)+i) + a2 * gbuf%MOM(jj(j)+i)
1755 ENDDO
1756 evar(3,i) = zero
1757 evar(4,i) = a1 * gbuf%FOR(jj(3)+i) + a2 * gbuf%MOM(jj(3)+i)
1758 evar(5,i) = a1 * gbuf%FOR(jj(4)+i)
1759 evar(6,i) = a1 * gbuf%FOR(jj(5)+i)
1760 ENDDO
1761 CALL shlrotg(lft ,llt ,nft ,x ,evar ,
1762 1 ity ,ixc ,ixtg ,ihbe ,area )
1763 IF(ity == 7)THEN
1764 nnod=3
1765 DO i=lft,llt
1766 n = i + nft
1767 DO j = 1,nnod
1768 nc(j,i) = ixtg(j+1,n)
1769 ENDDO
1770 thk0 = geo(1,ixtg(5,n))
1771 off = min(gbuf%OFF(i),one)
1772 vol(i) = thk0*area(i)*off
1773 ENDDO
1774 ELSEIF(ity == 3)THEN
1775 nnod=4
1776 DO i=lft,llt
1777 n = i + nft
1778 DO j = 1,nnod
1779 nc(j,i) = ixc(j+1,n)
1780 ENDDO
1781 thk0 = geo(1,ixc(6,n))
1782 off = min(gbuf%OFF(i),one)
1783 vol(i) = thk0*area(i)*off
1784 ENDDO
1785 ENDIF
1786C-----------------------------------------------
1787 ELSE
1788 ENDIF
1789 DO i=lft,llt
1790 DO j = 1,nnod
1791 n = nc(j,i)
1792 IF (n>0)THEN
1793 DO k = 1,3
1794 tens1(k,n) = tens1(k,n)+evar(k,i)*vol(i)
1795 tens2(k,n) = tens2(k,n)+evar(k+3,i)*vol(i)
1796 ENDDO
1797 vgps(n) = vgps(n)+vol(i)
1798 ENDIF
1799 ENDDO
1800 ENDDO
1801 490 CONTINUE
1802C-----------------------------------------------
1803C
1804 RETURN
1805 END
1806
1807
my_real
#define my_real
Definition cppsort.cpp:32
tencgps2
subroutine tencgps2(elbuf_tab, iparg, itens, tens1, tens2, x, ixc, igeo, ixtg, geo, vgps)
Definition tensorc.F:1650
tencgps1
subroutine tencgps1(elbuf_tab, iparg, itens, tens1, tens2, x, ixc, igeo, ixtg, itagps)
Definition tensorc.F:1488
tensorc
subroutine tensorc(elbuf_tab, iparg, itens, invert, nelcut, el2fa, nbf, tens, epsdot, iadp, nbf_l, nbpart, iadg, x, ixc, igeo, ixtg, ipm, stack, mat_param, geo, drape_sh4n, drape_sh3n, drapeg)
Definition tensorc.F:45
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
layini
subroutine layini(elbuf_str, jft, jlt, geo, igeo, mat, pid, thkly, matly, posly, igtyp, ixfem, ixlay, nlay, npt, isubstack, stack, drape, nft, thk, nel, ratio_thkly, indx_drape, sedrape, numel_drape)
Definition layini.F:47
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
drape_mod
Definition drape_mod.F:54
drape_mod::scdrape
integer scdrape
Definition drape_mod.F:92
drape_mod::stdrape
integer stdrape
Definition drape_mod.F:92
stack_mod
Definition stack_mod.F:72
stack_mod::ply_info
integer, dimension(:,:), allocatable ply_info
Definition stack_mod.F:133
spmd_r4get_partn
subroutine spmd_r4get_partn(size, nbf_l, nbpart, iadg, wal, buf)
Definition spmd_r4get_partn.F:47
shlrotg
subroutine shlrotg(jft, jlt, nft, x, tens, ity, ixc, ixtg, ihbe, area)
Definition tensor6.F:4639
uroto_tens2d
subroutine uroto_tens2d(nel, sig, dir)
Definition uroto_tens2d.F:30
uroto_tens2d_aniso
subroutine uroto_tens2d_aniso(nel, tens, dir_a, dir_b)
Definition uroto_tens2d_aniso.F:30
write_r_c
void write_r_c(float *w, int *len)
Definition write_routtines.c:519