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

Go to the source code of this file.

Functions/Subroutines

subroutine sbulk3 (volu, nc, nnc, mat, pm, volnod, bvolnod, vns, bns, vnsx, bnsx, fill)

Function/Subroutine Documentation

◆ sbulk3()

subroutine sbulk3 ( volu,
integer, dimension(mvsiz,nnc) nc,
integer nnc,
integer, dimension(*) mat,
pm,
volnod,
bvolnod,
vns,
bns,
vnsx,
bnsx,
fill )

Definition at line 39 of file sbulk3.F.

43C
44C-----------------------------------------------
45C I m p l i c i t T y p e s
46C-----------------------------------------------
47#include "implicit_f.inc"
48C-----------------------------------------------
49C G l o b a l P a r a m e t e r s
50C-----------------------------------------------
51#include "mvsiz_p.inc"
52C-----------------------------------------------
53C C o m m o n B l o c k s
54C-----------------------------------------------
55#include "vect01_c.inc"
56#include "param_c.inc"
57C-----------------------------------------------
58C D u m m y A r g u m e n t s
59C-----------------------------------------------
60 INTEGER NNC, NC(MVSIZ,NNC), MAT(*)
61C REAL
62 my_real
63 . vns(8,*),bns(8,*),vnsx(12,*),bnsx(12,*),
64 . volu(*), fill(*),
65 . pm(npropm,*), volnod(*), bvolnod(*)
66C-----------------------------------------------
67C L o c a l V a r i a b l e s
68C-----------------------------------------------
69 INTEGER I, N1, N2, N11, N22, N,
70 . IPERM101(10),IPERM102(10),IPERM103(10),
71 . IPERM161(16),IPERM162(16),
72 . IPERM201(20),IPERM202(20)
73C REAL
74 my_real
75 . fac,av1,cv1,av2,cv2
76C
77 DATA iperm101/0,0,0,0,1,2,3,1,2,3/
78 DATA iperm102/0,0,0,0,2,3,1,4,4,4/
79 DATA iperm103/1,3,6,5,0,0,0,0,0,0/
80 DATA iperm161/0,0,0,0,0,0,0,0,1,2,3,4,5,6,7,8/
81 DATA iperm162/0,0,0,0,0,0,0,0,2,3,4,1,6,7,8,5/
82 DATA iperm201/0,0,0,0,0,0,0,0,1,2,3,4,1,2,3,4,5,6,7,8/
83 DATA iperm202/0,0,0,0,0,0,0,0,2,3,4,1,5,6,7,8,6,7,8,5/
84C-----------------------------------------------------------------------
85C
86 IF(nnc==6) GOTO 60
87 IF(nnc==8) GOTO 80
88 IF(nnc==10)GOTO 100
89 IF(nnc==16)GOTO 160
90 IF(nnc==20)GOTO 200
91C
92C 4 nodes tetrahedra
93 DO i=lft,llt
94 av1 =volu(i)*fourth
95 vns(1,i)=av1
96 vns(3,i)=av1
97 vns(6,i)=av1
98 vns(5,i)=av1
99 cv1=fill(i)*pm(32,mat(i))*av1
100 bns(1,i)=cv1
101 bns(3,i)=cv1
102 bns(6,i)=cv1
103 bns(5,i)=cv1
104 ENDDO
105 GOTO 999
106C
107C Penta6 :
10860 CONTINUE
109 DO i=lft,llt
110 av1 =volu(i)*one_over_6
111 vns(1,i)=av1
112 vns(2,i)=av1
113 vns(3,i)=av1
114 vns(5,i)=av1
115 vns(6,i)=av1
116 vns(7,i)=av1
117 cv1=fill(i)*pm(32,mat(i))*av1
118 bns(1,i)=cv1
119 bns(2,i)=cv1
120 bns(3,i)=cv1
121 bns(5,i)=cv1
122 bns(6,i)=cv1
123 bns(7,i)=cv1
124 ENDDO
125 GOTO 999
126C
127C 8 nodes bricks :
12880 CONTINUE
129 DO i=lft,llt
130 av1 =volu(i)*one_over_8
131 vns(1,i)=av1
132 vns(2,i)=av1
133 vns(3,i)=av1
134 vns(4,i)=av1
135 vns(5,i)=av1
136 vns(6,i)=av1
137 vns(7,i)=av1
138 vns(8,i)=av1
139 cv1=fill(i)*pm(32,mat(i))*av1
140 bns(1,i)=cv1
141 bns(2,i)=cv1
142 bns(3,i)=cv1
143 bns(4,i)=cv1
144 bns(5,i)=cv1
145 bns(6,i)=cv1
146 bns(7,i)=cv1
147 bns(8,i)=cv1
148 ENDDO
149 GOTO 999
150C
151C 10 nodes tetrahedra :
152100 CONTINUE
153 DO i=lft,llt
154 fac=three_over_14
155 av1 = volu(i)*fac/(four*fac+six)
156 av2 = volu(i)*one /(four*fac+six)
157 vns(1,i)=av1
158 vns(3,i)=av1
159 vns(6,i)=av1
160 vns(5,i)=av1
161 cv1 = fill(i)*pm(32,mat(i))*av1
162 cv2 = fill(i)*pm(32,mat(i))*av2
163 bns(1,i)=cv1
164 bns(3,i)=cv1
165 bns(6,i)=cv1
166 bns(5,i)=cv1
167 DO n=5,10
168 IF(nc(i,n)/=0)THEN
169 vnsx(n-4,i)=av2
170 bnsx(n-4,i)=cv2
171 ELSE
172 n11=iperm101(n)
173 n1 =iperm103(n11)
174 n22=iperm102(n)
175 n2 =iperm103(n22)
176 vns(n1,i)=vns(n1,i)+half*av2
177 vns(n2,i)=vns(n2,i)+half*av2
178 bns(n1,i)=bns(n1,i)+half*cv2
179 bns(n2,i)=bns(n2,i)+half*cv2
180 ENDIF
181 ENDDO
182 ENDDO
183 GOTO 999
184C
185C 16 nodes thick shells :
186160 CONTINUE
187 DO i=lft,llt
188 av1 = volu(i)/thirty2
189 av2 = volu(i)*three/thirty2
190 vns(1,i)=av1
191 vns(2,i)=av1
192 vns(3,i)=av1
193 vns(4,i)=av1
194 vns(5,i)=av1
195 vns(6,i)=av1
196 vns(7,i)=av1
197 vns(8,i)=av1
198 cv1 = fill(i)*pm(32,mat(i))*av1
199 cv2 = fill(i)*pm(32,mat(i))*av2
200 bns(1,i)=cv1
201 bns(2,i)=cv1
202 bns(3,i)=cv1
203 bns(4,i)=cv1
204 bns(5,i)=cv1
205 bns(6,i)=cv1
206 bns(7,i)=cv1
207 bns(8,i)=cv1
208 DO n=9,16
209 IF(nc(i,n)/=0)THEN
210 vnsx(n-8,i)=av2
211 bnsx(n-8,i)=cv2
212 ELSE
213 n1=iperm161(n)
214 n2=iperm162(n)
215 vns(n1,i)=vns(n1,i)+half*av2
216 vns(n2,i)=vns(n2,i)+half*av2
217 bns(n1,i)=bns(n1,i)+half*cv2
218 bns(n2,i)=bns(n2,i)+half*cv2
219 ENDIF
220 ENDDO
221 ENDDO
222 GOTO 999
223C
224C 20 nodes bricks :
225200 CONTINUE
226 DO i=lft,llt
227 fac=three_over_14
228 av1 = volu(i)*fac/(eight*fac+twelve)
229 av2 = volu(i)*one /(eight*fac+twelve)
230 vns(1,i)=av1
231 vns(2,i)=av1
232 vns(3,i)=av1
233 vns(4,i)=av1
234 vns(5,i)=av1
235 vns(6,i)=av1
236 vns(7,i)=av1
237 vns(8,i)=av1
238 cv1 = fill(i)*pm(32,mat(i))*av1
239 cv2 = fill(i)*pm(32,mat(i))*av2
240 bns(1,i)=cv1
241 bns(2,i)=cv1
242 bns(3,i)=cv1
243 bns(4,i)=cv1
244 bns(5,i)=cv1
245 bns(6,i)=cv1
246 bns(7,i)=cv1
247 bns(8,i)=cv1
248 DO n=9,20
249 IF(nc(i,n)/=0)THEN
250 vnsx(n-8,i)=av2
251 bnsx(n-8,i)=cv2
252 ELSE
253 n1=iperm201(n)
254 n2=iperm202(n)
255 vns(n1,i)=vns(n1,i)+half*av2
256 vns(n2,i)=vns(n2,i)+half*av2
257 bns(n1,i)=bns(n1,i)+half*cv2
258 bns(n2,i)=bns(n2,i)+half*cv2
259 ENDIF
260 ENDDO
261 ENDDO
262 GOTO 999
263C
264 999 CONTINUE
265 RETURN
my_real
#define my_real
Definition cppsort.cpp:32