OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
cbacoorpinch.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!|| cbacoorpinch ../engine/source/elements/shell/coqueba/cbacoorpinch.F
25!||--- called by ------------------------------------------------------
26!|| cbaforc3 ../engine/source/elements/shell/coqueba/cbaforc3.F
27!||====================================================================
28 SUBROUTINE cbacoorpinch(
29 1 TNPG ,VPINCHXYZ ,VPINCH ,
30 2 VQ ,VQN ,IXC ,JFT ,JLT ,
31 3 NPLAT ,IPLAT ,THK ,DT1C,
32 4 FACP ,LC ,
33 5 VPINCHT1,VPINCHT2)
34C-----------------------------------------------
35C I M P L I C I T T Y P E S
36C-----------------------------------------------
37#include "implicit_f.inc"
38c-----------------------------------------------
39c g l o b a l p a r a m e t e r s
40c-----------------------------------------------
41#include "mvsiz_p.inc"
42C-----------------------------------------------
43C D U M M Y A R G U M E N T S
44C-----------------------------------------------
45 INTEGER IXC(NIXC,*), JFT, JLT, NPLAT, IPLAT(*)
46 my_real
47 . TNPG(MVSIZ,4,4), VPINCHXYZ(MVSIZ,4), VPINCH(3,*),
48 . VQ(MVSIZ,3,3), VQN(MVSIZ,9,4), THK(*), DT1C(*),
49 . FACP(MVSIZ), LC(MVSIZ),
50 . vpincht1(mvsiz,4),vpincht2(mvsiz,4)
51C-----------------------------------------------
52C L O C A L V A R I A B L E S
53C-----------------------------------------------
54 INTEGER NN(4), I, EP
55 my_real
56 . PG, PGPP, PGPM, PGMM, BETABETA(3,4), ELTHKINV, THKN(4), AVGTHK
57 DATA PG/.577350269189626/
58C=======================================================================
59
60
61C shape function I evaluated at gauss point J = TNPG(I,J)
62 pgpp = fourth*(one+pg)*(one+pg)
63 pgpm = fourth*(one+pg)*(one-pg)
64 pgmm = fourth*(one-pg)*(one-pg)
65C
66 DO i=jft,jlt
67 ep =iplat(i)
68
69 tnpg(ep,1,1) = pgpp
70 tnpg(ep,2,1) = pgpm
71 tnpg(ep,3,1) = pgmm
72 tnpg(ep,4,1) = pgpm
73
74 tnpg(ep,1,2) = pgpm
75 tnpg(ep,2,2) = pgpp
76 tnpg(ep,3,2) = pgpm
77 tnpg(ep,4,2) = pgmm
78
79 tnpg(ep,1,3) = pgmm
80 tnpg(ep,2,3) = pgpm
81 tnpg(ep,3,3) = pgpp
82 tnpg(ep,4,3) = pgpm
83
84 tnpg(ep,1,4) = pgpm
85 tnpg(ep,2,4) = pgmm
86 tnpg(ep,3,4) = pgpm
87 tnpg(ep,4,4) = pgpp
88 ENDDO
89
90C Transform VPINCH into VPINCHXYZ
91
92 DO i=jft,jlt
93 ep =iplat(i)
94 nn(1)=ixc(2,ep)
95 nn(2)=ixc(3,ep)
96 nn(3)=ixc(4,ep)
97 nn(4)=ixc(5,ep)
98
99 betabeta(1,1) =vq(ep,1,1)*vpinch(1,nn(1))+vq(ep,2,1)*vpinch(2,nn(1))
100 1 +vq(ep,3,1)*vpinch(3,nn(1))
101 betabeta(1,2) =vq(ep,1,1)*vpinch(1,nn(2))+vq(ep,2,1)*vpinch(2,nn(2))
102 1 +vq(ep,3,1)*vpinch(3,nn(2))
103 betabeta(1,3) =vq(ep,1,1)*vpinch(1,nn(3))+vq(ep,2,1)*vpinch(2,nn(3))
104 1 +vq(ep,3,1)*vpinch(3,nn(3))
105 betabeta(1,4) =vq(ep,1,1)*vpinch(1,nn(4))+vq(ep,2,1)*vpinch(2,nn(4))
106 1 +vq(ep,3,1)*vpinch(3,nn(4))
107 betabeta(2,1) =vq(ep,1,2)*vpinch(1,nn(1))+vq(ep,2,2)*vpinch(2,nn(1))
108 1 +vq(ep,3,2)*vpinch(3,nn(1))
109 betabeta(2,2) =vq(ep,1,2)*vpinch(1,nn(2))+vq(ep,2,2)*vpinch(2,nn(2))
110 1 +vq(ep,3,2)*vpinch(3,nn(2))
111 betabeta(2,3) =vq(ep,1,2)*vpinch(1,nn(3))+vq(ep,2,2)*vpinch(2,nn(3))
112 1 +vq(ep,3,2)*vpinch(3,nn(3))
113 betabeta(2,4) =vq(ep,1,2)*vpinch(1,nn(4))+vq(ep,2,2)*vpinch(2,nn(4))
114 1 +vq(ep,3,2)*vpinch(3,nn(4))
115 betabeta(3,1) =vq(ep,1,3)*vpinch(1,nn(1))+vq(ep,2,3)*vpinch(2,nn(1))
116 1 +vq(ep,3,3)*vpinch(3,nn(1))
117 betabeta(3,2) =vq(ep,1,3)*vpinch(1,nn(2))+vq(ep,2,3)*vpinch(2,nn(2))
118 1 +vq(ep,3,3)*vpinch(3,nn(2))
119 betabeta(3,3) =vq(ep,1,3)*vpinch(1,nn(3))+vq(ep,2,3)*vpinch(2,nn(3))
120 1 +vq(ep,3,3)*vpinch(3,nn(3))
121 betabeta(3,4) =vq(ep,1,3)*vpinch(1,nn(4))+vq(ep,2,3)*vpinch(2,nn(4))
122 1 +vq(ep,3,3)*vpinch(3,nn(4))
123
124C projecting BETABETA on t1
125
126 vpincht1(ep,1)=vqn(ep,1,1)*betabeta(1,1)+
127 + vqn(ep,2,1)*betabeta(2,1)+vqn(ep,3,1)*betabeta(3,1)
128
129 vpincht1(ep,2)=vqn(ep,1,2)*betabeta(1,2)+
130 + vqn(ep,2,2)*betabeta(2,2)+vqn(ep,3,2)*betabeta(3,2)
131
132 vpincht1(ep,3)=vqn(ep,1,3)*betabeta(1,3)+
133 + vqn(ep,2,3)*betabeta(2,3)+vqn(ep,3,3)*betabeta(3,3)
134
135 vpincht1(ep,4)=vqn(ep,1,4)*betabeta(1,4)+
136 + vqn(ep,2,4)*betabeta(2,4)+vqn(ep,3,4)*betabeta(3,4)
137
138C projecting BETABETA on t2
139
140 vpincht2(ep,1)=vqn(ep,4,1)*betabeta(1,1)+
141 + vqn(ep,5,1)*betabeta(2,1)+vqn(ep,6,1)*betabeta(3,1)
142
143 vpincht2(ep,2)=vqn(ep,4,2)*betabeta(1,2)+
144 + vqn(ep,5,2)*betabeta(2,2)+vqn(ep,6,2)*betabeta(3,2)
145
146 vpincht2(ep,3)=vqn(ep,4,3)*betabeta(1,3)+
147 + vqn(ep,5,3)*betabeta(2,3)+vqn(ep,6,3)*betabeta(3,3)
148
149 vpincht2(ep,4)=vqn(ep,4,4)*betabeta(1,4)+
150 + vqn(ep,5,4)*betabeta(2,4)+vqn(ep,6,4)*betabeta(3,4)
151
152C projection of BETABETA onto nodal normal giving VPINCHXYZ
153
154 vpinchxyz(ep,1)=vqn(ep,7,1)*betabeta(1,1)+
155 + vqn(ep,8,1)*betabeta(2,1)+vqn(ep,9,1)*betabeta(3,1)
156
157 vpinchxyz(ep,2)=vqn(ep,7,2)*betabeta(1,2)+
158 + vqn(ep,8,2)*betabeta(2,2)+vqn(ep,9,2)*betabeta(3,2)
159
160 vpinchxyz(ep,3)=vqn(ep,7,3)*betabeta(1,3)+
161 + vqn(ep,8,3)*betabeta(2,3)+vqn(ep,9,3)*betabeta(3,3)
162
163 vpinchxyz(ep,4)=vqn(ep,7,4)*betabeta(1,4)+
164 + vqn(ep,8,4)*betabeta(2,4)+vqn(ep,9,4)*betabeta(3,4)
165
166C calculate average thickness
167 thkn(1) = thk(ep)*(one+two*vpinchxyz(ep,1)*dt1c(ep))
168 thkn(2) = thk(ep)*(one+two*vpinchxyz(ep,2)*dt1c(ep))
169 thkn(3) = thk(ep)*(one+two*vpinchxyz(ep,3)*dt1c(ep))
170 thkn(4) = thk(ep)*(one+two*vpinchxyz(ep,4)*dt1c(ep))
171C
172 avgthk = fourth*(thkn(1) + thkn(2) + thkn(3) + thkn(4))
173 elthkinv = two/avgthk
174
175C dividing by thickness (definition of beta for pinching)
176 vpinchxyz(ep,1) = vpinchxyz(ep,1)*elthkinv
177 vpinchxyz(ep,2) = vpinchxyz(ep,2)*elthkinv
178 vpinchxyz(ep,3) = vpinchxyz(ep,3)*elthkinv
179 vpinchxyz(ep,4) = vpinchxyz(ep,4)*elthkinv
180
181C dividing by thickness (definition of beta for pinching) in t1
182 vpincht1(ep,1) = vpincht1(ep,1)*elthkinv
183 vpincht1(ep,2) = vpincht1(ep,2)*elthkinv
184 vpincht1(ep,3) = vpincht1(ep,3)*elthkinv
185 vpincht1(ep,4) = vpincht1(ep,4)*elthkinv
186
187C dividing by thickness (definition of beta for pinching) in t2
188 vpincht2(ep,1) = vpincht2(ep,1)*elthkinv
189 vpincht2(ep,2) = vpincht2(ep,2)*elthkinv
190 vpincht2(ep,3) = vpincht2(ep,3)*elthkinv
191 vpincht2(ep,4) = vpincht2(ep,4)*elthkinv
192
193C calculate scaling factor for stiffness
194C to be used later for dynamic condensation STIFPINCH
195 facp(ep) = (lc(ep)/avgthk)**2
196
197 ENDDO
198 RETURN
199 END
cbacoorpinch
subroutine cbacoorpinch(tnpg, vpinchxyz, vpinch, vq, vqn, ixc, jft, jlt, nplat, iplat, thk, dt1c, facp, lc, vpincht1, vpincht2)
Definition cbacoorpinch.F:34