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