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 38 of file sbulk3.F.

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