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 28 of file cbacoorpinch.F.

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