OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
cbacoorpinch.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine cbacoorpinch (tnpg, vpinchxyz, vpinch, vq, vqn, ixc, jft, jlt, nplat, iplat, thk, dt1c, facp, lc, vpincht1, vpincht2)

Function/Subroutine Documentation

◆ cbacoorpinch()

subroutine cbacoorpinch ( tnpg,
vpinchxyz,
vpinch,
vq,
vqn,
integer, dimension(nixc,*) ixc,
integer jft,
integer jlt,
integer nplat,
integer, dimension(*) iplat,
thk,
dt1c,
facp,
lc,
vpincht1,
vpincht2 )

Definition at line 30 of file cbacoorpinch.F.

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
my_real
#define my_real
Definition cppsort.cpp:32