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

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