OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
s8ederict3.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!|| s8ederict3 ../engine/source/elements/solid/solide8e/s8ederict3.F
25!||--- called by ------------------------------------------------------
26!|| s8eforc3 ../engine/source/elements/solid/solide8e/s8eforc3.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../engine/source/output/message/message.F
29!|| arret ../engine/source/system/arret.F
30!|| schkjab3 ../engine/source/elements/solid/solide/schkjab3.F
31!||--- uses -----------------------------------------------------
32!|| message_mod ../engine/share/message_module/message_mod.F
33!||====================================================================
34 SUBROUTINE s8ederict3(
35 1 OFF, DET, NGL, 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, PX1,
42 8 PX2, PX3, PX4, PY1,
43 9 PY2, PY3, PY4, PZ1,
44 A PZ2, PZ3, PZ4, HX,
45 B HY, HZ, AJ1, AJ2,
46 C AJ3, AJ4, AJ5, AJ6,
47 D AJ7, AJ8, AJ9, SMAX,
48 E NEL)
49C-----------------------------------------------
50C M o d u l e s
51C-----------------------------------------------
52 USE message_mod
53C-----------------------------------------------
54C I m p l i c i t T y p e s
55C-----------------------------------------------
56#include "implicit_f.inc"
57#include "comlock.inc"
58C-----------------------------------------------
59C G l o b a l P a r a m e t e r s
60C-----------------------------------------------
61#include "mvsiz_p.inc"
62C-----------------------------------------------
63C C o m m o n B l o c k s
64C-----------------------------------------------
65C-----------------------------------------------
66C D u m m y A r g u m e n t s
67C-----------------------------------------------
68 INTEGER, INTENT(IN) :: NEL
69 DOUBLE PRECISION X1(*), X2(*), X3(*), X4(*), X5(*), X6(*), X7(*), X8(*),
70 . Y1(*), Y2(*), Y3(*), Y4(*), Y5(*), Y6(*), Y7(*), Y8(*),
71 . Z1(*), Z2(*), Z3(*), Z4(*), Z5(*), Z6(*), Z7(*), Z8(*)
72 my_real OFF(*),DET(*),
73 . PX1(*), PX2(*), PX3(*), PX4(*),
74 . PY1(*), PY2(*), PY3(*), PY4(*),
75 . PZ1(*), PZ2(*), PZ3(*), PZ4(*),
76 . HX(MVSIZ,4), HY(MVSIZ,4), HZ(MVSIZ,4),
77 . AJ1(*),AJ2(*),AJ3(*),
78 . AJ4(*),AJ5(*),AJ6(*),
79 . AJ7(*),AJ8(*),AJ9(*),SMAX(*)
80C-----------------------------------------------
81C L o c a l V a r i a b l e s
82C-----------------------------------------------
83 INTEGER NGL(*), I, J ,ICOR
84C 12
85 my_real DETT(MVSIZ) ,
86 . aji1(mvsiz), aji2(mvsiz), aji3(mvsiz),
87 . aji4(mvsiz), aji5(mvsiz), aji6(mvsiz),
88 . aji7(mvsiz), aji8(mvsiz), aji9(mvsiz),
89 . x17(mvsiz) , x28(mvsiz) , x35(mvsiz) , x46(mvsiz),
90 . y17(mvsiz) , y28(mvsiz) , y35(mvsiz) , y46(mvsiz),
91 . z17(mvsiz) , z28(mvsiz) , z35(mvsiz) , z46(mvsiz),
92 . jac_59_68(mvsiz), jac_67_49(mvsiz), jac_48_57(mvsiz),
93 . jac_38_29(mvsiz), jac_19_37(mvsiz), jac_27_18(mvsiz),
94 . jac_26_35(mvsiz), jac_34_16(mvsiz), jac_15_24(mvsiz),
95 . aj12(mvsiz), aj45(mvsiz), aj78(mvsiz),
96 . a17(mvsiz) , a28(mvsiz) ,
97 . b17(mvsiz) , b28(mvsiz) ,
98 . c17(mvsiz) , c28(mvsiz)
99C-----------------------------------------------
100 DO i=1,nel
101 x17(i)=x7(i)-x1(i)
102 x28(i)=x8(i)-x2(i)
103 x35(i)=x5(i)-x3(i)
104 x46(i)=x6(i)-x4(i)
105 y17(i)=y7(i)-y1(i)
106 y28(i)=y8(i)-y2(i)
107 y35(i)=y5(i)-y3(i)
108 y46(i)=y6(i)-y4(i)
109 z17(i)=z7(i)-z1(i)
110 z28(i)=z8(i)-z2(i)
111 z35(i)=z5(i)-z3(i)
112 z46(i)=z6(i)-z4(i)
113 ENDDO
114C
115 DO i=1,nel
116 aj4(i)=x17(i)+x28(i)-x35(i)-x46(i)
117 aj5(i)=y17(i)+y28(i)-y35(i)-y46(i)
118 aj6(i)=z17(i)+z28(i)-z35(i)-z46(i)
119 a17(i)=x17(i)+x46(i)
120 a28(i)=x28(i)+x35(i)
121 b17(i)=y17(i)+y46(i)
122 b28(i)=y28(i)+y35(i)
123 c17(i)=z17(i)+z46(i)
124 c28(i)=z28(i)+z35(i)
125 ENDDO
126 DO i=1,nel
127 aj7(i)=a17(i)+a28(i)
128 aj8(i)=b17(i)+b28(i)
129 aj9(i)=c17(i)+c28(i)
130 aj1(i)=a17(i)-a28(i)
131 aj2(i)=b17(i)-b28(i)
132 aj3(i)=c17(i)-c28(i)
133 ENDDO
134C
135C JACOBIAN
136C
137 DO i=1,nel
138 jac_59_68(i)=aj5(i)*aj9(i)-aj6(i)*aj8(i)
139 jac_67_49(i)=aj6(i)*aj7(i)-aj4(i)*aj9(i)
140 jac_38_29(i)=(-aj2(i)*aj9(i)+aj3(i)*aj8(i))
141 jac_19_37(i)=( aj1(i)*aj9(i)-aj3(i)*aj7(i))
142 jac_27_18(i)=(-aj1(i)*aj8(i)+aj2(i)*aj7(i))
143 jac_26_35(i)=( aj2(i)*aj6(i)-aj3(i)*aj5(i))
144 jac_34_16(i)=(-aj1(i)*aj6(i)+aj3(i)*aj4(i))
145 jac_15_24(i)=( aj1(i)*aj5(i)-aj2(i)*aj4(i))
146 jac_48_57(i)=aj4(i)*aj8(i)-aj5(i)*aj7(i)
147 ENDDO
148C
149 DO i=1,nel
150 det(i)=one_over_64*(aj1(i)*jac_59_68(i)+aj2(i)*jac_67_49(i)+aj3(i)*jac_48_57(i))
151 ENDDO
152C
153 CALL schkjab3(off, det, ngl, nel)
154C
155 DO i=1,nel
156 dett(i)=one_over_64/det(i)
157 ENDDO
158C
159C INVERSE DE LA MATRICE JACOBIENNE
160C
161 DO i=1,nel
162 aji1(i)=dett(i)*jac_59_68(i)
163 aji4(i)=dett(i)*jac_67_49(i)
164 aji7(i)=dett(i)*jac_48_57(i)
165 aji2(i)=dett(i)*jac_38_29(i)
166 aji5(i)=dett(i)*jac_19_37(i)
167 aji8(i)=dett(i)*jac_27_18(i)
168 aji3(i)=dett(i)*jac_26_35(i)
169 aji6(i)=dett(i)*jac_34_16(i)
170 aji9(i)=dett(i)*jac_15_24(i)
171 ENDDO
172C
173 DO i=1,nel
174 aj12(i)=aji1(i)-aji2(i)
175 aj45(i)=aji4(i)-aji5(i)
176 aj78(i)=aji7(i)-aji8(i)
177 ENDDO
178 DO i=1,nel
179 px2(i)= aj12(i)-aji3(i)
180 py2(i)= aj45(i)-aji6(i)
181 pz2(i)= aj78(i)-aji9(i)
182 px4(i)=-aj12(i)-aji3(i)
183 py4(i)=-aj45(i)-aji6(i)
184 pz4(i)=-aj78(i)-aji9(i)
185 ENDDO
186 DO i=1,nel
187 aj12(i)=aji1(i)+aji2(i)
188 aj45(i)=aji4(i)+aji5(i)
189 aj78(i)=aji7(i)+aji8(i)
190 ENDDO
191 DO i=1,nel
192 px1(i)=-aj12(i)-aji3(i)
193 py1(i)=-aj45(i)-aji6(i)
194 pz1(i)=-aj78(i)-aji9(i)
195 px3(i)=aj12(i)-aji3(i)
196 py3(i)=aj45(i)-aji6(i)
197 pz3(i)=aj78(i)-aji9(i)
198 ENDDO
199C
200C mode 1
201C 1 1 -1 -1 -1 -1 1 1
202 DO i=1,nel
203 hx(i,1)=(x1(i)+x2(i)-x3(i)-x4(i)-x5(i)-x6(i)+x7(i)+x8(i))
204 hy(i,1)=(y1(i)+y2(i)-y3(i)-y4(i)-y5(i)-y6(i)+y7(i)+y8(i))
205 hz(i,1)=(z1(i)+z2(i)-z3(i)-z4(i)-z5(i)-z6(i)+z7(i)+z8(i))
206 ENDDO
207C mode 2
208C 1 -1 -1 1 -1 1 1 -1
209 DO i=1,nel
210 hx(i,2)=(x1(i)-x2(i)-x3(i)+x4(i)-x5(i)+x6(i)+x7(i)-x8(i))
211 hy(i,2)=(y1(i)-y2(i)-y3(i)+y4(i)-y5(i)+y6(i)+y7(i)-y8(i))
212 hz(i,2)=(z1(i)-z2(i)-z3(i)+z4(i)-z5(i)+z6(i)+z7(i)-z8(i))
213 ENDDO
214C mode 3
215C 1 -1 1 -1 1 -1 1 -1
216 DO i=1,nel
217 hx(i,3)=(x1(i)-x2(i)+x3(i)-x4(i)+x5(i)-x6(i)+x7(i)-x8(i))
218 hy(i,3)=(y1(i)-y2(i)+y3(i)-y4(i)+y5(i)-y6(i)+y7(i)-y8(i))
219 hz(i,3)=(z1(i)-z2(i)+z3(i)-z4(i)+z5(i)-z6(i)+z7(i)-z8(i))
220 ENDDO
221C mode 4
222C -1 1 -1 1 1 -1 1 -1
223 DO i=1,nel
224 hx(i,4)=(-x1(i)+x2(i)-x3(i)+x4(i)+x5(i)-x6(i)+x7(i)-x8(i))
225 hy(i,4)=(-y1(i)+y2(i)-y3(i)+y4(i)+y5(i)-y6(i)+y7(i)-y8(i))
226 hz(i,4)=(-z1(i)+z2(i)-z3(i)+z4(i)+z5(i)-z6(i)+z7(i)-z8(i))
227 ENDDO
228C
229C----surface max mediane-- *16
230 DO i=1,nel
231 smax(i)= jac_59_68(i)*jac_59_68(i)+jac_67_49(i)*jac_67_49(i)
232 . +jac_48_57(i)*jac_48_57(i)
233 smax(i)= max(smax(i),jac_38_29(i)*jac_38_29(i)+jac_19_37(i)*jac_19_37(i)
234 . +jac_27_18(i)*jac_27_18(i))
235 smax(i)= max(smax(i),jac_26_35(i)*jac_26_35(i)+jac_34_16(i)*jac_34_16(i)
236 . +jac_15_24(i)*jac_15_24(i))
237 ENDDO
238 DO i=1,nel
239 IF(smax(i)<=zero)THEN
240 CALL ancmsg(msgid=173,anmode=aninfo,i1=ngl(i))
241 CALL arret(2)
242 ENDIF
243 smax(i)= one/sqrt(smax(i))
244 ENDDO
245 RETURN
246C
247 1000 FORMAT(/' ZERO OR NEGATIVE VOLUME : 3D-ELEMENT NB',i10/)
248 2000 FORMAT(/' ZERO OR NEGATIVE VOLUME : DELETE 3D-ELEMENT NB',i10/)
249 END
max
#define max(a, b)
Definition macros.h:21
message_mod
Definition message_mod.F:1249
s8ederict3
subroutine s8ederict3(off, det, ngl, x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, px1, px2, px3, px4, py1, py2, py3, py4, pz1, pz2, pz3, pz4, hx, hy, hz, aj1, aj2, aj3, aj4, aj5, aj6, aj7, aj8, aj9, smax, nel)
Definition s8ederict3.F:49
schkjab3
subroutine schkjab3(off, det, ngl, nel)
Definition schkjab3.F:39
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
arret
subroutine arret(nn)
Definition arret.F:87