OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
section_3n.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_3n ../engine/source/tools/sect/section_3n.F
25!||--- called by ------------------------------------------------------
26!|| forintc ../engine/source/elements/forintc.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!||====================================================================
32 SUBROUTINE section_3n (LFT,LLT,NFT,NSEG,N1,
33 2 N2,N3,NSTRF,X,V,VR,FSAV,
34 3 IXTG, FOPTA,SECFCUM,
35 4 FX,FY,FZ,MX,MY,MZ,
36 5 TYPE,NSINT,IFRAM,NNOD,NOD,MS,
37 7 XSEC,FBSAV6,IPARSENS)
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"
53#include "scr06_c.inc"
54C-----------------------------------------------
55C D u m m y A r g u m e n t s
56C-----------------------------------------------
57 INTEGER LFT, LLT, NFT, NSEG, N1, N2, N3,
58 4 TYPE,NSINT,IPARSENS
59 INTEGER NSTRF(2,*),IXTG(NIXTG,*),IFRAM,NNOD,NOD(*)
60 my_real
61 . X(3,*), FSAV(NTHVKI), FOPTA(6), SECFCUM(7,*),
62 . fx(mvsiz,3), fy(mvsiz,3), fz(mvsiz,3), mx(mvsiz,3),
63 . my(mvsiz,3), mz(mvsiz,3),
64 . v(3,*), vr(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(0:7,3),
70 . nsa, j, i, k, i1, i2, ipack, n, jj
71 my_real
72 . fx1(mvsiz), fy1(mvsiz), fz1(mvsiz),
73 . mx1(mvsiz), my1(mvsiz), mz1(mvsiz), 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 . d13, xxc, yyc, zzc, fsx, fsy, fsz, fn, fsnx, fsny, fsnz, fstx,
78 . fsty, fstz, dmx, dmy, dmz
79 my_real
80 . msxphi, msyphi, mszphi, fsxphi,
81 . fsyphi, fszphi, fnphi, fsnxphi, fsnyphi, fsnzphi, fstxphi,
82 . fstyphi, fstzphi, dmxphi, dmyphi, dmzphi
83 my_real
84 . xx1phi,xx3phi,xx4phi,xx5phi,xx6phi
85 my_real
86 . yy1phi,yy3phi,yy4phi,yy5phi,yy6phi
87 my_real
88 . zz1phi,zz3phi,zz4phi,zz5phi,zz6phi
89 my_real
90 . al4phi,al5phi,al6phi,xx5t,yy5t,zz5t
91 my_real
92 . al4,al5,al6
93 my_real, DIMENSION(:,:), ALLOCATABLE :: fstparit
94C-----------------------------------------------
95 DATA unpack/0,1,0,1,0,1,0,1,
96 . 0,0,1,1,0,0,1,1,
97 . 0,0,0,0,1,1,1,1/
98C
99 IF(nseg==0)RETURN
100 IF(lft+nft>nstrf(1,nseg))RETURN
101 IF(llt+nft<nstrf(1,1 ))RETURN
102C---------------------------------------------------------
103 nsa=0
104C
105 DO 20 j=1,nseg
106 i=nstrf(1,j)-nft
107 IF (lft>i) GOTO 20
108 IF (llt<i) GOTO 30
109 nsa=nsa+1
110 jjj(nsa)=j
111 20 CONTINUE
112 30 CONTINUE
113C
114 IF(nsa==0)RETURN
115C
116 IF(type+nsint==0)THEN
117C
118 DO i=1,16
119 fst(i)=zero
120 ENDDO
121C
122 IF(iparsens/=0) THEN
123 ALLOCATE(fstparit(12,nsa))
124 DO j=1,nsa
125 DO i=1,12
126 fstparit(i,j) = zero
127 ENDDO
128 ENDDO
129 ENDIF
130C
131 IF(nspmd==1) THEN
132 CALL section_skew(n1 ,n2 ,n3 ,x , xxc, yyc, zzc,
133 2 xx4, yy4, zz4, xx5, yy5, zz5, xx6, yy6, zz6,
134 3 xxn, yyn, zzn,ifram,nnod,nod,ms)
135 ELSE
136 CALL section_skewp(xxc, yyc, zzc, xx4 , yy4 , zz4 ,
137 2 xx5, yy5, zz5, xx6 , yy6 , zz6 ,
138 3 xxn, yyn, zzn, ifram, n1 , xsec)
139 END IF
140C
141 IF(iparsens==0) THEN ! Parith/Off
142 DO k=1,nsa
143 j = jjj(k)
144 i = nstrf(1,j)-nft
145 ipack = nstrf(2,j)
146 DO i1 = 1,3
147 IF(unpack(ipack,i1)/=0)THEN
148 fx1(k)=fx(i,i1)
149 fy1(k)=fy(i,i1)
150 fz1(k)=fz(i,i1)
151C
152 mx1(k)=mx(i,i1)
153 my1(k)=my(i,i1)
154 mz1(k)=mz(i,i1)
155C
156 n = ixtg(i1+1,nstrf(1,j))
157 dx1(k)=x(1,n)
158 dy1(k)=x(2,n)
159 dz1(k)=x(3,n)
160C
161 fsx=fx1(k)
162 fsy=fy1(k)
163 fsz=fz1(k)
164C
165 fn=fsx*xxn+fsy*yyn+fsz*zzn
166 fsnx=fn*xxn
167 fsny=fn*yyn
168 fsnz=fn*zzn
169 fstx=fsx-fsnx
170 fsty=fsy-fsny
171 fstz=fsz-fsnz
172C
173 dx1(k)=dx1(k)-xxc
174 dy1(k)=dy1(k)-yyc
175 dz1(k)=dz1(k)-zzc
176C
177 msx =dy1(k)*fz1(k)-dz1(k)*fy1(k)
178 msy =dz1(k)*fx1(k)-dx1(k)*fz1(k)
179 msz =dx1(k)*fy1(k)-dy1(k)*fx1(k)
180C
181 msx =msx+mx1(k)
182 msy =msy+my1(k)
183 msz =msz+mz1(k)
184C
185 dmx =msx*xx4+msy*yy4+msz*zz4
186 dmy =msx*xx5+msy*yy5+msz*zz5
187 dmz =msx*xx6+msy*yy6+msz*zz6
188C
189 fst(1)=fst(1)+fsnx
190 fst(2)=fst(2)+fsny
191 fst(3)=fst(3)+fsnz
192 fst(4)=fst(4)+fstx
193 fst(5)=fst(5)+fsty
194 fst(6)=fst(6)+fstz
195 fst(7)=fst(7)+dmx
196 fst(8)=fst(8)+dmy
197 fst(9)=fst(9)+dmz
198 fst(10) = fst(10) + fsx
199 fst(11) = fst(11) + fsy
200 fst(12) = fst(12) + fsz
201 fst(13) = fst(13) + msx
202 fst(14) = fst(14) + msy
203 fst(15) = fst(15) + msz
204 fst(16)=fst(16)
205 . +fx1(k)*v(1,n) +fy1(k)*v(2,n) +fz1(k)*v(3,n)
206 . +mx1(k)*vr(1,n)+my1(k)*vr(2,n)+mz1(k)*vr(3,n)
207C
208 ENDIF
209 ENDDO
210 ENDDO
211 ELSE ! Parith/on
212 DO k=1,nsa
213 j = jjj(k)
214 i = nstrf(1,j)-nft
215 ipack = nstrf(2,j)
216 DO i1 = 1,3
217 IF(unpack(ipack,i1)/=0)THEN
218 fx1(k)=fx(i,i1)
219 fy1(k)=fy(i,i1)
220 fz1(k)=fz(i,i1)
221C
222 mx1(k)=mx(i,i1)
223 my1(k)=my(i,i1)
224 mz1(k)=mz(i,i1)
225C
226 n = ixtg(i1+1,nstrf(1,j))
227 dx1(k)=x(1,n)
228 dy1(k)=x(2,n)
229 dz1(k)=x(3,n)
230C
231 fsx=fx1(k)
232 fsy=fy1(k)
233 fsz=fz1(k)
234C
235 fn=fsx*xxn+fsy*yyn+fsz*zzn
236 fsnx=fn*xxn
237 fsny=fn*yyn
238 fsnz=fn*zzn
239 fstx=fsx-fsnx
240 fsty=fsy-fsny
241 fstz=fsz-fsnz
242C
243 dx1(k)=dx1(k)-xxc
244 dy1(k)=dy1(k)-yyc
245 dz1(k)=dz1(k)-zzc
246C
247 msx =dy1(k)*fz1(k)-dz1(k)*fy1(k)
248 msy =dz1(k)*fx1(k)-dx1(k)*fz1(k)
249 msz =dx1(k)*fy1(k)-dy1(k)*fx1(k)
250C
251 msx =msx+mx1(k)
252 msy =msy+my1(k)
253 msz =msz+mz1(k)
254C
255 dmx =msx*xx4+msy*yy4+msz*zz4
256 dmy =msx*xx5+msy*yy5+msz*zz5
257 dmz =msx*xx6+msy*yy6+msz*zz6
258C
259 fst(1)=fst(1)+fsnx
260 fst(2)=fst(2)+fsny
261 fst(3)=fst(3)+fsnz
262 fst(4)=fst(4)+fstx
263 fst(5)=fst(5)+fsty
264 fst(6)=fst(6)+fstz
265 fst(7)=fst(7)+dmx
266 fst(8)=fst(8)+dmy
267 fst(9)=fst(9)+dmz
268 fst(10) = fst(10) + fsx
269 fst(11) = fst(11) + fsy
270 fst(12) = fst(12) + fsz
271 fst(13) = fst(13) + msx
272 fst(14) = fst(14) + msy
273 fst(15) = fst(15) + msz
274 fst(16)=fst(16)
275 . +fx1(k)*v(1,n) +fy1(k)*v(2,n) +fz1(k)*v(3,n)
276 . +mx1(k)*vr(1,n)+my1(k)*vr(2,n)+mz1(k)*vr(3,n)
277C
278 fstparit(1,k)=fstparit(1,k)+fsnx
279 fstparit(2,k)=fstparit(2,k)+fsny
280 fstparit(3,k)=fstparit(3,k)+fsnz
281 fstparit(4,k)=fstparit(4,k)+fstx
282 fstparit(5,k)=fstparit(5,k)+fsty
283 fstparit(6,k)=fstparit(6,k)+fstz
284 fstparit(7,k)=fstparit(7,k)+msx
285 fstparit(8,k)=fstparit(8,k)+msy
286 fstparit(9,k)=fstparit(9,k)+msz
287 fstparit(10,k)=fstparit(10,k) +
288 . ( xx4*(fsnx+fstx) +
289 . yy4*(fsny+fsty) +
290 . zz4*(fsnz+fstz) )
291 fstparit(11,k)=fstparit(11,k) +
292 . ( xx5*(fsnx+fstx) +
293 . yy5*(fsny+fsty) +
294 . zz5*(fsnz+fstz) )
295 fstparit(12,k)=fstparit(12,k) +
296 . ( xx6*(fsnx+fstx) +
297 . yy6*(fsny+fsty) +
298 . zz6*(fsnz+fstz) )
299 ENDIF
300 ENDDO
301 ENDDO
302C
303 CALL sum_6_float_sect(fstparit,12,nsa,1,nsa,fbsav6,12,6)
304C
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,3
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 = ixtg(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 IF((nsa/=0).AND.(iparsens/=0)) THEN
361 DEALLOCATE(fstparit)
362 ENDIF
363C
364 RETURN
365 END
forintc
subroutine forintc(timers, pm, geo, x, a, ar, v, vr, ms, in, nloc_dmg, wa, stifn, stifr, fsky, crksky, tf, bufmat, partsav, d, mat_elem, dr, eani, tani, fani, fsav, sensors, skew, anin, failwave, dt2t, thke, bufgeo, iadc, iadtg, iparg, npc, ixc, ixtg, neltst, ipari, ityptst, nstrf, ipart, ipartc, iparttg, secfcum, fsavd, group_param_tab, fzero, ixtg1, iadtg1, igeo, ipm, madfail, xsec, itask, mcp, temp, fthe, fthesky, ms_ply, zi_ply, inod_pxfem, xedge4n, xedge3n, iel_pxfem, iadc_pxfem, igrouc, ngrouc, gresav, grth, igrth, mstg, dmeltg, msc, dmelc, table, knod2elc, ptg, msz2, inod_crk, iel_crk, iadc_crk, elcutc, nodenr, ibordnode, nodedge, crknodiad, elbuf_tab, xfem_tab, condn, condnsky, crkedge, stack, itab, glob_therm, drape_sh4n, drape_sh3n, subset, xdp, vpinch, apinch, stifpinch, drapeg, output, dt, snpc, stf, userl_avail, maxfunc, sbufmat)
Definition forintc.F:89
sum_6_float_sect
subroutine sum_6_float_sect(f, a, b, jft, jlt, f6, d, e)
Definition parit.F:699
section_3n
subroutine section_3n(lft, llt, nft, nseg, n1, n2, n3, nstrf, x, v, vr, fsav, ixtg, fopta, secfcum, fx, fy, fz, mx, my, mz, type, nsint, ifram, nnod, nod, ms, xsec, fbsav6, iparsens)
Definition section_3n.F:38
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