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

40 use element_mod , only : nixt
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,TYPE,NSINT
60 INTEGER NSTRF(2,*),IXT(NIXT,*),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),
64 . v(3,*),ms(*),xsec(4,3)
65 DOUBLE PRECISION FBSAV6(12,6)
66C-----------------------------------------------
67C L o c a l V a r i a b l e s
68C-----------------------------------------------
69 INTEGER JJJ(MVSIZ), UNPACK(3,2),
70 . NSA, J, I, K, I1, IPACK, N
71 my_real
72 . fx1(mvsiz), fy1(mvsiz), fz1(mvsiz),
73 . dx1(mvsiz),
74 . dy1(mvsiz), dz1(mvsiz),fst(16),
75 . msx, msy, msz,
76 . xx4, yy4, zz4, xx5, yy5, zz5, xx6, yy6, zz6, xxn, yyn, zzn,
77 . xxc, yyc, zzc, fsx, fsy, fsz, fn, fsnx, fsny, fsnz, fstx,
78 . fsty, fstz, dmx, dmy, dmz
79 my_real, DIMENSION(:,:), ALLOCATABLE :: fstparit
80C-----------------------------------------------
81 DATA unpack/1,0,1,
82 . 0,1,1/
83C
84 IF(nseg==0)RETURN
85 IF(lft+nft>nstrf(1,nseg))RETURN
86 IF(llt+nft<nstrf(1,1 ))RETURN
87C--------------------------------------------------------
88 nsa=0
89C
90 DO j=1,nseg
91 i=nstrf(1,j)-nft
92 IF (lft>i) cycle
93 IF (llt<i) EXIT
94 nsa=nsa+1
95 jjj(nsa)=j
96 ENDDO
97
98C
99 IF(nsa==0)RETURN
100C
101 IF(type+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 n = ixt(i1+1,nstrf(1,j))
138 dx1(k)=x(1,n)
139 dy1(k)=x(2,n)
140 dz1(k)=x(3,n)
141C
142 fsx=fx1(k)
143 fsy=fy1(k)
144 fsz=fz1(k)
145C
146 fn=fsx*xxn+fsy*yyn+fsz*zzn
147 fsnx=fn*xxn
148 fsny=fn*yyn
149 fsnz=fn*zzn
150 fstx=fsx-fsnx
151 fsty=fsy-fsny
152 fstz=fsz-fsnz
153C
154 dx1(k)=dx1(k)-xxc
155 dy1(k)=dy1(k)-yyc
156 dz1(k)=dz1(k)-zzc
157C
158 msx =dy1(k)*fz1(k)-dz1(k)*fy1(k)
159 msy =dz1(k)*fx1(k)-dx1(k)*fz1(k)
160 msz =dx1(k)*fy1(k)-dy1(k)*fx1(k)
161C
162 dmx =msx*xx4+msy*yy4+msz*zz4
163 dmy =msx*xx5+msy*yy5+msz*zz5
164 dmz =msx*xx6+msy*yy6+msz*zz6
165C
166 fst(1)=fst(1)+fsnx
167 fst(2)=fst(2)+fsny
168 fst(3)=fst(3)+fsnz
169 fst(4)=fst(4)+fstx
170 fst(5)=fst(5)+fsty
171 fst(6)=fst(6)+fstz
172 fst(7)=fst(7)+dmx
173 fst(8)=fst(8)+dmy
174 fst(9)=fst(9)+dmz
175 fst(10) = fst(10) + fsx
176 fst(11) = fst(11) + fsy
177 fst(12) = fst(12) + fsz
178 fst(13) = fst(13) + msx
179 fst(14) = fst(14) + msy
180 fst(15) = fst(15) + msz
181 fst(16)=fst(16)
182 . +fx1(k)*v(1,n)+fy1(k)*v(2,n)+fz1(k)*v(3,n)
183C
184 ENDIF
185 ENDDO
186 ENDDO
187 ELSE ! Parith/on
188 DO k=1,nsa
189 j = jjj(k)
190 i = nstrf(1,j)-nft
191 ipack = nstrf(2,j)
192 DO i1 = 1,2
193 IF(unpack(ipack,i1)/=0)THEN
194 fx1(k)=fx(i,i1)
195 fy1(k)=fy(i,i1)
196 fz1(k)=fz(i,i1)
197C
198 n = ixt(i1+1,nstrf(1,j))
199 dx1(k)=x(1,n)
200 dy1(k)=x(2,n)
201 dz1(k)=x(3,n)
202C
203 fsx=fx1(k)
204 fsy=fy1(k)
205 fsz=fz1(k)
206C
207 fn=fsx*xxn+fsy*yyn+fsz*zzn
208 fsnx=fn*xxn
209 fsny=fn*yyn
210 fsnz=fn*zzn
211 fstx=fsx-fsnx
212 fsty=fsy-fsny
213 fstz=fsz-fsnz
214C
215 dx1(k)=dx1(k)-xxc
216 dy1(k)=dy1(k)-yyc
217 dz1(k)=dz1(k)-zzc
218C
219 msx =dy1(k)*fz1(k)-dz1(k)*fy1(k)
220 msy =dz1(k)*fx1(k)-dx1(k)*fz1(k)
221 msz =dx1(k)*fy1(k)-dy1(k)*fx1(k)
222C
223 dmx =msx*xx4+msy*yy4+msz*zz4
224 dmy =msx*xx5+msy*yy5+msz*zz5
225 dmz =msx*xx6+msy*yy6+msz*zz6
226C
227 fst(1)=fst(1)+fsnx
228 fst(2)=fst(2)+fsny
229 fst(3)=fst(3)+fsnz
230 fst(4)=fst(4)+fstx
231 fst(5)=fst(5)+fsty
232 fst(6)=fst(6)+fstz
233 fst(7)=fst(7)+dmx
234 fst(8)=fst(8)+dmy
235 fst(9)=fst(9)+dmz
236 fst(10) = fst(10) + fsx
237 fst(11) = fst(11) + fsy
238 fst(12) = fst(12) + fsz
239 fst(13) = fst(13) + msx
240 fst(14) = fst(14) + msy
241 fst(15) = fst(15) + msz
242 fst(16)=fst(16)
243 . +fx1(k)*v(1,n)+fy1(k)*v(2,n)+fz1(k)*v(3,n)
244C
245 fstparit(1,k)=fstparit(1,k)+fsnx
246 fstparit(2,k)=fstparit(2,k)+fsny
247 fstparit(3,k)=fstparit(3,k)+fsnz
248 fstparit(4,k)=fstparit(4,k)+fstx
249 fstparit(5,k)=fstparit(5,k)+fsty
250 fstparit(6,k)=fstparit(6,k)+fstz
251 fstparit(7,k)=fstparit(7,k)+msx
252 fstparit(8,k)=fstparit(8,k)+msy
253 fstparit(9,k)=fstparit(9,k)+msz
254 fstparit(10,k)=fstparit(10,k) +
255 . ( xx4*(fsnx+fstx) +
256 . yy4*(fsny+fsty) +
257 . zz4*(fsnz+fstz) )
258 fstparit(11,k)=fstparit(11,k) +
259 . ( xx5*(fsnx+fstx) +
260 . yy5*(fsny+fsty) +
261 . zz5*(fsnz+fstz) )
262 fstparit(12,k)=fstparit(12,k) +
263 . ( xx6*(fsnx+fstx) +
264 . yy6*(fsny+fsty) +
265 . zz6*(fsnz+fstz) )
266 ENDIF
267 ENDDO
268 ENDDO
269C
270 CALL sum_6_float_sect(fstparit,12,nsa,1,nsa,fbsav6,12,6)
271C
272 DEALLOCATE(fstparit)
273 ENDIF
274C
275#include "lockon.inc"
276 fsav(1)=fsav(1)+dt12*fst(1)
277 fsav(2)=fsav(2)+dt12*fst(2)
278 fsav(3)=fsav(3)+dt12*fst(3)
279 fsav(4)=fsav(4)+dt12*fst(4)
280 fsav(5)=fsav(5)+dt12*fst(5)
281 fsav(6)=fsav(6)+dt12*fst(6)
282 fsav(7)=fsav(7)+dt12*fst(7)
283 fsav(8)=fsav(8)+dt12*fst(8)
284 fsav(9)=fsav(9)+dt12*fst(9)
285 fsav(10)=fsav(10)+dt12*fst(16)
286 fsav(31)=fsav(31)+dt12*fst(13)
287 fsav(32)=fsav(32)+dt12*fst(14)
288 fsav(33)=fsav(33)+dt12*fst(15)
289 fsav(34)=fsav(34) + dt12* (xx4*(fst(1)+fst(4)) +
290 . yy4*(fst(2)+fst(5)) + zz4*(fst(3)+fst(6)))
291 fsav(35)=fsav(35) + dt12* (xx5*(fst(1)+fst(4)) +
292 . yy5*(fst(2)+fst(5)) + zz5*(fst(3)+fst(6)))
293 fsav(36)=fsav(36) + dt12* (xx6*(fst(1)+fst(4)) +
294 . yy6*(fst(2)+fst(5)) + zz6*(fst(3)+fst(6)))
295 fsav(37)=xxc
296 fsav(38)=yyc
297 fsav(39)=zzc
298 fopta(1) = fopta(1) + fst(10)
299 fopta(2) = fopta(2) + fst(11)
300 fopta(3) = fopta(3) + fst(12)
301 fopta(4) = fopta(4) + fst(13)
302 fopta(5) = fopta(5) + fst(14)
303 fopta(6) = fopta(6) + fst(15)
304#include "lockoff.inc"
305C
306 ELSE
307C
308#include "lockon.inc"
309 DO i1 = 1,2
310 DO k=1,nsa
311 j = jjj(k)
312 i = nstrf(1,j)-nft
313 ipack = nstrf(2,j)
314 IF(unpack(ipack,i1)/=0)THEN
315 n = ixt(i1+1,nstrf(1,j))
316 secfcum(1,n)=secfcum(1,n)+fx(i,i1)
317 secfcum(2,n)=secfcum(2,n)+fy(i,i1)
318 secfcum(3,n)=secfcum(3,n)+fz(i,i1)
319 ENDIF
320 ENDDO
321 ENDDO
322#include "lockoff.inc"
323 ENDIF
324C
325 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