OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
section_3n.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 "scr06_c.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine section_3n (lft, llt, nft, nseg, n1, n2, n3, nstrf, x, v, vr, fsav, ixtg, fopta, secfcum, fx, fy, fz, mx, my, mz, type, nsint, ifram, nnod, nod, ms, xsec, fbsav6, iparsens)

Function/Subroutine Documentation

◆ section_3n()

subroutine section_3n ( integer lft,
integer llt,
integer nft,
integer nseg,
integer n1,
integer n2,
integer n3,
integer, dimension(2,*) nstrf,
x,
v,
vr,
fsav,
integer, dimension(nixtg,*) ixtg,
fopta,
secfcum,
fx,
fy,
fz,
mx,
my,
mz,
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_3n.F.

38C-----------------------------------------------
39C I m p l i c i t T y p e s
40C-----------------------------------------------
41#include "implicit_f.inc"
42C-----------------------------------------------
43C G l o b a l P a r a m e t e r s
44C-----------------------------------------------
45#include "mvsiz_p.inc"
46C-----------------------------------------------
47C C o m m o n B l o c k s
48C-----------------------------------------------
49#include "comlock.inc"
50#include "com01_c.inc"
51#include "com08_c.inc"
52#include "param_c.inc"
53#include "scr06_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,
58 4 TYPE,NSINT,IPARSENS
59 INTEGER NSTRF(2,*),IXTG(NIXTG,*),IFRAM,NNOD,NOD(*)
60 my_real
61 . x(3,*), fsav(nthvki), fopta(6), secfcum(7,*),
62 . fx(mvsiz,3), fy(mvsiz,3), fz(mvsiz,3), mx(mvsiz,3),
63 . my(mvsiz,3), mz(mvsiz,3),
64 . v(3,*), vr(3,*),ms(*),xsec(4,3)
65 DOUBLE PRECISION FBSAV6(12,6)
66C-----------------------------------------------
67C L o c a l V a r i a b l e s
68C-----------------------------------------------
69 INTEGER JJJ(MVSIZ), UNPACK(0:7,3),
70 . NSA, J, I, K, I1, I2, IPACK, N, JJ
71 my_real
72 . fx1(mvsiz), fy1(mvsiz), fz1(mvsiz),
73 . mx1(mvsiz), my1(mvsiz), mz1(mvsiz), dx1(mvsiz),
74 . dy1(mvsiz), dz1(mvsiz),fst(16),
75 . msx, msy, msz,
76 . xx4, yy4, zz4, xx5, yy5, zz5, xx6, yy6, zz6, xxn, yyn, zzn,
77 . d13, xxc, yyc, zzc, fsx, fsy, fsz, fn, fsnx, fsny, fsnz, fstx,
78 . fsty, fstz, dmx, dmy, dmz
79 my_real
80 . msxphi, msyphi, mszphi, fsxphi,
81 . fsyphi, fszphi, fnphi, fsnxphi, fsnyphi, fsnzphi, fstxphi,
82 . fstyphi, fstzphi, dmxphi, dmyphi, dmzphi
83 my_real
84 . xx1phi,xx3phi,xx4phi,xx5phi,xx6phi
85 my_real
86 . yy1phi,yy3phi,yy4phi,yy5phi,yy6phi
87 my_real
88 . zz1phi,zz3phi,zz4phi,zz5phi,zz6phi
89 my_real
90 . al4phi,al5phi,al6phi,xx5t,yy5t,zz5t
91 my_real
92 . al4,al5,al6
93 my_real, DIMENSION(:,:), ALLOCATABLE :: fstparit
94C-----------------------------------------------
95 DATA unpack/0,1,0,1,0,1,0,1,
96 . 0,0,1,1,0,0,1,1,
97 . 0,0,0,0,1,1,1,1/
98C
99 IF(nseg==0)RETURN
100 IF(lft+nft>nstrf(1,nseg))RETURN
101 IF(llt+nft<nstrf(1,1 ))RETURN
102C---------------------------------------------------------
103 nsa=0
104C
105 DO 20 j=1,nseg
106 i=nstrf(1,j)-nft
107 IF (lft>i) GOTO 20
108 IF (llt<i) GOTO 30
109 nsa=nsa+1
110 jjj(nsa)=j
111 20 CONTINUE
112 30 CONTINUE
113C
114 IF(nsa==0)RETURN
115C
116 IF(type+nsint==0)THEN
117C
118 DO i=1,16
119 fst(i)=zero
120 ENDDO
121C
122 IF(iparsens/=0) THEN
123 ALLOCATE(fstparit(12,nsa))
124 DO j=1,nsa
125 DO i=1,12
126 fstparit(i,j) = zero
127 ENDDO
128 ENDDO
129 ENDIF
130C
131 IF(nspmd==1) THEN
132 CALL section_skew(n1 ,n2 ,n3 ,x , xxc, yyc, zzc,
133 2 xx4, yy4, zz4, xx5, yy5, zz5, xx6, yy6, zz6,
134 3 xxn, yyn, zzn,ifram,nnod,nod,ms)
135 ELSE
136 CALL section_skewp(xxc, yyc, zzc, xx4 , yy4 , zz4 ,
137 2 xx5, yy5, zz5, xx6 , yy6 , zz6 ,
138 3 xxn, yyn, zzn, ifram, n1 , xsec)
139 END IF
140C
141 IF(iparsens==0) THEN ! Parith/Off
142 DO k=1,nsa
143 j = jjj(k)
144 i = nstrf(1,j)-nft
145 ipack = nstrf(2,j)
146 DO i1 = 1,3
147 IF(unpack(ipack,i1)/=0)THEN
148 fx1(k)=fx(i,i1)
149 fy1(k)=fy(i,i1)
150 fz1(k)=fz(i,i1)
151C
152 mx1(k)=mx(i,i1)
153 my1(k)=my(i,i1)
154 mz1(k)=mz(i,i1)
155C
156 n = ixtg(i1+1,nstrf(1,j))
157 dx1(k)=x(1,n)
158 dy1(k)=x(2,n)
159 dz1(k)=x(3,n)
160C
161 fsx=fx1(k)
162 fsy=fy1(k)
163 fsz=fz1(k)
164C
165 fn=fsx*xxn+fsy*yyn+fsz*zzn
166 fsnx=fn*xxn
167 fsny=fn*yyn
168 fsnz=fn*zzn
169 fstx=fsx-fsnx
170 fsty=fsy-fsny
171 fstz=fsz-fsnz
172C
173 dx1(k)=dx1(k)-xxc
174 dy1(k)=dy1(k)-yyc
175 dz1(k)=dz1(k)-zzc
176C
177 msx =dy1(k)*fz1(k)-dz1(k)*fy1(k)
178 msy =dz1(k)*fx1(k)-dx1(k)*fz1(k)
179 msz =dx1(k)*fy1(k)-dy1(k)*fx1(k)
180C
181 msx =msx+mx1(k)
182 msy =msy+my1(k)
183 msz =msz+mz1(k)
184C
185 dmx =msx*xx4+msy*yy4+msz*zz4
186 dmy =msx*xx5+msy*yy5+msz*zz5
187 dmz =msx*xx6+msy*yy6+msz*zz6
188C
189 fst(1)=fst(1)+fsnx
190 fst(2)=fst(2)+fsny
191 fst(3)=fst(3)+fsnz
192 fst(4)=fst(4)+fstx
193 fst(5)=fst(5)+fsty
194 fst(6)=fst(6)+fstz
195 fst(7)=fst(7)+dmx
196 fst(8)=fst(8)+dmy
197 fst(9)=fst(9)+dmz
198 fst(10) = fst(10) + fsx
199 fst(11) = fst(11) + fsy
200 fst(12) = fst(12) + fsz
201 fst(13) = fst(13) + msx
202 fst(14) = fst(14) + msy
203 fst(15) = fst(15) + msz
204 fst(16)=fst(16)
205 . +fx1(k)*v(1,n) +fy1(k)*v(2,n) +fz1(k)*v(3,n)
206 . +mx1(k)*vr(1,n)+my1(k)*vr(2,n)+mz1(k)*vr(3,n)
207C
208 ENDIF
209 ENDDO
210 ENDDO
211 ELSE ! Parith/on
212 DO k=1,nsa
213 j = jjj(k)
214 i = nstrf(1,j)-nft
215 ipack = nstrf(2,j)
216 DO i1 = 1,3
217 IF(unpack(ipack,i1)/=0)THEN
218 fx1(k)=fx(i,i1)
219 fy1(k)=fy(i,i1)
220 fz1(k)=fz(i,i1)
221C
222 mx1(k)=mx(i,i1)
223 my1(k)=my(i,i1)
224 mz1(k)=mz(i,i1)
225C
226 n = ixtg(i1+1,nstrf(1,j))
227 dx1(k)=x(1,n)
228 dy1(k)=x(2,n)
229 dz1(k)=x(3,n)
230C
231 fsx=fx1(k)
232 fsy=fy1(k)
233 fsz=fz1(k)
234C
235 fn=fsx*xxn+fsy*yyn+fsz*zzn
236 fsnx=fn*xxn
237 fsny=fn*yyn
238 fsnz=fn*zzn
239 fstx=fsx-fsnx
240 fsty=fsy-fsny
241 fstz=fsz-fsnz
242C
243 dx1(k)=dx1(k)-xxc
244 dy1(k)=dy1(k)-yyc
245 dz1(k)=dz1(k)-zzc
246C
247 msx =dy1(k)*fz1(k)-dz1(k)*fy1(k)
248 msy =dz1(k)*fx1(k)-dx1(k)*fz1(k)
249 msz =dx1(k)*fy1(k)-dy1(k)*fx1(k)
250C
251 msx =msx+mx1(k)
252 msy =msy+my1(k)
253 msz =msz+mz1(k)
254C
255 dmx =msx*xx4+msy*yy4+msz*zz4
256 dmy =msx*xx5+msy*yy5+msz*zz5
257 dmz =msx*xx6+msy*yy6+msz*zz6
258C
259 fst(1)=fst(1)+fsnx
260 fst(2)=fst(2)+fsny
261 fst(3)=fst(3)+fsnz
262 fst(4)=fst(4)+fstx
263 fst(5)=fst(5)+fsty
264 fst(6)=fst(6)+fstz
265 fst(7)=fst(7)+dmx
266 fst(8)=fst(8)+dmy
267 fst(9)=fst(9)+dmz
268 fst(10) = fst(10) + fsx
269 fst(11) = fst(11) + fsy
270 fst(12) = fst(12) + fsz
271 fst(13) = fst(13) + msx
272 fst(14) = fst(14) + msy
273 fst(15) = fst(15) + msz
274 fst(16)=fst(16)
275 . +fx1(k)*v(1,n) +fy1(k)*v(2,n) +fz1(k)*v(3,n)
276 . +mx1(k)*vr(1,n)+my1(k)*vr(2,n)+mz1(k)*vr(3,n)
277C
278 fstparit(1,k)=fstparit(1,k)+fsnx
279 fstparit(2,k)=fstparit(2,k)+fsny
280 fstparit(3,k)=fstparit(3,k)+fsnz
281 fstparit(4,k)=fstparit(4,k)+fstx
282 fstparit(5,k)=fstparit(5,k)+fsty
283 fstparit(6,k)=fstparit(6,k)+fstz
284 fstparit(7,k)=fstparit(7,k)+msx
285 fstparit(8,k)=fstparit(8,k)+msy
286 fstparit(9,k)=fstparit(9,k)+msz
287 fstparit(10,k)=fstparit(10,k) +
288 . ( xx4*(fsnx+fstx) +
289 . yy4*(fsny+fsty) +
290 . zz4*(fsnz+fstz) )
291 fstparit(11,k)=fstparit(11,k) +
292 . ( xx5*(fsnx+fstx) +
293 . yy5*(fsny+fsty) +
294 . zz5*(fsnz+fstz) )
295 fstparit(12,k)=fstparit(12,k) +
296 . ( xx6*(fsnx+fstx) +
297 . yy6*(fsny+fsty) +
298 . zz6*(fsnz+fstz) )
299 ENDIF
300 ENDDO
301 ENDDO
302C
303 CALL sum_6_float_sect(fstparit,12,nsa,1,nsa,fbsav6,12,6)
304C
305 ENDIF
306C
307#include "lockon.inc"
308 fsav(1)=fsav(1)+dt12*fst(1)
309 fsav(2)=fsav(2)+dt12*fst(2)
310 fsav(3)=fsav(3)+dt12*fst(3)
311 fsav(4)=fsav(4)+dt12*fst(4)
312 fsav(5)=fsav(5)+dt12*fst(5)
313 fsav(6)=fsav(6)+dt12*fst(6)
314 fsav(7)=fsav(7)+dt12*fst(7)
315 fsav(8)=fsav(8)+dt12*fst(8)
316 fsav(9)=fsav(9)+dt12*fst(9)
317 fsav(10)=fsav(10)+dt12*fst(16)
318 fsav(31)=fsav(31)+dt12*fst(13)
319 fsav(32)=fsav(32)+dt12*fst(14)
320 fsav(33)=fsav(33)+dt12*fst(15)
321 fsav(34)=fsav(34) + dt12* (xx4*(fst(1)+fst(4)) +
322 . yy4*(fst(2)+fst(5)) + zz4*(fst(3)+fst(6)))
323 fsav(35)=fsav(35) + dt12* (xx5*(fst(1)+fst(4)) +
324 . yy5*(fst(2)+fst(5)) + zz5*(fst(3)+fst(6)))
325 fsav(36)=fsav(36) + dt12* (xx6*(fst(1)+fst(4)) +
326 . yy6*(fst(2)+fst(5)) + zz6*(fst(3)+fst(6)))
327 fsav(37)=xxc
328 fsav(38)=yyc
329 fsav(39)=zzc
330 fopta(1) = fopta(1) + fst(10)
331 fopta(2) = fopta(2) + fst(11)
332 fopta(3) = fopta(3) + fst(12)
333 fopta(4) = fopta(4) + fst(13)
334 fopta(5) = fopta(5) + fst(14)
335 fopta(6) = fopta(6) + fst(15)
336#include "lockoff.inc"
337C
338 ELSE
339C
340#include "lockon.inc"
341 DO i1 = 1,3
342 DO k=1,nsa
343 j = jjj(k)
344 i = nstrf(1,j)-nft
345 ipack = nstrf(2,j)
346 IF(unpack(ipack,i1)/=0)THEN
347 n = ixtg(i1+1,nstrf(1,j))
348 secfcum(1,n)=secfcum(1,n)+fx(i,i1)
349 secfcum(2,n)=secfcum(2,n)+fy(i,i1)
350 secfcum(3,n)=secfcum(3,n)+fz(i,i1)
351 secfcum(5,n)=secfcum(5,n)+mx(i,i1)
352 secfcum(6,n)=secfcum(6,n)+my(i,i1)
353 secfcum(7,n)=secfcum(7,n)+mz(i,i1)
354 ENDIF
355 ENDDO
356 ENDDO
357#include "lockoff.inc"
358 ENDIF
359C
360 IF((nsa/=0).AND.(iparsens/=0)) THEN
361 DEALLOCATE(fstparit)
362 ENDIF
363C
364 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