OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
section_p.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_p (lft, llt, nft, nseg, n1, n2, n3, nstrf, x, v, vr, fsav, ixp, fopta, secfcum, fx, fy, fz, mx, my, mz, itype, nsint, ifram, nnod, nod, ms, xsec, fbsav6, iparsens)

Function/Subroutine Documentation

◆ section_p()

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

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