OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
section_t.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_t (lft, llt, nft, nseg, n1, n2, n3, nstrf, x, v, fsav, ixt, fopta, secfcum, fx, fy, fz, type, nsint, ifram, nnod, nod, ms, xsec, fbsav6, iparsens)

Function/Subroutine Documentation

◆ section_t()

subroutine section_t ( integer lft,
integer llt,
integer nft,
integer nseg,
integer n1,
integer n2,
integer n3,
integer, dimension(2,*) nstrf,
x,
v,
fsav,
integer, dimension(nixt,*) ixt,
fopta,
secfcum,
fx,
fy,
fz,
integer type,
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_t.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,TYPE,NSINT
57 INTEGER NSTRF(2,*),IXT(NIXT,*),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),
61 . v(3,*),ms(*),xsec(4,3)
62 DOUBLE PRECISION FBSAV6(12,6)
63C-----------------------------------------------
64C L o c a l V a r i a b l e s
65C-----------------------------------------------
66 INTEGER JJJ(MVSIZ), UNPACK(3,2),
67 . NSA, J, I, K, I1, I2, IPACK, N, JJ
68 my_real
69 . fx1(mvsiz), fy1(mvsiz), fz1(mvsiz),
70 . dx1(mvsiz),
71 . dy1(mvsiz), dz1(mvsiz),fst(16),
72 . msx, msy, msz, xx1, yy1, zz1, xx2, yy2, zz2, xx3, yy3, zz3,
73 . xx4, yy4, zz4, xx5, yy5, zz5, xx6, yy6, zz6, xxn, yyn, zzn,
74 . d13, xxc, yyc, zzc, fsx, fsy, fsz, fn, fsnx, fsny, fsnz, fstx,
75 . fsty, fstz, dmx, dmy, dmz
76 my_real
77 . msxphi, msyphi, mszphi, fsxphi,
78 . fsyphi, fszphi, fnphi, fsnxphi, fsnyphi, fsnzphi, fstxphi,
79 . fstyphi, fstzphi, dmxphi, dmyphi, dmzphi
80 my_real
81 . xx1phi,xx3phi,xx4phi,xx5phi,xx6phi
82 my_real
83 . yy1phi,yy3phi,yy4phi,yy5phi,yy6phi
84 my_real
85 . zz1phi,zz3phi,zz4phi,zz5phi,zz6phi
86 my_real
87 . al4phi,al5phi,al6phi,xx5t,yy5t,zz5t
88 my_real
89 . al4,al5,al6
90 my_real, DIMENSION(:,:), ALLOCATABLE :: fstparit
91C-----------------------------------------------
92 DATA unpack/1,0,1,
93 . 0,1,1/
94C
95 IF(nseg==0)RETURN
96 IF(lft+nft>nstrf(1,nseg))RETURN
97 IF(llt+nft<nstrf(1,1 ))RETURN
98C--------------------------------------------------------
99 nsa=0
100C
101 DO j=1,nseg
102 i=nstrf(1,j)-nft
103 IF (lft>i) cycle
104 IF (llt<i) EXIT
105 nsa=nsa+1
106 jjj(nsa)=j
107 ENDDO
108
109C
110 IF(nsa==0)RETURN
111C
112 IF(type+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 n = ixt(i1+1,nstrf(1,j))
149 dx1(k)=x(1,n)
150 dy1(k)=x(2,n)
151 dz1(k)=x(3,n)
152C
153 fsx=fx1(k)
154 fsy=fy1(k)
155 fsz=fz1(k)
156C
157 fn=fsx*xxn+fsy*yyn+fsz*zzn
158 fsnx=fn*xxn
159 fsny=fn*yyn
160 fsnz=fn*zzn
161 fstx=fsx-fsnx
162 fsty=fsy-fsny
163 fstz=fsz-fsnz
164C
165 dx1(k)=dx1(k)-xxc
166 dy1(k)=dy1(k)-yyc
167 dz1(k)=dz1(k)-zzc
168C
169 msx =dy1(k)*fz1(k)-dz1(k)*fy1(k)
170 msy =dz1(k)*fx1(k)-dx1(k)*fz1(k)
171 msz =dx1(k)*fy1(k)-dy1(k)*fx1(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)
194C
195 ENDIF
196 ENDDO
197 ENDDO
198 ELSE ! Parith/on
199 DO k=1,nsa
200 j = jjj(k)
201 i = nstrf(1,j)-nft
202 ipack = nstrf(2,j)
203 DO i1 = 1,2
204 IF(unpack(ipack,i1)/=0)THEN
205 fx1(k)=fx(i,i1)
206 fy1(k)=fy(i,i1)
207 fz1(k)=fz(i,i1)
208C
209 n = ixt(i1+1,nstrf(1,j))
210 dx1(k)=x(1,n)
211 dy1(k)=x(2,n)
212 dz1(k)=x(3,n)
213C
214 fsx=fx1(k)
215 fsy=fy1(k)
216 fsz=fz1(k)
217C
218 fn=fsx*xxn+fsy*yyn+fsz*zzn
219 fsnx=fn*xxn
220 fsny=fn*yyn
221 fsnz=fn*zzn
222 fstx=fsx-fsnx
223 fsty=fsy-fsny
224 fstz=fsz-fsnz
225C
226 dx1(k)=dx1(k)-xxc
227 dy1(k)=dy1(k)-yyc
228 dz1(k)=dz1(k)-zzc
229C
230 msx =dy1(k)*fz1(k)-dz1(k)*fy1(k)
231 msy =dz1(k)*fx1(k)-dx1(k)*fz1(k)
232 msz =dx1(k)*fy1(k)-dy1(k)*fx1(k)
233C
234 dmx =msx*xx4+msy*yy4+msz*zz4
235 dmy =msx*xx5+msy*yy5+msz*zz5
236 dmz =msx*xx6+msy*yy6+msz*zz6
237C
238 fst(1)=fst(1)+fsnx
239 fst(2)=fst(2)+fsny
240 fst(3)=fst(3)+fsnz
241 fst(4)=fst(4)+fstx
242 fst(5)=fst(5)+fsty
243 fst(6)=fst(6)+fstz
244 fst(7)=fst(7)+dmx
245 fst(8)=fst(8)+dmy
246 fst(9)=fst(9)+dmz
247 fst(10) = fst(10) + fsx
248 fst(11) = fst(11) + fsy
249 fst(12) = fst(12) + fsz
250 fst(13) = fst(13) + msx
251 fst(14) = fst(14) + msy
252 fst(15) = fst(15) + msz
253 fst(16)=fst(16)
254 . +fx1(k)*v(1,n)+fy1(k)*v(2,n)+fz1(k)*v(3,n)
255C
256 fstparit(1,k)=fstparit(1,k)+fsnx
257 fstparit(2,k)=fstparit(2,k)+fsny
258 fstparit(3,k)=fstparit(3,k)+fsnz
259 fstparit(4,k)=fstparit(4,k)+fstx
260 fstparit(5,k)=fstparit(5,k)+fsty
261 fstparit(6,k)=fstparit(6,k)+fstz
262 fstparit(7,k)=fstparit(7,k)+msx
263 fstparit(8,k)=fstparit(8,k)+msy
264 fstparit(9,k)=fstparit(9,k)+msz
265 fstparit(10,k)=fstparit(10,k) +
266 . ( xx4*(fsnx+fstx) +
267 . yy4*(fsny+fsty) +
268 . zz4*(fsnz+fstz) )
269 fstparit(11,k)=fstparit(11,k) +
270 . ( xx5*(fsnx+fstx) +
271 . yy5*(fsny+fsty) +
272 . zz5*(fsnz+fstz) )
273 fstparit(12,k)=fstparit(12,k) +
274 . ( xx6*(fsnx+fstx) +
275 . yy6*(fsny+fsty) +
276 . zz6*(fsnz+fstz) )
277 ENDIF
278 ENDDO
279 ENDDO
280C
281 CALL sum_6_float_sect(fstparit,12,nsa,1,nsa,fbsav6,12,6)
282C
283 DEALLOCATE(fstparit)
284 ENDIF
285C
286#include "lockon.inc"
287 fsav(1)=fsav(1)+dt12*fst(1)
288 fsav(2)=fsav(2)+dt12*fst(2)
289 fsav(3)=fsav(3)+dt12*fst(3)
290 fsav(4)=fsav(4)+dt12*fst(4)
291 fsav(5)=fsav(5)+dt12*fst(5)
292 fsav(6)=fsav(6)+dt12*fst(6)
293 fsav(7)=fsav(7)+dt12*fst(7)
294 fsav(8)=fsav(8)+dt12*fst(8)
295 fsav(9)=fsav(9)+dt12*fst(9)
296 fsav(10)=fsav(10)+dt12*fst(16)
297 fsav(31)=fsav(31)+dt12*fst(13)
298 fsav(32)=fsav(32)+dt12*fst(14)
299 fsav(33)=fsav(33)+dt12*fst(15)
300 fsav(34)=fsav(34) + dt12* (xx4*(fst(1)+fst(4)) +
301 . yy4*(fst(2)+fst(5)) + zz4*(fst(3)+fst(6)))
302 fsav(35)=fsav(35) + dt12* (xx5*(fst(1)+fst(4)) +
303 . yy5*(fst(2)+fst(5)) + zz5*(fst(3)+fst(6)))
304 fsav(36)=fsav(36) + dt12* (xx6*(fst(1)+fst(4)) +
305 . yy6*(fst(2)+fst(5)) + zz6*(fst(3)+fst(6)))
306 fsav(37)=xxc
307 fsav(38)=yyc
308 fsav(39)=zzc
309 fopta(1) = fopta(1) + fst(10)
310 fopta(2) = fopta(2) + fst(11)
311 fopta(3) = fopta(3) + fst(12)
312 fopta(4) = fopta(4) + fst(13)
313 fopta(5) = fopta(5) + fst(14)
314 fopta(6) = fopta(6) + fst(15)
315#include "lockoff.inc"
316C
317 ELSE
318C
319#include "lockon.inc"
320 DO i1 = 1,2
321 DO k=1,nsa
322 j = jjj(k)
323 i = nstrf(1,j)-nft
324 ipack = nstrf(2,j)
325 IF(unpack(ipack,i1)/=0)THEN
326 n = ixt(i1+1,nstrf(1,j))
327 secfcum(1,n)=secfcum(1,n)+fx(i,i1)
328 secfcum(2,n)=secfcum(2,n)+fy(i,i1)
329 secfcum(3,n)=secfcum(3,n)+fz(i,i1)
330 ENDIF
331 ENDDO
332 ENDDO
333#include "lockoff.inc"
334 ENDIF
335C
336 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