OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
tensorc_ply.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/.
23C available just with ply/xfem formulation
24!||====================================================================
25!|| tensorc_ply ../engine/source/output/anim/generate/tensorc_ply.F
26!||--- called by ------------------------------------------------------
27!|| genani ../engine/source/output/anim/generate/genani.F
28!||--- calls -----------------------------------------------------
29!|| sigrota ../engine/source/output/anim/generate/sigrota.F
30!|| spmd_r4get_partn ../engine/source/mpi/anim/spmd_r4get_partn.F
31!|| write_r_c ../common_source/tools/input_output/write_routines.c
32!||--- uses -----------------------------------------------------
33!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
34!|| element_mod ../common_source/modules/elements/element_mod.F90
35!|| matparam_def_mod ../common_source/modules/mat_elem/matparam_def_mod.F90
36!|| my_alloc_mod ../common_source/tools/memory/my_alloc.F90
37!|| plyxfem_mod ../engine/share/modules/plyxfem_mod.F
38!|| stack_mod ../engine/share/modules/stack_mod.F
39!||====================================================================
40 SUBROUTINE tensorc_ply(IPLY, NEL_PLY, ELBUF_TAB, IPARG,
41 1 ITENS, INVERT, EL2FA, NBF,
42 2 TENS, EPSDOT, IADP, NBF_L,
43 3 NBPART,IADG, X, IXC,MAT_PARAM,
44 4 IGEO, IXTG, NBF_PXFEMG, IPM ,STACK)
45C-----------------------------------------------
46C M o d u l e s
47C-----------------------------------------------
48 USE elbufdef_mod
49 USE matparam_def_mod
50 USE plyxfem_mod
51 USE stack_mod
52 USE my_alloc_mod
53 use element_mod , only : nixc,nixtg
54C-----------------------------------------------
55C I m p l i c i t T y p e s
56C-----------------------------------------------
57#include "implicit_f.inc"
58C-----------------------------------------------
59C C o m m o n B l o c k s
60C-----------------------------------------------
61#include "mvsiz_p.inc"
62C-----------------------------------------------
63#include "com01_c.inc"
64#include "com04_c.inc"
65#include "param_c.inc"
66#include "task_c.inc"
67C-----------------------------------------------
68C D u m m y A r g u m e n t s
69C-----------------------------------------------
70 INTEGER IPARG(NPARG,*),ITENS, INVERT(*),
71 . EL2FA(*),IXC(NIXC,*), IGEO(NPROPGI,*),
72 . NBF,IADP(*),NBF_L,NBPART,IADG(NSPMD,*),
73 . IXTG(NIXTG,*),NEL_PLY,IPLY, NBF_PXFEMG,
74 . ipm(npropmi,*)
75C REAL
76 my_real
77 . tens(3,*),epsdot(6,*), x(3,*)
78 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
79 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(IN) :: MAT_PARAM
80 TYPE (STACK_PLY) :: STACK
81C-----------------------------------------------
82C L o c a l V a r i a b l e s
83C-----------------------------------------------
84C REAL
85 my_real
86 . fac, a1, a2, a3, thk, sige(mvsiz,5)
87 REAL R4(18)
88 INTEGER I, NG, NEL, NFT, IAD, ITY, LFT, NPT, IR,IS,IPT,
89 . n, j, llt, mlw, istrain,nptr,npts,nptt,nlay,
90 . ipid, ns1, ns2 , istre,
91 . nn1,nn2,nn3,nn4,nn5,nn6,nni,n0,
92 . ii ,inc,ihbe ,irep,buf,ilayer,
93 . jj(8)
94 INTEGER IE, ISHPLYXFEM, IFLAG, ION, NPG,
95 . ELC,PLYELEMS(NUMELC),PLYS,IFAILURE,IVISC,NUVARV,
96 . MAT(MVSIZ),PID(MVSIZ),IGTYP,IADR,MATLY,IPMAT,
97 . ISUBSTACK,IPMAT_IPLY
98 REAL,DIMENSION(:,:),ALLOCATABLE:: WA
99
100 TYPE(G_BUFEL_) ,POINTER :: GBUF
101 TYPE(L_BUFEL_) ,POINTER :: LBUF
102C-----------------------------------------------
103 CALL my_alloc(wa,3,nbf_l)
104!
105 nel_ply = 0
106
107 DO plys = 1,nplypart
108 iply = indx_ply(plys)
109
110 plyelems=0
111 DO i=1,plyshell(iply)%PLYNUMSHELL
112 ipt = plyshell(iply)%SHELLIPT(i)
113 elc = plyshell(iply)%SHID(i)
114 plyelems(elc)=ipt
115 ENDDO
116
117 DO j=1,18
118 r4(j) = zero
119 ENDDO
120C
121 ie = 0
122 ilayer = 0
123 iflag = 0
124 ion = 0
125 npg = 0
126C
127 nn1 = 1
128 nn2 = nn1
129 nn3 = nn2
130 nn4 = nn3 + numelq
131 nn5 = nn4 + numelc
132 nn6 = nn5 + numeltg
133C
134
135 DO 490 ng=1,ngroup
136 ii = 0
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 iad =iparg(4,ng)
142 ity =iparg(5,ng)
143 ihbe = iparg(23,ng)
144 igtyp =iparg(38,ng)
145 ifailure = iparg(43,ng)
146 istrain = iparg(44,ng)
147 ishplyxfem = iparg(50,ng)
148 isubstack = iparg(71,ng)
149 lft=1
150 llt=nel
151!
152 DO i=1,8 ! length max of GBUF%G_STRA = 8
153 jj(i) = nel*(i-1)
154 ENDDO
155!
156 DO i=lft,llt
157 DO j=1,5
158 sige(i,j) = zero
159 ENDDO
160 ENDDO
161!
162C-----------------------------------------------
163C COQUES
164C-----------------------------------------------
165 IF(ity==3.OR.ity==7.AND.ishplyxfem > 0)THEN
166 gbuf => elbuf_tab(ng)%GBUF
167 nptr = elbuf_tab(ng)%NPTR
168 npts = elbuf_tab(ng)%NPTS
169 nptt = elbuf_tab(ng)%NPTT
170 nlay = elbuf_tab(ng)%NLAY
171 npg = nptr*npts
172 npt = nlay*nptt
173C
174 IF(ity==3)THEN
175 n0 = 0
176 nni = nn4
177 ELSE
178 n0 = numelc
179 nni = nn5
180 ENDIF
181C
182C
183 fac = zero
184 a1 = zero
185 a2 = zero
186 a3 = zero
187 istre = 1
188C
189C test on a single element of the group
190C
191 n = 1 + nft
192C
193 DO i=lft,llt
194 n = i + nft
195 ilayer = plyelems(n)
196 IF(ilayer > 0) iflag = ilayer
197 ENDDO
198 IF(iflag == 0) GO TO 490
199 ilayer = iflag
200 iflag = 1
201C------------------------
202C STRESS
203C------------------------
204 IF(itens==1)THEN
205 ns1 = 5
206 ns2 = 3
207 a1 = one
208 a2 = zero
209 ELSEIF(itens==2)THEN
210 ns1 = 5
211 ns2 = 3
212 a1 = zero
213 a2 = one
214 ELSEIF(itens==3)THEN
215 ns1 = 5
216 ns2 = 3
217 IF(mlw==1)THEN
218 a1 = one
219 a2 = six
220 ELSEIF(mlw==2.OR.mlw==19.OR.
221 . mlw==15.OR.
222 . mlw==22.OR.mlw==25.OR.
223 . mlw==27.OR.mlw==32.OR.
224 . mlw>=28)THEN
225 a1 = zero
226 a2 = zero
227 ELSEIF(mlw==3.OR.mlw==23)THEN
228 a1 = zero
229 a2 = zero
230 ENDIF
231 ELSEIF(itens==4)THEN
232 ns1 = 5
233 ns2 = 3
234 IF(mlw==1)THEN
235 a1 = zero
236 a2 = zero
237 ELSEIF(mlw==2.OR.mlw==19.OR.
238 . mlw==15.OR.
239 . mlw==22.OR.mlw==25.OR.
240 . mlw==27.OR.mlw==32.OR.
241 . mlw>=28)THEN
242 a1 = one
243 a2 = zero
244 ELSEIF(mlw==3.OR.mlw==23)THEN
245 a1 = one
246 a2 = zero
247 ENDIF
248 ELSEIF(itens>=101.AND.itens<=200)THEN
249 ns1 = 5
250 ns2 = 3
251 IF(mlw==1.OR.mlw==3.OR.mlw==23)THEN
252 a1 = one
253 a2 = zero
254 ELSEIF(mlw==2.OR.mlw==19.OR.
255 . mlw==15.OR.
256 . mlw==22.OR.mlw==25.OR.
257 . mlw==27.OR.mlw==32.OR.
258 . mlw>=28)THEN
259 ipt = min(npt,itens-100)
260 a1 = one
261 a2 = zero
262 IF(ipt == iply ) ion = 1
263 ENDIF
264C------------------------
265C STRAIN
266C------------------------
267 ELSEIF(itens==5)THEN
268 istre = 0
269 ns1 = 8
270 ns2 = 8
271 IF(istrain==1)THEN
272 a1 = zero
273 a2 = zero
274 ELSE
275 a1 = zero
276 a2 = zero
277 ENDIF
278 ELSEIF(itens==6)THEN
279 istre = 0
280 ns1 = 8
281 ns2 = 8
282 IF(istrain==1)THEN
283 a1 = zero
284 a2 = zero
285 ELSE
286 a1 = zero
287 a2 = zero
288 ENDIF
289 ELSEIF(itens==7)THEN
290 istre = 0
291 ns1 = 8
292 ns2 = 8
293 IF(istrain==1)THEN
294 a1 = zero
295 a2 = zero
296 ELSE
297 a1 = zero
298 a2 = zero
299 ENDIF
300 ELSEIF(itens==8)THEN
301 istre = 0
302 ns1 = 8
303 ns2 = 8
304 IF(istrain==1)THEN
305 a1 = zero
306 a2 = zero
307 ELSE
308 a1 = zero
309 a2 = zero
310 ENDIF
311 ELSEIF(itens>=201.AND.itens<=300)THEN
312 istre = 0
313 ns1 = 8
314 ns2 = 8
315 ipt = min(npt,itens - 200)
316 IF(ipt == iply ) ion = 1
317 IF(istrain==1.AND.npt/=0)THEN
318cc IPT = ILAYER
319 a1 = one
320 a2 = half*(((2*ilayer-one)/npt)-one)
321 ELSE
322 a1 = zero
323 a2 = zero
324 ENDIF
325C------------------------
326C STRAIN RATE
327C------------------------
328 ELSEIF(itens==91)THEN
329 istre = 2
330 a1 = zero
331 a2 = zero
332 ELSEIF(itens==92)THEN
333 istre = 2
334 a1 = zero
335 a2 = zero
336 ELSEIF(itens==93)THEN
337 istre = 2
338 a1 = zero
339 a2 = zero
340 ELSEIF(itens==94)THEN
341 istre = 2
342 a1 = zero
343 a2 = zero
344 ELSEIF(itens>=301.AND.itens<=400)THEN
345 ipt = min(npt,itens - 300)
346 IF(ipt == iply ) ion = 1
347 IF(npt/=0)THEN
348 istre = 2
349cc IPT = ILAYER
350 a1 = one
351 a2 = half*(((2*ilayer-one)/npt)-one)
352 ELSE
353 istre = 2
354 a1 = zero
355 a2 = zero
356 ENDIF
357 ENDIF
358C
359 IF(istre==1)THEN
360C------------------------
361C STRESS
362C------------------------
363 IF(ity==3)THEN
364 ipid = ixc(6,nft+1)
365 ELSE
366 ipid = ixtg(5,nft+1)
367 ENDIF
368 irep = igeo(6,ipid)
369c------------
370 IF (itens>=101.AND.itens<=200
371 . .AND.(mlw==25.OR.mlw==15).AND.irep==1) THEN
372 ivisc = 0
373 nuvarv = 0
374 IF(ity==3)THEN
375 DO i=1,nel
376 mat(i)=ixc(1,nft+i)
377 pid(i)=ixc(6,nft+i)
378 END DO
379 ELSE
380 DO i=1,nel
381 mat(i)=ixtg(1,nft+i)
382 pid(i)=ixtg(5,nft+i)
383 END DO
384 END IF
385 IF(mlw == 25) THEN
386 IF(igtyp == 17)THEN
387!! IIGEO = 40 + 5*(ISUBSTACK - 1)
388!! IADI = IGEO(IIGEO + 3,PID(1))
389 ipmat = 2 + npt
390 ipmat_iply = ipmat + npt
391! old stack organisation IPMAT = 300
392 nuvarv = 0
393 DO n=1,npt
394 iadr = (n-1)*nel
395 DO i=1,nel
396 matly = stack%IGEO(ipmat+n,isubstack)
397 IF (mat_param(matly)%IVISC > 0) THEN
398 ivisc = 1
399 nuvarv = max(nuvarv, mat_param(matly)%VISC%NUVAR)
400 END IF
401 END DO
402 END DO
403 END IF
404 ENDIF
405 IF(ion == 1)THEN
406 CALL sigrota(lft ,llt ,nft ,ilayer ,nel ,
407 2 ns1 ,x ,ixc ,elbuf_tab(ng),
408 3 sige ,ity ,ixtg ,ihbe ,istrain ,
409 4 ivisc )
410 DO i=lft,llt
411 n = i + nft
412 ilayer = plyelems(n)
413 IF(ilayer > 0) THEN
414 ie = ie + 1
415 DO j = 1 , 3
416 r4(j) = sige(i,j)
417 ENDDO
418cc R4(3) = R4(3) * INVERT(EL2FA(NEL_PLY + IE))
419 tens(1,el2fa(nel_ply + ie)) = r4(1)
420 tens(2,el2fa(nel_ply + ie)) = r4(2)
421 tens(3,el2fa(nel_ply + ie)) = r4(3)
422 ENDIF
423 ENDDO
424 ELSE ! ION = 0
425 DO i=lft,llt
426 n = i + nft
427 ilayer = plyelems(n)
428 IF(ilayer > 0) THEN
429 ie = ie + 1
430 tens(1,el2fa(nel_ply + ie)) = zero
431 tens(2,el2fa(nel_ply + ie)) = zero
432 tens(3,el2fa(nel_ply + ie)) = zero
433 ENDIF
434 ENDDO
435 ENDIF ! ION
436c------------
437 ELSEIF (itens>=101.AND.itens<=200
438 . .AND.mlw==25.AND.irep==0) THEN
439C
440 IF(ion == 1) THEN
441 DO i=lft,llt
442 DO j = 1 , 5
443 sige(i,j) = zero
444 ENDDO
445 ENDDO
446 DO i=lft,llt
447 n = i + nft
448 ilayer = plyelems(n)
449 IF (ilayer > 0) THEN
450 DO ir=1,nptr
451 DO is=1,npts
452 lbuf => elbuf_tab(ng)%BUFLY(ilayer)%LBUF(ir,is,1)
453 DO j = 1 , 5
454 sige(i,j) = sige(i,j) + lbuf%SIG(jj(j)+i)/npg
455 ENDDO
456 ENDDO
457 ENDDO
458 ENDIF
459 ENDDO
460c
461 DO i=lft,llt
462 n = i + nft
463 ilayer = plyelems(n)
464 IF(ilayer > 0) THEN
465 ie = ie + 1
466 DO j = 1 , 3
467 r4(j) = sige(i,j)
468 ENDDO
469cc R4(3) = R4(3) * INVERT(EL2FA(NNI+N))
470 tens(1,el2fa(nel_ply + ie)) = r4(1)
471 tens(2,el2fa(nel_ply + ie)) = r4(2)
472 tens(3,el2fa(nel_ply + ie)) = r4(3)
473 ENDIF
474 ENDDO
475 ELSE
476 DO i=lft,llt
477 n = i + nft
478 ilayer = plyelems(n)
479 IF(ilayer > 0) THEN
480 ie = ie + 1
481cc R4(3) = R4(3) * INVERT(EL2FA(NEL_PLY + IE))
482 tens(1,el2fa(nel_ply + ie)) = zero
483 tens(2,el2fa(nel_ply + ie)) = zero
484 tens(3,el2fa(nel_ply + ie)) = zero
485 ENDIF
486 ENDDO
487 ENDIF
488 ELSE
489 DO i=lft,llt
490 n = i + nft
491 ilayer = plyelems(n)
492 IF(ilayer > 0) THEN
493 ie = ie + 1
494 DO j = 1,3
495 r4(j) = a1 * gbuf%FOR(jj(j)+i) + a2 * gbuf%MOM(jj(j)+i)
496 ENDDO
497cc R4(3) = R4(3) * INVERT(EL2FA(NEL_PLY + IE))
498 tens(1,el2fa(nel_ply + ie)) = r4(1)
499 tens(2,el2fa(nel_ply + ie)) = r4(2)
500 tens(3,el2fa(nel_ply + ie)) = r4(3)
501 ENDIF
502 ENDDO
503 ENDIF
504 ELSEIF (istre == 0 .AND. gbuf%G_STRA > 0) THEN
505C------------------------
506C STRAIN
507C------------------------
508 DO i=lft,llt
509 n = i + nft
510 ilayer = plyelems(n)
511 IF(ilayer > 0) THEN
512 thk = gbuf%THK(i)
513 IF(itens/=6)THEN
514 DO j = 1 , 3
515 r4(j) = a1*gbuf%STRA(jj(j)+i)+a2*gbuf%STRA(jj(j)+i)*thk
516 ENDDO
517 ELSE
518 DO j = 1 , 3
519 r4(j) = gbuf%STRA(jj(j)+i)
520 ENDDO
521 ENDIF
522 ie = ie + 1
523cc R4(3) = R4(3) * INVERT(EL2FA(NEL_PLY + IE)) * HALF
524 tens(1,el2fa(nel_ply + ie)) = r4(1)
525 tens(2,el2fa(nel_ply + ie)) = r4(2)
526 tens(3,el2fa(nel_ply + ie)) = r4(3)
527 ENDIF
528 ENDDO
529 ELSEIF(istre==2)THEN
530C------------------------
531C STRAIN RATE
532C------------------------
533 DO i=lft,llt
534 n = i + nft
535 ilayer = plyelems(n)
536 IF(ilayer > 0) THEN
537 thk = gbuf%THK(i)
538 IF(itens/=92)THEN
539 DO j = 1 , 3
540 r4(j) = a1*epsdot(j,n+n0) + a2*epsdot(j+3,n+n0)*thk
541 ENDDO
542 ELSE
543 DO j = 1 , 3
544 r4(j) = epsdot(j+3,n+n0)
545 ENDDO
546 ENDIF
547cc R4(3) = R4(3) * INVERT(EL2FA(NEL_PLY + IE)) * HALF
548 ie = ie + 1
549 tens(1,el2fa(nel_ply + ie)) = r4(1)
550 tens(2,el2fa(nel_ply + ie)) = r4(2)
551 tens(3,el2fa(nel_ply + ie)) = r4(3)
552 ENDIF
553 ENDDO
554 ENDIF
555C-----------------------------------------------
556 ELSE
557 ENDIF
558 490 CONTINUE
559C----------------------------------------------
560 IF(iflag > 0 ) THEN
561 IF (nspmd == 1)THEN
562 DO i=1,ie
563 n = el2fa(nel_ply + i)
564 r4(1) = tens(1,n)
565 r4(2) = tens(2,n)
566 r4(3) = tens(3,n)
567 CALL write_r_c(r4,3)
568 ENDDO
569 ELSE
570 DO i=1,ie
571 n = el2fa(nel_ply + i)
572 wa(1,i+nel_ply) = tens(1,n)
573 wa(2,i+nel_ply) = tens(2,n)
574 wa(3,i+nel_ply) = tens(3,n)
575 ENDDO
576 ENDIF
577 ENDIF
578C
579 nel_ply = nel_ply + plyshell(iply)%PLYNUMSHELL
580 ENDDO
581
582 IF (nspmd > 1)THEN
583 IF(ispmd==0) THEN
584 buf = nbf_pxfemg*3
585 ELSE
586 buf = 1
587 ENDIF
588 CALL spmd_r4get_partn(3,3*nbf_l,nplypart,iadg,wa,buf)
589 ENDIF
590
591 DEALLOCATE(wa)
592 RETURN
593 END
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
plyxfem_mod
Definition plyxfem_mod.F:31
plyxfem_mod::indx_ply
integer, dimension(:), allocatable indx_ply
Definition plyxfem_mod.F:60
plyxfem_mod::nplypart
integer nplypart
Definition plyxfem_mod.F:59
plyxfem_mod::plyshell
type(plyshells), dimension(:), allocatable plyshell
Definition plyxfem_mod.F:56
stack_mod
Definition stack_mod.F:75
sigrota
subroutine sigrota(jft, jlt, nft, ipt, nel, ns1, x, ixc, elbuf_str, sig, ity, ixtg, ihbe, istrain, ivisc)
Definition sigrota.F:38
spmd_r4get_partn
subroutine spmd_r4get_partn(size, nbf_l, nbpart, iadg, wal, buf)
Definition spmd_r4get_partn.F:47
tensorc_ply
subroutine tensorc_ply(iply, nel_ply, elbuf_tab, iparg, itens, invert, el2fa, nbf, tens, epsdot, iadp, nbf_l, nbpart, iadg, x, ixc, mat_param, igeo, ixtg, nbf_pxfemg, ipm, stack)
Definition tensorc_ply.F:45
write_r_c
void write_r_c(float *w, int *len)
Definition write_routines.c:519