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

Function/Subroutine Documentation

◆ section_r()

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