OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
s4derit3.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!|| s4derit3 ../engine/source/elements/solid/solide4/s4derit3.F
25!||--- called by ------------------------------------------------------
26!|| s4forc3 ../engine/source/elements/solid/solide4/s4forc3.F
27!|| s4ke3 ../engine/source/elements/solid/solide4/s4ke3.F
28!||--- calls -----------------------------------------------------
29!|| schkjab3 ../engine/source/elements/solid/solide/schkjab3.F
30!||====================================================================
31 SUBROUTINE s4derit3(
32 1 OFF, DET, NGL, DELTAX,
33 2 MXT, X1, X2, X3,
34 3 X4, Y1, Y2, Y3,
35 4 Y4, Z1, Z2, Z3,
36 5 Z4, PX1, PX2, PX3,
37 6 PX4, PY1, PY2, PY3,
38 7 PY4, PZ1, PZ2, PZ3,
39 8 PZ4, RX, RY, RZ,
40 9 SX, SY, SZ, TX,
41 A TY, TZ, PM, VOLDP,
42 B NEL, IFORMDT)
43C-----------------------------------------------
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46#include "implicit_f.inc"
47#include "comlock.inc"
48C-----------------------------------------------
49C G l o b a l P a r a m e t e r s
50C-----------------------------------------------
51#include "mvsiz_p.inc"
52#include "param_c.inc"
53C-----------------------------------------------
54C D u m m y A r g u m e n t s
55C-----------------------------------------------
56 INTEGER, INTENT(IN) :: NEL
57 INTEGER, INTENT(IN) :: IFORMDT
58 INTEGER MXT(*)
59 DOUBLE PRECISION
60 . X1(*), X2(*), X3(*), X4(*),
61 . Y1(*), Y2(*), Y3(*), Y4(*),
62 . Z1(*), Z2(*), Z3(*), Z4(*),VOLDP(*)
63 my_real
64 . OFF(*),DET(*),DELTAX(*),
65 . PX1(*), PX2(*), PX3(*), PX4(*),
66 . PY1(*), PY2(*), PY3(*), PY4(*),
67 . pz1(*), pz2(*), pz3(*), pz4(*),
68 . rx(*), ry(*), rz(*), sx(*), sy(*), sz(*),tx(*), ty(*), tz(*),
69 . pm(npropm,*)
70C-----------------------------------------------
71C C o m m o n B l o c k s
72C-----------------------------------------------
73#include "scr17_c.inc"
74C-----------------------------------------------
75C L o c a l V a r i a b l e s
76C-----------------------------------------------
77 INTEGER NGL(*), I
78 DOUBLE PRECISION
79 . X41, Y41, Z41, X42, Y42, Z42, X43, Y43, Z43,B1DP,C1DP,D1DP
80 my_real
81 . B1(MVSIZ), B2(MVSIZ), B3(MVSIZ), B4(MVSIZ),
82 . C1(MVSIZ), C2(MVSIZ), C3(MVSIZ), C4(MVSIZ),
83 . D1(MVSIZ), D2(MVSIZ), D3(MVSIZ), D4(MVSIZ),
84 . D,
85 . PXX, PYY, PZZ, PXY, PYZ, PXZ, GFAC, AA, BB, P, LD
86C-----------------------------------------------
87C
88 DO i=1,nel
89 x43 = x4(i) - x3(i)
90 y43 = y4(i) - y3(i)
91 z43 = z4(i) - z3(i)
92 x41 = x4(i) - x1(i)
93 y41 = y4(i) - y1(i)
94 z41 = z4(i) - z1(i)
95 x42 = x4(i) - x2(i)
96 y42 = y4(i) - y2(i)
97 z42 = z4(i) - z2(i)
98C
99 rx(i) = -x41
100 ry(i) = -y41
101 rz(i) = -z41
102 sx(i) = -x42
103 sy(i) = -y42
104 sz(i) = -z42
105C
106 tx(i) = -x43
107 ty(i) = -y43
108 tz(i) = -z43
109C
110 b1dp = y43*z42 - y42*z43
111 b1(i) = b1dp
112 b2(i) = y41*z43 - y43*z41
113 b3(i) = y42*z41 - y41*z42
114 b4(i) = -(b1(i) + b2(i) + b3(i))
115C
116 c1dp = z43*x42 - z42*x43
117 c1(i) = c1dp
118 c2(i) = z41*x43 - z43*x41
119 c3(i) = z42*x41 - z41*x42
120 c4(i) = -(c1(i) + c2(i) + c3(i))
121C
122 d1dp = x43*y42 - x42*y43
123 d1(i) = d1dp
124 d2(i) = x41*y43 - x43*y41
125 d3(i) = x42*y41 - x41*y42
126 d4(i) = -(d1(i) + d2(i) + d3(i))
127C
128 voldp(i) = (x41*b1dp + y41*c1dp + z41*d1dp)*one_over_6
129 det(i) = voldp(i)
130C
131 ENDDO
132C
133 CALL schkjab3(
134 1 off, det, ngl, nel)
135C
136 DO i=1,nel
137 d = one/det(i)/six
138 px1(i)=-b1(i)*d
139 py1(i)=-c1(i)*d
140 pz1(i)=-d1(i)*d
141 px2(i)=-b2(i)*d
142 py2(i)=-c2(i)*d
143 pz2(i)=-d2(i)*d
144 px3(i)=-b3(i)*d
145 py3(i)=-c3(i)*d
146 pz3(i)=-d3(i)*d
147 px4(i)=-b4(i)*d
148 py4(i)=-c4(i)*d
149 pz4(i)=-d4(i)*d
150 END DO
151
152 IF(idt1sol==0)THEN
153
154 DO i=1,nel
155 d = max(px1(i)*px1(i)+py1(i)*py1(i)+pz1(i)*pz1(i),
156 . px2(i)*px2(i)+py2(i)*py2(i)+pz2(i)*pz2(i),
157 . px3(i)*px3(i)+py3(i)*py3(i)+pz3(i)*pz3(i),
158 . px4(i)*px4(i)+py4(i)*py4(i)+pz4(i)*pz4(i))
159 deltax(i) = one / sqrt(d)
160 END DO
161
162
163 ELSEIF(iformdt==0)THEN
164 DO i=1,nel
165 d = px1(i)*px1(i)+py1(i)*py1(i)+pz1(i)*pz1(i)
166 . + px2(i)*px2(i)+py2(i)*py2(i)+pz2(i)*pz2(i)
167 . + px3(i)*px3(i)+py3(i)*py3(i)+pz3(i)*pz3(i)
168 . + px4(i)*px4(i)+py4(i)*py4(i)+pz4(i)*pz4(i)
169 deltax(i) = one / sqrt(d)
170 END DO
171
172 ELSEIF(iformdt==1)THEN
173
174 gfac=pm(105,mxt(1))
175 ld =two*sqrt(max(one-gfac,zero))+one
176 DO i=1,nel
177 pxx=px1(i)*px1(i)+px2(i)*px2(i)+px3(i)*px3(i)+px4(i)*px4(i)
178 pyy=py1(i)*py1(i)+py2(i)*py2(i)+py3(i)*py3(i)+py4(i)*py4(i)
179 pzz=pz1(i)*pz1(i)+pz2(i)*pz2(i)+pz3(i)*pz3(i)+pz4(i)*pz4(i)
180 pxy=px1(i)*py1(i)+px2(i)*py2(i)+px3(i)*py3(i)+px4(i)*py4(i)
181 pxz=px1(i)*pz1(i)+px2(i)*pz2(i)+px3(i)*pz3(i)+px4(i)*pz4(i)
182 pyz=py1(i)*pz1(i)+py2(i)*pz2(i)+py3(i)*pz3(i)+py4(i)*pz4(i)
183C
184 aa = -(pxx+pyy+pzz)
185 bb = (pxx*pyy+pxx*pzz+pyy*pzz-pxy**2-pxz**2-pyz**2)
186 p = bb-third*aa*aa
187 d=two*sqrt(third*max(-p,zero))-third*aa
188C
189 d=ld*d
190C
191 deltax(i) = one / sqrt(d)
192 END DO
193
194 ELSEIF(iformdt==2)THEN
195
196 gfac=pm(105,mxt(1))
197 DO i=1,nel
198 pxx=px1(i)*px1(i)+px2(i)*px2(i)+px3(i)*px3(i)+px4(i)*px4(i)
199 pyy=py1(i)*py1(i)+py2(i)*py2(i)+py3(i)*py3(i)+py4(i)*py4(i)
200 pzz=pz1(i)*pz1(i)+pz2(i)*pz2(i)+pz3(i)*pz3(i)+pz4(i)*pz4(i)
201 pxy=px1(i)*py1(i)+px2(i)*py2(i)+px3(i)*py3(i)+px4(i)*py4(i)
202 pxz=px1(i)*pz1(i)+px2(i)*pz2(i)+px3(i)*pz3(i)+px4(i)*pz4(i)
203 pyz=py1(i)*pz1(i)+py2(i)*pz2(i)+py3(i)*pz3(i)+py4(i)*pz4(i)
204C
205 aa = -(pxx+pyy+pzz)
206 bb = gfac*(pxx*pyy+pxx*pzz+pyy*pzz-pxy**2-pxz**2-pyz**2)
207 p = bb-third*aa*aa
208 d = two*sqrt(third*max(-p,zero))-third*aa
209C
210 deltax(i) = one / sqrt(d)
211 END DO
212
213 END IF
214C
215 RETURN
216C
217 END
max
#define max(a, b)
Definition macros.h:21
s4derit3
subroutine s4derit3(off, det, ngl, deltax, mxt, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, px1, px2, px3, px4, py1, py2, py3, py4, pz1, pz2, pz3, pz4, rx, ry, rz, sx, sy, sz, tx, ty, tz, pm, voldp, nel, iformdt)
Definition s4derit3.F:43
schkjab3
subroutine schkjab3(off, det, ngl, nel)
Definition schkjab3.F:39