OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
tensor0.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!|| tensor0 ../starter/source/output/anim/tensor0.F
25!||--- called by ------------------------------------------------------
26!|| genani1 ../starter/source/output/anim/genani1.F
27!||--- calls -----------------------------------------------------
28!||--- uses -----------------------------------------------------
29!||====================================================================
30 SUBROUTINE tensor0(ELBUF_TAB ,IPARG ,ITENS ,PM ,EL2FA ,
31 2 NBF ,TENS ,IPART ,IPARTSP )
32C-----------------------------------------------
33C M o d u l e s
34C-----------------------------------------------
35 USE elbufdef_mod
36C-----------------------------------------------
37C I m p l i c i t T y p e s
38C-----------------------------------------------
39#include "implicit_f.inc"
40C-----------------------------------------------
41C C o m m o n B l o c k s
42C-----------------------------------------------
43#include "vect01_c.inc"
44#include "com01_c.inc"
45#include "param_c.inc"
46#include "scr17_c.inc"
47C-----------------------------------------------
48C D u m m y A r g u m e n t s
49C-----------------------------------------------
50C REAL
51 my_real
52 . tens(6,*),pm(npropm,*)
53 INTEGER IPARG(NPARG,*),ITENS, EL2FA(*),
54 . nbf,ipart(lipart1,*),ipartsp(*)
55 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
56C-----------------------------------------------
57 REAL R4(18),WA(6*NBF)
58 INTEGER I,II(6),J,N, NG, NEL, IPT, MT1, MLW,NN1,IPRT,JJ
59 TYPE(g_bufel_) ,POINTER :: GBUF
60 TYPE(l_bufel_) ,POINTER :: LBUF
61C=======================================================================
62 DO j=1,18
63 r4(j) = zero
64 ENDDO
65C
66 nn1 = 1
67c NN2 = NN1 + (NUMSPH+MAXPJET)
68C
69 DO 490 ng=1,ngroup
70 mlw = iparg(1,ng)
71 nel = iparg(2,ng)
72 nft = iparg(3,ng)
73 ity = iparg(5,ng)
74 lft=1
75 llt=nel
76!
77 DO i=1,6
78 ii(i) = (i-1)*nel
79 ENDDO
80!
81C-----------------------------------------------
82 IF (ity == 51) THEN
83C PARTICULES SPH.
84C-----------------------------------------------
85 gbuf => elbuf_tab(ng)%GBUF
86 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
87 iprt=ipartsp(1 + nft)
88 mt1 =ipart(1,iprt)
89C-----------------------------------------------
90 IF(itens == 1)THEN
91C STRESS
92C-----------------------------------------------
93 DO i=lft,llt
94 n = i + nft
95 IF(el2fa(nn1+n)/=0)THEN
96 tens(1,el2fa(nn1+n)) = gbuf%SIG(ii(1) + i)
97 tens(2,el2fa(nn1+n)) = gbuf%SIG(ii(2) + i)
98 tens(3,el2fa(nn1+n)) = gbuf%SIG(ii(3) + i)
99 tens(4,el2fa(nn1+n)) = gbuf%SIG(ii(4) + i)
100 tens(5,el2fa(nn1+n)) = gbuf%SIG(ii(5) + i)
101 tens(6,el2fa(nn1+n)) = gbuf%SIG(ii(6) + i)
102 ENDIF
103 ENDDO
104C-----------------------------------------------
105 ELSEIF (itens == 4 .AND. mlw == 24 .AND.
106 . nint(pm(56,mt1)) == 1) THEN
107C CRACKS
108C-----------------------------------------------
109 DO i=lft,llt
110 n = i + nft
111 IF(el2fa(nn1+n)/=0)THEN
112 tens(1,el2fa(nn1+n)) = lbuf%DGLO(ii(1) + i)
113 tens(2,el2fa(nn1+n)) = lbuf%DGLO(ii(2) + i)
114 tens(3,el2fa(nn1+n)) = lbuf%DGLO(ii(3) + i)
115 tens(4,el2fa(nn1+n)) = lbuf%DGLO(ii(4) + i)
116 tens(5,el2fa(nn1+n)) = lbuf%DGLO(ii(5) + i)
117 tens(6,el2fa(nn1+n)) = lbuf%DGLO(ii(6) + i)
118 ENDIF
119 ENDDO
120 ELSE
121C-----------------------------------------------
122 DO i=lft,llt
123 n = i + nft
124 IF(el2fa(nn1+n)/=0)THEN
125 tens(1,el2fa(nn1+n)) = zero
126 tens(2,el2fa(nn1+n)) = zero
127 tens(3,el2fa(nn1+n)) = zero
128 tens(4,el2fa(nn1+n)) = zero
129 tens(5,el2fa(nn1+n)) = zero
130 tens(6,el2fa(nn1+n)) = zero
131 ENDIF
132 ENDDO
133 ENDIF
134C-----------------------------------------------
135 ELSE
136 ENDIF
137 490 CONTINUE
138 500 CONTINUE
139C-----------------------------------------------
140 DO n=1,nbf
141 r4(1) = tens(1,n)
142 r4(2) = tens(2,n)
143 r4(3) = tens(3,n)
144 r4(4) = tens(4,n)
145 r4(5) = tens(5,n)
146 r4(6) = tens(6,n)
147 CALL write_r_c(r4,6)
148 ENDDO
149C-----------------------------------------------
150 RETURN
151 END
my_real
#define my_real
Definition cppsort.cpp:32
tensor0
subroutine tensor0(elbuf_tab, iparg, itens, pm, el2fa, nbf, tens, ipart, ipartsp)
Definition tensor0.F:32
write_r_c
void write_r_c(float *w, int *len)
Definition write_routtines.c:519