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