OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sdlen8.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!|| sdlen8 ../engine/source/elements/solid/solidez/sdlen8.F
25!||--- called by ------------------------------------------------------
26!|| s20forc3 ../engine/source/elements/solid/solide20/s20forc3.F
27!|| szforc3 ../engine/source/elements/solid/solidez/szforc3.F
28!||--- calls -----------------------------------------------------
29!|| basisf ../engine/source/elements/solid/solide8/basisf.F
30!|| sdlen_dege ../engine/source/elements/solid/solide/sdlen_dege.F
31!||====================================================================
32 SUBROUTINE sdlen8(
33 1 DELTAX, VOLG, IXS, X1,
34 2 X2, X3, X4, X5,
35 3 X6, X7, X8, Y1,
36 4 Y2, Y3, Y4, Y5,
37 5 Y6, Y7, Y8, Z1,
38 6 Z2, Z3, Z4, Z5,
39 7 Z6, Z7, Z8, NEL)
40C-----------------------------------------------
41C I m p l i c i t T y p e s
42C-----------------------------------------------
43#include "implicit_f.inc"
44C-----------------------------------------------
45C G l o b a l P a r a m e t e r s
46C-----------------------------------------------
47#include "mvsiz_p.inc"
48C-----------------------------------------------
49C D u m m y A r g u m e n t s
50C-----------------------------------------------
51 INTEGER, INTENT(IN) :: NEL
52 INTEGER IXS(NIXS,*)
53C REAL
54 my_real
55 . DELTAX(*),VOLG(*),
56 . X1(*), X2(*), X3(*), X4(*), X5(*), X6(*), X7(*), X8(*),
57 . Y1(*), Y2(*), Y3(*), Y4(*), Y5(*), Y6(*), Y7(*), Y8(*),
58 . z1(*), z2(*), z3(*), z4(*), z5(*), z6(*), z7(*), z8(*)
59C-----------------------------------------------
60C C o m m o n B l o c k s
61C-----------------------------------------------
62#include "scr17_c.inc"
63C-----------------------------------------------
64C L o c a l V a r i a b l e s
65C-----------------------------------------------
66 INTEGER I, J, IPT, IDEGE(MVSIZ)
67C REAL
68 my_real
69 . AJ11, AJ12, AJ13, AJ21,
70 . AJ22, AJ23, AJ31, AJ32,
71 . AJ33, AI11, AI12, AI13,
72 . AI21, AI22, AI23, AI31,
73 . ai32, ai33
74C REAL
75 my_real
76 . x12(mvsiz), x34(mvsiz), x56(mvsiz),
77 . x78(mvsiz), y12(mvsiz), y34(mvsiz), y56(mvsiz), y78(mvsiz),
78 . z12(mvsiz), z34(mvsiz), z56(mvsiz), z78(mvsiz), x14(mvsiz),
79 . x23(mvsiz), x58(mvsiz), x67(mvsiz), y14(mvsiz), y23(mvsiz),
80 . y58(mvsiz), y67(mvsiz), z14(mvsiz), z23(mvsiz), z58(mvsiz),
81 . z67(mvsiz), x15(mvsiz), x26(mvsiz), x37(mvsiz), x48(mvsiz),
82 . y15(mvsiz), y26(mvsiz), y37(mvsiz), y48(mvsiz), z15(mvsiz),
83 . z26(mvsiz), z37(mvsiz), z48(mvsiz), h(8), vlinv,
84 . delta1,delta2,delta3,
85 . spx1,spx2,spx3,spx4,spx5,spx6,spx7,spx8,
86 . spy1,spy2,spy3,spy4,spy5,spy6,spy7,spy8,
87 . spz1,spz2,spz3,spz4,spz5,spz6,spz7,spz8,
88 . xx1,yy1,zz1,xx2,yy2,zz2,xx3,yy3,zz3,smax(mvsiz),vmin,
89 . p1(8), p2(8), p3(8),vlinc(mvsiz,8)
90C-----------------------------------------------
91C
92 IF (idts6>0) THEN
93 CALL sdlen_dege(
94 1 volg, deltax, x1, x2,
95 2 x3, x4, x5, x6,
96 3 x7, x8, y1, y2,
97 4 y3, y4, y5, y6,
98 5 y7, y8, z1, z2,
99 6 z3, z4, z5, z6,
100 7 z7, z8, ixs, idege,
101 8 nel)
102 ELSE
103 idege(1:nel)=0
104 END IF
105C
106 DO i=1,nel
107 x12(i)=x1(i)-x2(i)
108 y12(i)=y1(i)-y2(i)
109 z12(i)=z1(i)-z2(i)
110 x34(i)=x3(i)-x4(i)
111 y34(i)=y3(i)-y4(i)
112 z34(i)=z3(i)-z4(i)
113 x56(i)=x5(i)-x6(i)
114 y56(i)=y5(i)-y6(i)
115 z56(i)=z5(i)-z6(i)
116 x78(i)=x7(i)-x8(i)
117 y78(i)=y7(i)-y8(i)
118 z78(i)=z7(i)-z8(i)
119 x14(i)=x1(i)-x4(i)
120 y14(i)=y1(i)-y4(i)
121 z14(i)=z1(i)-z4(i)
122 x23(i)=x2(i)-x3(i)
123 y23(i)=y2(i)-y3(i)
124 z23(i)=z2(i)-z3(i)
125 x58(i)=x5(i)-x8(i)
126 y58(i)=y5(i)-y8(i)
127 z58(i)=z5(i)-z8(i)
128 x67(i)=x6(i)-x7(i)
129 y67(i)=y6(i)-y7(i)
130 z67(i)=z6(i)-z7(i)
131 x15(i)=x1(i)-x5(i)
132 y15(i)=y1(i)-y5(i)
133 z15(i)=z1(i)-z5(i)
134 x26(i)=x2(i)-x6(i)
135 y26(i)=y2(i)-y6(i)
136 z26(i)=z2(i)-z6(i)
137 x37(i)=x3(i)-x7(i)
138 y37(i)=y3(i)-y7(i)
139 z37(i)=z3(i)-z7(i)
140 x48(i)=x4(i)-x8(i)
141 y48(i)=y4(i)-y8(i)
142 z48(i)=z4(i)-z8(i)
143 END DO
144C
145 DO ipt=1,8
146 CALL basisf (h,p1,p2,p3,ipt)
147C
148 DO i=1,nel
149 aj11=p1(1)*x12(i)+p1(3)*x34(i)+p1(5)*x56(i)+p1(7)*x78(i)
150 aj12=p1(1)*y12(i)+p1(3)*y34(i)+p1(5)*y56(i)+p1(7)*y78(i)
151 aj13=p1(1)*z12(i)+p1(3)*z34(i)+p1(5)*z56(i)+p1(7)*z78(i)
152 aj21=p2(1)*x14(i)+p2(2)*x23(i)+p2(5)*x58(i)+p2(6)*x67(i)
153 aj22=p2(1)*y14(i)+p2(2)*y23(i)+p2(5)*y58(i)+p2(6)*y67(i)
154 aj23=p2(1)*z14(i)+p2(2)*z23(i)+p2(5)*z58(i)+p2(6)*z67(i)
155 aj31=p3(1)*x15(i)+p3(2)*x26(i)+p3(3)*x37(i)+p3(4)*x48(i)
156 aj32=p3(1)*y15(i)+p3(2)*y26(i)+p3(3)*y37(i)+p3(4)*y48(i)
157 aj33=p3(1)*z15(i)+p3(2)*z26(i)+p3(3)*z37(i)+p3(4)*z48(i)
158
159 ai11= aj22*aj33-aj23*aj32
160 ai21=-aj21*aj33+aj23*aj31
161 ai31= aj21*aj32-aj22*aj31
162 vlinc(i,ipt)=aj11*ai11+aj12*ai21+aj13*ai31
163 ENDDO
164 END DO ! IPT=1,8
165C
166 DO i=1,nel
167c mediane * 4
168 xx1 = x1(i) + x2(i) + x3(i) + x4(i)
169 . - x5(i) - x6(i) - x7(i) - x8(i)
170 yy1 = y1(i) + y2(i) + y3(i) + y4(i)
171 . - y5(i) - y6(i) - y7(i) - y8(i)
172 zz1 = z1(i) + z2(i) + z3(i) + z4(i)
173 . - z5(i) - z6(i) - z7(i) - z8(i)
174 xx2 = x1(i) + x2(i) + x5(i) + x6(i)
175 . - x3(i) - x4(i) - x7(i) - x8(i)
176 yy2 = y1(i) + y2(i) + y5(i) + y6(i)
177 . - y3(i) - y4(i) - y7(i) - y8(i)
178 zz2 = z1(i) + z2(i) + z5(i) + z6(i)
179 . - z3(i) - z4(i) - z7(i) - z8(i)
180 xx3 = x1(i) + x4(i) + x5(i) + x8(i)
181 . - x3(i) - x2(i) - x7(i) - x6(i)
182 yy3 = y1(i) + y4(i) + y5(i) + y8(i)
183 . - y3(i) - y2(i) - y7(i) - y6(i)
184 zz3 = z1(i) + z4(i) + z5(i) + z8(i)
185 . - z3(i) - z2(i) - z7(i) - z6(i)
186C surface * 16
187 smax(i) = (yy1 * zz2 - yy2 * zz1)**2
188 . + (zz1 * xx2 - zz2 * xx1)**2
189 . + (xx1 * yy2 - xx2 * yy1)**2
190 smax(i) = max(smax(i),(yy1 * zz3 - yy3 * zz1)**2
191 . + (zz1 * xx3 - zz3 * xx1)**2
192 . + (xx1 * yy3 - xx3 * yy1)**2)
193 smax(i) = max(smax(i),(yy3 * zz2 - yy2 * zz3)**2
194 . + (zz3 * xx2 - zz2 * xx3)**2
195 . + (xx3 * yy2 - xx2 * yy3)**2)
196 ENDDO
197C volume / 8
198 IF (idts6>0) THEN
199 DO i=1,nel
200 IF(idege(i)==0)THEN
201 vmin = min(vlinc(i,1),vlinc(i,2),vlinc(i,3),vlinc(i,4),
202 . vlinc(i,5),vlinc(i,6),vlinc(i,7),vlinc(i,8))
203C
204 deltax(i)=hundred28*vmin/sqrt(smax(i))
205 ENDIF
206 ENDDO
207 ELSE
208 DO i=1,nel
209 vmin = min(vlinc(i,1),vlinc(i,2),vlinc(i,3),vlinc(i,4),
210 . vlinc(i,5),vlinc(i,6),vlinc(i,7),vlinc(i,8))
211C
212 deltax(i)=hundred28*vmin/sqrt(smax(i))
213 ENDDO
214 ENDIF
215
216
217C-----------
218 RETURN
219 END
#define min(a, b)
Definition macros.h:20
#define max(a, b)
Definition macros.h:21
subroutine sdlen8(deltax, volg, ixs, x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, nel)
Definition sdlen8.F:40
subroutine sdlen_dege(volg, lat, x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, ixs, idege, nel)
Definition sdlen_dege.F:45
subroutine basisf(h, p1, p2, p3, ipt)
Definition basisf.F:32