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 34 of file section_3n.F.

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