OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
section_s6.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "comlock.inc"
#include "com01_c.inc"
#include "com08_c.inc"
#include "param_c.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine section_s6 (lft, llt, nft, nseg, n1, n2, n3, nstrf, x, v, fsav, ixs, fopta, secfcum, fx, fy, fz, type, nsint, ifram, nnod, nod, ms, xsec, fbsav6, iparsens)

Function/Subroutine Documentation

◆ section_s6()

subroutine section_s6 ( integer lft,
integer llt,
integer nft,
integer nseg,
integer n1,
integer n2,
integer n3,
integer, dimension(2,*) nstrf,
x,
v,
fsav,
integer, dimension(nixs,*) ixs,
fopta,
secfcum,
fx,
fy,
fz,
integer type,
integer nsint,
integer ifram,
integer nnod,
integer, dimension(*) nod,
ms,
xsec,
double precision, dimension(12,6) fbsav6,
integer iparsens )

Definition at line 32 of file section_s6.F.

39C-----------------------------------------------
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42#include "implicit_f.inc"
43C-----------------------------------------------
44C G l o b a l P a r a m e t e r s
45C-----------------------------------------------
46#include "mvsiz_p.inc"
47C-----------------------------------------------
48C C o m m o n B l o c k s
49C-----------------------------------------------
50#include "comlock.inc"
51#include "com01_c.inc"
52#include "com08_c.inc"
53#include "param_c.inc"
54C-----------------------------------------------
55C D u m m y A r g u m e n t s
56C-----------------------------------------------
57 INTEGER LFT, LLT, NFT, NSEG, N1, N2, N3,TYPE,NSINT
58 INTEGER NSTRF(2,*),IXS(NIXS,*),IFRAM,NNOD,NOD(*)
59 INTEGER IPARSENS
60 my_real x(3,*), fsav(nthvki), fopta(6), secfcum(7,*),xsec(4,3),
61 . fx(mvsiz,8), fy(mvsiz,8), fz(mvsiz,8), v(3,*) ,ms(*)
62 DOUBLE PRECISION FBSAV6(12,6)
63C-----------------------------------------------
64C L o c a l V a r i a b l e s
65C-----------------------------------------------
66 INTEGER JJJ(MVSIZ), UNPACK(0:255,8),
67 . NSA, J, I, K, I1, I2, IPACK, N,POWER2(8),IPERM(6),II,JJ
68 my_real fx1(mvsiz), fy1(mvsiz), fz1(mvsiz),
69 . dx1(mvsiz),dy1(mvsiz), dz1(mvsiz),fst(16),
70 . msx, msy, msz, xx1, yy1, zz1, xx2, yy2, zz2, xx3, yy3, zz3,
71 . xx4, yy4, zz4, xx5, yy5, zz5, xx6, yy6, zz6, xxn, yyn, zzn,
72 . d13, xxc, yyc, zzc, fsx, fsy, fsz, fn, fsnx, fsny, fsnz, fstx,
73 . fsty, fstz, dmx, dmy, dmz,
74 . al4,al5,al6
75 DATA power2/1,2,4,8,16,32,64,128/
76 DATA iperm/1,2,3,5,6,7/
77 my_real, DIMENSION(:,:), ALLOCATABLE :: fstparit
78C---------------------------------------------------------
79 IF(nseg==0)RETURN
80 IF(lft+nft>nstrf(1,nseg))RETURN
81 IF(llt+nft<nstrf(1,1 ))RETURN
82C---------------------------------------------------------
83 nsa=0
84C
85 DO i=1,8
86 DO j=0,255
87 unpack(j,i)=mod(j/power2(i),2)
88 ENDDO
89 ENDDO
90C
91 DO j=1,nseg
92 i=nstrf(1,j)-nft
93 IF (lft>i) cycle
94 IF (llt<i) EXIT
95 nsa=nsa+1
96 jjj(nsa)=j
97 ENDDO
98
99C
100 IF(nsa==0)RETURN
101C
102 IF(type+nsint==0)THEN
103C
104 DO i=1,16
105 fst(i)=zero
106 ENDDO
107C
108 IF(iparsens/=0) THEN
109 ALLOCATE(fstparit(12,nsa))
110 DO j=1,nsa
111 DO i=1,12
112 fstparit(i,j) = zero
113 ENDDO
114 ENDDO
115 ENDIF
116C
117 IF(nspmd==1) THEN
118 CALL section_skew(n1 ,n2 ,n3 ,x , xxc, yyc, zzc,
119 2 xx4, yy4, zz4, xx5, yy5, zz5, xx6, yy6, zz6,
120 3 xxn, yyn, zzn,ifram,nnod,nod,ms)
121 ELSE
122 CALL section_skewp(xxc, yyc, zzc, xx4 , yy4 , zz4 ,
123 2 xx5, yy5, zz5, xx6 , yy6 , zz6 ,
124 3 xxn, yyn, zzn, ifram, n1 , xsec)
125 END IF
126C
127 IF(iparsens==0) THEN ! Parith/Off
128 DO k=1,nsa
129 j = jjj(k)
130 i = nstrf(1,j)-nft
131 ipack = mod(nstrf(2,j),256)
132 DO ii=1,6
133 i1 = iperm(ii)
134 IF(unpack(ipack,i1)/=0)THEN
135 fx1(k)=-fx(i,ii)
136 fy1(k)=-fy(i,ii)
137 fz1(k)=-fz(i,ii)
138C
139 n = ixs(i1+1,nstrf(1,j))
140 dx1(k)=x(1,n)
141 dy1(k)=x(2,n)
142 dz1(k)=x(3,n)
143C
144 fsx=fx1(k)
145 fsy=fy1(k)
146 fsz=fz1(k)
147C
148 fn=fsx*xxn+fsy*yyn+fsz*zzn
149 fsnx=fn*xxn
150 fsny=fn*yyn
151 fsnz=fn*zzn
152 fstx=fsx-fsnx
153 fsty=fsy-fsny
154 fstz=fsz-fsnz
155C
156 dx1(k)=dx1(k)-xxc
157 dy1(k)=dy1(k)-yyc
158 dz1(k)=dz1(k)-zzc
159C
160 msx =dy1(k)*fz1(k)-dz1(k)*fy1(k)
161 msy =dz1(k)*fx1(k)-dx1(k)*fz1(k)
162 msz =dx1(k)*fy1(k)-dy1(k)*fx1(k)
163C
164 dmx =msx*xx4+msy*yy4+msz*zz4
165 dmy =msx*xx5+msy*yy5+msz*zz5
166 dmz =msx*xx6+msy*yy6+msz*zz6
167C
168 fst(1)=fst(1)+fsnx
169 fst(2)=fst(2)+fsny
170 fst(3)=fst(3)+fsnz
171 fst(4)=fst(4)+fstx
172 fst(5)=fst(5)+fsty
173 fst(6)=fst(6)+fstz
174 fst(7)=fst(7)+dmx
175 fst(8)=fst(8)+dmy
176 fst(9)=fst(9)+dmz
177 fst(10) = fst(10) + fsx
178 fst(11) = fst(11) + fsy
179 fst(12) = fst(12) + fsz
180 fst(13) = fst(13) + msx
181 fst(14) = fst(14) + msy
182 fst(15) = fst(15) + msz
183 fst(16)=fst(16)
184 . +fx1(k)*v(1,n)+fy1(k)*v(2,n)+fz1(k)*v(3,n)
185C
186 ENDIF
187 ENDDO
188 ENDDO
189 ELSE ! Parith/On
190 DO k=1,nsa
191 j = jjj(k)
192 i = nstrf(1,j)-nft
193 ipack = mod(nstrf(2,j),256)
194 DO ii=1,6
195 i1 = iperm(ii)
196 IF(unpack(ipack,i1)/=0)THEN
197 fx1(k)=-fx(i,ii)
198 fy1(k)=-fy(i,ii)
199 fz1(k)=-fz(i,ii)
200C
201 n = ixs(i1+1,nstrf(1,j))
202 dx1(k)=x(1,n)
203 dy1(k)=x(2,n)
204 dz1(k)=x(3,n)
205C
206 fsx=fx1(k)
207 fsy=fy1(k)
208 fsz=fz1(k)
209C
210 fn=fsx*xxn+fsy*yyn+fsz*zzn
211 fsnx=fn*xxn
212 fsny=fn*yyn
213 fsnz=fn*zzn
214 fstx=fsx-fsnx
215 fsty=fsy-fsny
216 fstz=fsz-fsnz
217C
218 dx1(k)=dx1(k)-xxc
219 dy1(k)=dy1(k)-yyc
220 dz1(k)=dz1(k)-zzc
221C
222 msx =dy1(k)*fz1(k)-dz1(k)*fy1(k)
223 msy =dz1(k)*fx1(k)-dx1(k)*fz1(k)
224 msz =dx1(k)*fy1(k)-dy1(k)*fx1(k)
225C
226 dmx =msx*xx4+msy*yy4+msz*zz4
227 dmy =msx*xx5+msy*yy5+msz*zz5
228 dmz =msx*xx6+msy*yy6+msz*zz6
229C
230 fst(1)=fst(1)+fsnx
231 fst(2)=fst(2)+fsny
232 fst(3)=fst(3)+fsnz
233 fst(4)=fst(4)+fstx
234 fst(5)=fst(5)+fsty
235 fst(6)=fst(6)+fstz
236 fst(7)=fst(7)+dmx
237 fst(8)=fst(8)+dmy
238 fst(9)=fst(9)+dmz
239 fst(10) = fst(10) + fsx
240 fst(11) = fst(11) + fsy
241 fst(12) = fst(12) + fsz
242 fst(13) = fst(13) + msx
243 fst(14) = fst(14) + msy
244 fst(15) = fst(15) + msz
245 fst(16)=fst(16)
246 . +fx1(k)*v(1,n)+fy1(k)*v(2,n)+fz1(k)*v(3,n)
247C
248 fstparit(1,k)=fstparit(1,k)+fsnx
249 fstparit(2,k)=fstparit(2,k)+fsny
250 fstparit(3,k)=fstparit(3,k)+fsnz
251 fstparit(4,k)=fstparit(4,k)+fstx
252 fstparit(5,k)=fstparit(5,k)+fsty
253 fstparit(6,k)=fstparit(6,k)+fstz
254 fstparit(7,k)=fstparit(7,k)+msx
255 fstparit(8,k)=fstparit(8,k)+msy
256 fstparit(9,k)=fstparit(9,k)+msz
257 fstparit(10,k)=fstparit(10,k) +
258 . ( xx4*(fsnx+fstx) +
259 . yy4*(fsny+fsty) +
260 . zz4*(fsnz+fstz) )
261 fstparit(11,k)=fstparit(11,k) +
262 . ( xx5*(fsnx+fstx) +
263 . yy5*(fsny+fsty) +
264 . zz5*(fsnz+fstz) )
265 fstparit(12,k)=fstparit(12,k) +
266 . ( xx6*(fsnx+fstx) +
267 . yy6*(fsny+fsty) +
268 . zz6*(fsnz+fstz) )
269 ENDIF
270 ENDDO
271 ENDDO
272C
273 CALL sum_6_float_sect(fstparit,12,nsa,1,nsa,fbsav6,12,6)
274C
275 DEALLOCATE(fstparit)
276 ENDIF
277C
278#include "lockon.inc"
279 fsav(1)=fsav(1)+dt12*fst(1)
280 fsav(2)=fsav(2)+dt12*fst(2)
281 fsav(3)=fsav(3)+dt12*fst(3)
282 fsav(4)=fsav(4)+dt12*fst(4)
283 fsav(5)=fsav(5)+dt12*fst(5)
284 fsav(6)=fsav(6)+dt12*fst(6)
285 fsav(7)=fsav(7)+dt12*fst(7)
286 fsav(8)=fsav(8)+dt12*fst(8)
287 fsav(9)=fsav(9)+dt12*fst(9)
288 fsav(10)=fsav(10)+dt12*fst(16)
289 fsav(31)=fsav(31)+dt12*fst(13)
290 fsav(32)=fsav(32)+dt12*fst(14)
291 fsav(33)=fsav(33)+dt12*fst(15)
292 fsav(34)=fsav(34) + dt12* (xx4*(fst(1)+fst(4)) +
293 . yy4*(fst(2)+fst(5)) + zz4*(fst(3)+fst(6)))
294 fsav(35)=fsav(35) + dt12* (xx5*(fst(1)+fst(4)) +
295 . yy5*(fst(2)+fst(5)) + zz5*(fst(3)+fst(6)))
296 fsav(36)=fsav(36) + dt12* (xx6*(fst(1)+fst(4)) +
297 . yy6*(fst(2)+fst(5)) + zz6*(fst(3)+fst(6)))
298 fsav(37)=xxc
299 fsav(38)=yyc
300 fsav(39)=zzc
301 fopta(1) = fopta(1) + fst(10)
302 fopta(2) = fopta(2) + fst(11)
303 fopta(3) = fopta(3) + fst(12)
304 fopta(4) = fopta(4) + fst(13)
305 fopta(5) = fopta(5) + fst(14)
306 fopta(6) = fopta(6) + fst(15)
307#include "lockoff.inc"
308C
309
310 ELSE
311C
312#include "lockon.inc"
313 DO ii=1,6
314 i1=iperm(ii)
315 DO k=1,nsa
316 j = jjj(k)
317 i = nstrf(1,j)-nft
318 ipack = mod(nstrf(2,j),256)
319 IF(unpack(ipack,i1)/=0)THEN
320 n = ixs(i1+1,nstrf(1,j))
321 secfcum(1,n)=secfcum(1,n)- fx(i,ii)
322 secfcum(2,n)=secfcum(2,n)- fy(i,ii)
323 secfcum(3,n)=secfcum(3,n)- fz(i,ii)
324 ENDIF
325 ENDDO
326 ENDDO
327#include "lockoff.inc"
328 ENDIF
329C
330 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
sum_6_float_sect
subroutine sum_6_float_sect(f, a, b, jft, jlt, f6, d, e)
Definition parit.F:699
section_skew
subroutine section_skew(n1, n2, n3, x, xxc, yyc, zzc, xx4, yy4, zz4, xx5, yy5, zz5, xx6, yy6, zz6, xxn, yyn, zzn, ifram, nnod, nod, ms)
Definition section_skew.F:40
section_skewp
subroutine section_skewp(xxc, yyc, zzc, xx4, yy4, zz4, xx5, yy5, zz5, xx6, yy6, zz6, xxn, yyn, zzn, ifram, n1, xsec)
Definition section_skewp.F:40