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