OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
crframe_imp.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!|| crframe_imp ../engine/source/elements/solid/solide8s/crframe_imp.F
25!||--- called by ------------------------------------------------------
26!|| srcoor3_imp ../engine/source/elements/solid/solide8s/srcoor3_imp.F
27!||====================================================================
28 SUBROUTINE crframe_imp(
29 1 SAV, INVJ, XD1, XD2,
30 2 XD3, XD4, XD5, XD6,
31 3 XD7, XD8, YD1, YD2,
32 4 YD3, YD4, YD5, YD6,
33 5 YD7, YD8, ZD1, ZD2,
34 6 ZD3, ZD4, ZD5, ZD6,
35 7 ZD7, ZD8, R, NEL)
36C-----------------------------------------------
37C I m p l i c i t T y p e s
38C-----------------------------------------------
39#include "implicit_f.inc"
40C-----------------------------------------------
41C G l o b a l P a r a m e t e r s
42C-----------------------------------------------
43#include "mvsiz_p.inc"
44C-----------------------------------------------
45C C o m m o n B l o c k s
46C-----------------------------------------------
47C-----------------------------------------------
48C D u m m y A r g u m e n t s
49C-----------------------------------------------
50 INTEGER NEL
51C REAL
52! my_real
53! . OFFG(*)
54
55 DOUBLE PRECISION
56 . XD1(MVSIZ), XD2(MVSIZ), XD3(MVSIZ), XD4(MVSIZ),
57 . xd5(mvsiz), xd6(mvsiz), xd7(mvsiz), xd8(mvsiz),
58 . yd1(mvsiz), yd2(mvsiz), yd3(mvsiz), yd4(mvsiz),
59 . yd5(mvsiz), yd6(mvsiz), yd7(mvsiz), yd8(mvsiz),
60 . zd1(mvsiz), zd2(mvsiz), zd3(mvsiz), zd4(mvsiz),
61 . zd5(mvsiz), zd6(mvsiz), zd7(mvsiz), zd8(mvsiz),
62 . sav(nel,21),invj(mvsiz,3,3), r(3,3,mvsiz)
63C-----------------------------------------------
64C L o c a l V a r i a b l e s
65C-----------------------------------------------
66 INTEGER I,J
67C=======================================================================
68 DOUBLE PRECISION DX_DR,DX_DS,DX_DT,DY_DR,DY_DS,DY_DT,DZ_DR,DZ_DS,DZ_DT
69 DOUBLE PRECISION FMAT(3,3),UM(3,3),IC,I2C,I3C,IU,I2U,I3U
70 DOUBLE PRECISION C11,C21,C31,C12,C22,C32,C13,C23,C33,DETJ0,DETM1
71 DOUBLE PRECISION CC11,CC21,CC31,CC12,CC22,CC32,CC13,CC23,CC33
72 DOUBLE PRECISION A,B,ZZ,A1,A2,A3,A4,X0(8),Y0(8),Z0(8)
73 DOUBLE PRECISION MILLE24
74 MILLE24 = 1024.0
75
76 DO i=1,nel
77 x0(1) = zero
78 y0(1) = zero
79 z0(1) = zero
80 x0(2) = sav(i,1)
81 y0(2) = sav(i,2)
82 z0(2) = sav(i,3)
83 x0(3) = sav(i,4)
84 y0(3) = sav(i,5)
85 z0(3) = sav(i,6)
86 x0(4) = sav(i,7)
87 y0(4) = sav(i,8)
88 z0(4) = sav(i,9)
89 x0(5) = sav(i,10)
90 y0(5) = sav(i,11)
91 z0(5) = sav(i,12)
92 x0(6) = sav(i,13)
93 y0(6) = sav(i,14)
94 z0(6) = sav(i,15)
95 x0(7) = sav(i,16)
96 y0(7) = sav(i,17)
97 z0(7) = sav(i,18)
98 x0(8) = sav(i,19)
99 y0(8) = sav(i,20)
100 z0(8) = sav(i,21)
101
102 dx_dr = (x0(3)+x0(4)+x0(7)+x0(8))-(x0(1)+x0(2)+x0(5)+x0(6))
103 dy_dr = (y0(3)+y0(4)+y0(7)+y0(8))-(y0(1)+y0(2)+y0(5)+y0(6))
104 dz_dr = (z0(3)+z0(4)+z0(7)+z0(8))-(z0(1)+z0(2)+z0(5)+z0(6))
105 !DX_DR = DX_DR/EIGHT
106 !DY_DR = DY_DR/EIGHT
107 !DZ_DR = DZ_DR/EIGHT
108 dx_ds = (x0(5)+x0(6)+x0(7)+x0(8))-(x0(1)+x0(2)+x0(3)+x0(4))
109 dy_ds = (y0(5)+y0(6)+y0(7)+y0(8))-(y0(1)+y0(2)+y0(3)+y0(4))
110 dz_ds = (z0(5)+z0(6)+z0(7)+z0(8))-(z0(1)+z0(2)+z0(3)+z0(4))
111 !DX_DS = DX_DS/EIGHT
112 !DY_DS = DY_DS/EIGHT
113 !DZ_DS = DZ_DS/EIGHT
114 dx_dt = (x0(2)+x0(3)+x0(6)+x0(7))-(x0(1)+x0(4)+x0(5)+x0(8))
115 dy_dt = (y0(2)+y0(3)+y0(6)+y0(7))-(y0(1)+y0(4)+y0(5)+y0(8))
116 dz_dt = (z0(2)+z0(3)+z0(6)+z0(7))-(z0(1)+z0(4)+z0(5)+z0(8))
117 !DX_DT = DX_DT/EIGHT
118 !DY_DT = DY_DT/EIGHT
119 !DZ_DT = DZ_DT/EIGHT
120 detj0 =(dx_dr*(dy_ds*dz_dt-dz_ds*dy_dt)
121 . -dx_ds*(dy_dr*dz_dt-dy_dt*dz_dr)
122 . +dx_dt*(dy_dr*dz_ds-dy_ds*dz_dr))
123 detm1 = one/detj0
124 detm1 = eight*detm1
125 invj(i,1,1) = (dy_ds*dz_dt-dz_ds*dy_dt)*detm1
126 invj(i,2,1) = (dz_dr*dy_dt-dy_dr*dz_dt)*detm1
127 invj(i,3,1) = (dy_dr*dz_ds-dy_ds*dz_dr)*detm1
128 invj(i,1,2) = (dx_dt*dz_ds-dx_ds*dz_dt)*detm1
129 invj(i,2,2) = (dx_dr*dz_dt-dx_dt*dz_dr)*detm1
130 invj(i,3,2) = (dx_ds*dz_dr-dx_dr*dz_ds)*detm1
131 invj(i,1,3) = (dx_ds*dy_dt-dx_dt*dy_ds)*detm1
132 invj(i,2,3) = (dx_dt*dy_dr-dx_dr*dy_dt)*detm1
133 invj(i,3,3) = (dx_dr*dy_ds-dx_ds*dy_dr)*detm1
134
135 dx_dr = (xd3(i)+xd4(i)+xd7(i)+xd8(i))-(xd1(i)+xd2(i)+xd5(i)+xd6(i))
136 dy_dr = (yd3(i)+yd4(i)+yd7(i)+yd8(i))-(yd1(i)+yd2(i)+yd5(i)+yd6(i))
137 dz_dr = (zd3(i)+zd4(i)+zd7(i)+zd8(i))-(zd1(i)+zd2(i)+zd5(i)+zd6(i))
138 dx_dr = dx_dr/eight
139 dy_dr = dy_dr/eight
140 dz_dr = dz_dr/eight
141 dx_ds = (xd5(i)+xd6(i)+xd7(i)+xd8(i))-(xd1(i)+xd2(i)+xd3(i)+xd4(i))
142 dy_ds = (yd5(i)+yd6(i)+yd7(i)+yd8(i))-(yd1(i)+yd2(i)+yd3(i)+yd4(i))
143 dz_ds = (zd5(i)+zd6(i)+zd7(i)+zd8(i))-(zd1(i)+zd2(i)+zd3(i)+zd4(i))
144 dx_ds = dx_ds/eight
145 dy_ds = dy_ds/eight
146 dz_ds = dz_ds/eight
147 dx_dt = (xd2(i)+xd3(i)+xd6(i)+xd7(i))-(xd1(i)+xd4(i)+xd5(i)+xd8(i))
148 dy_dt = (yd2(i)+yd3(i)+yd6(i)+yd7(i))-(yd1(i)+yd4(i)+yd5(i)+yd8(i))
149 dz_dt = (zd2(i)+zd3(i)+zd6(i)+zd7(i))-(zd1(i)+zd4(i)+zd5(i)+zd8(i))
150 dx_dt = dx_dt/eight
151 dy_dt = dy_dt/eight
152 dz_dt = dz_dt/eight
153
154 fmat(1,1) = (dx_dr*invj(i,1,1)+dx_ds*invj(i,2,1)+dx_dt*invj(i,3,1))
155 fmat(2,1) = (dy_dr*invj(i,1,1)+dy_ds*invj(i,2,1)+dy_dt*invj(i,3,1))
156 fmat(3,1) = (dz_dr*invj(i,1,1)+dz_ds*invj(i,2,1)+dz_dt*invj(i,3,1))
157 fmat(1,2) = (dx_dr*invj(i,1,2)+dx_ds*invj(i,2,2)+dx_dt*invj(i,3,2))
158 fmat(2,2) = (dy_dr*invj(i,1,2)+dy_ds*invj(i,2,2)+dy_dt*invj(i,3,2))
159 fmat(3,2) = (dz_dr*invj(i,1,2)+dz_ds*invj(i,2,2)+dz_dt*invj(i,3,2))
160 fmat(1,3) = (dx_dr*invj(i,1,3)+dx_ds*invj(i,2,3)+dx_dt*invj(i,3,3))
161 fmat(2,3) = (dy_dr*invj(i,1,3)+dy_ds*invj(i,2,3)+dy_dt*invj(i,3,3))
162 fmat(3,3) = (dz_dr*invj(i,1,3)+dz_ds*invj(i,2,3)+dz_dt*invj(i,3,3))
163
164 c11 = fmat(1,1)*fmat(1,1)+fmat(2,1)*fmat(2,1)+fmat(3,1)*fmat(3,1)
165 c21 = fmat(1,2)*fmat(1,1)+fmat(2,2)*fmat(2,1)+fmat(3,2)*fmat(3,1)
166 c31 = fmat(1,3)*fmat(1,1)+fmat(2,3)*fmat(2,1)+fmat(3,3)*fmat(3,1)
167 c12 = fmat(1,1)*fmat(1,2)+fmat(2,1)*fmat(2,2)+fmat(3,1)*fmat(3,2)
168 c22 = fmat(1,2)*fmat(1,2)+fmat(2,2)*fmat(2,2)+fmat(3,2)*fmat(3,2)
169 c32 = fmat(1,3)*fmat(1,2)+fmat(2,3)*fmat(2,2)+fmat(3,3)*fmat(3,2)
170 c13 = fmat(1,1)*fmat(1,3)+fmat(2,1)*fmat(2,3)+fmat(3,1)*fmat(3,3)
171 c23 = fmat(1,2)*fmat(1,3)+fmat(2,2)*fmat(2,3)+fmat(3,2)*fmat(3,3)
172 c33 = fmat(1,3)*fmat(1,3)+fmat(2,3)*fmat(2,3)+fmat(3,3)*fmat(3,3)
173
174 cc11 = c11*c11+c12*c21+c13*c31
175 cc21 = c21*c11+c22*c21+c23*c31
176 cc31 = c31*c11+c32*c21+c33*c31
177 cc12 = c11*c12+c12*c22+c13*c32
178 cc22 = c21*c12+c22*c22+c23*c32
179 cc32 = c31*c12+c32*c22+c33*c32
180 cc13 = c11*c13+c12*c23+c13*c33
181 cc23 = c21*c13+c22*c23+c23*c33
182 cc33 = c31*c13+c32*c23+c33*c33
183
184 ic = c11+c22+c33
185 i2c = c11*c22+c22*c33+c11*c33-c21*c12-c13*c31-c23*c32
186 i3c = c11*c22*c33+c12*c23*c31+c13*c21*c32
187 . -(c13*c22*c31+c12*c21*c33+c11*c23*c32)
188
189 a = (two*ic*ic*ic-nine*ic*i2c+twenty7*i3c)*thirty2/twenty7
190 b = (four*(i2c*i2c*i2c+ic*ic*ic*i3c)-ic*ic*i2c*i2c-eighteen*ic*i2c*i3c
191 . +twenty7*i3c*i3c)*mille24/twenty7
192 b = max(b,zero)
193 a1 = a+sqrt(b)
194 a2 = a-sqrt(b)
195 !ZZ = -TWO_THIRD*IC+CBRT(A1)+CBRT(A2)
196 zz = -two_third*ic+sign(abs(a1)**third,a1)+sign(abs(a2)**third,a2)
197 a = two*ic+zz
198 IF (a == zero) THEN
199 iu = sqrt(ic+two*sqrt(i2c))
200 ELSE
201 a = sqrt(a)
202 iu = half*(a+sqrt(two*ic-zz+sixteen*sqrt(i3c)/a))
203 ENDIF
204 i3u = sqrt(i3c)
205 i2u = half*(iu*iu-ic)
206 a = iu*i2u-i3u
207 b = i3u+iu*ic
208 a1 = iu*a
209 a2 = a*b
210 a3 = i2u*i3u*b+iu*iu*(i2u*i2c+i3c)
211 a4 = one/(i3u*i3u*b+iu*iu*(iu*i3c+i3u*i2c))
212 um(1,1) = a4*(a1*cc11-a2*c11+a3)
213 um(2,1) = a4*(a1*cc21-a2*c21)
214 um(3,1) = a4*(a1*cc31-a2*c31)
215 um(1,2) = a4*(a1*cc12-a2*c12)
216 um(2,2) = a4*(a1*cc22-a2*c22+a3)
217 um(3,2) = a4*(a1*cc32-a2*c32)
218 um(1,3) = a4*(a1*cc13-a2*c13)
219 um(2,3) = a4*(a1*cc23-a2*c23)
220 um(3,3) = a4*(a1*cc33-a2*c33+a3)
221
222 r(1,1,i) = fmat(1,1)*um(1,1)+fmat(1,2)*um(2,1)+fmat(1,3)*um(3,1)
223 r(2,1,i) = fmat(2,1)*um(1,1)+fmat(2,2)*um(2,1)+fmat(2,3)*um(3,1)
224 r(3,1,i) = fmat(3,1)*um(1,1)+fmat(3,2)*um(2,1)+fmat(3,3)*um(3,1)
225 r(1,2,i) = fmat(1,1)*um(1,2)+fmat(1,2)*um(2,2)+fmat(1,3)*um(3,2)
226 r(2,2,i) = fmat(2,1)*um(1,2)+fmat(2,2)*um(2,2)+fmat(2,3)*um(3,2)
227 r(3,2,i) = fmat(3,1)*um(1,2)+fmat(3,2)*um(2,2)+fmat(3,3)*um(3,2)
228 r(1,3,i) = fmat(1,1)*um(1,3)+fmat(1,2)*um(2,3)+fmat(1,3)*um(3,3)
229 r(2,3,i) = fmat(2,1)*um(1,3)+fmat(2,2)*um(2,3)+fmat(2,3)*um(3,3)
230 r(3,3,i) = fmat(3,1)*um(1,3)+fmat(3,2)*um(2,3)+fmat(3,3)*um(3,3)
231 ENDDO
232 RETURN
233 END
crframe_imp
subroutine crframe_imp(sav, invj, xd1, xd2, xd3, xd4, xd5, xd6, xd7, xd8, yd1, yd2, yd3, yd4, yd5, yd6, yd7, yd8, zd1, zd2, zd3, zd4, zd5, zd6, zd7, zd8, r, nel)
Definition crframe_imp.F:36
max
#define max(a, b)
Definition macros.h:21