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