OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
section_r.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| section_r ../engine/source/tools/sect/section_r.F
25!||--- called by ------------------------------------------------------
26!|| forint ../engine/source/elements/forint.F
27!||--- calls -----------------------------------------------------
28!|| section_skew ../engine/source/tools/sect/section_skew.F
29!|| section_skewp ../engine/source/tools/sect/section_skewp.F
30!|| sum_6_float_sect ../engine/source/system/parit.F
31!||--- uses -----------------------------------------------------
32!|| element_mod ../common_source/modules/elements/element_mod.F90
33!||====================================================================
34 SUBROUTINE section_r (LFT,LLT,NFT,NSEG,N1,
35 2 N2,N3,NSTRF,X,V,VR,FSAV,
36 3 IXR, FOPTA,SECFCUM,
37 4 FX,FY,FZ,MX,MY,MZ,
38 5 ITYPE,NSINT,IFRAM,NNOD,NOD,MS,
39 7 XSEC,FBSAV6,IPARSENS)
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
350 END
sum_6_float_sect
subroutine sum_6_float_sect(f, a, b, jft, jlt, f6, d, e)
Definition parit.F:699
section_r
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)
Definition section_r.F:40
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