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