OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
crframe_imp.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"

Go to the source code of this file.

Functions/Subroutines

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)

Function/Subroutine Documentation

◆ crframe_imp()

subroutine crframe_imp ( double precision, dimension(nel,21) sav,
double precision, dimension(mvsiz,3,3) invj,
double precision, dimension(mvsiz) xd1,
double precision, dimension(mvsiz) xd2,
double precision, dimension(mvsiz) xd3,
double precision, dimension(mvsiz) xd4,
double precision, dimension(mvsiz) xd5,
double precision, dimension(mvsiz) xd6,
double precision, dimension(mvsiz) xd7,
double precision, dimension(mvsiz) xd8,
double precision, dimension(mvsiz) yd1,
double precision, dimension(mvsiz) yd2,
double precision, dimension(mvsiz) yd3,
double precision, dimension(mvsiz) yd4,
double precision, dimension(mvsiz) yd5,
double precision, dimension(mvsiz) yd6,
double precision, dimension(mvsiz) yd7,
double precision, dimension(mvsiz) yd8,
double precision, dimension(mvsiz) zd1,
double precision, dimension(mvsiz) zd2,
double precision, dimension(mvsiz) zd3,
double precision, dimension(mvsiz) zd4,
double precision, dimension(mvsiz) zd5,
double precision, dimension(mvsiz) zd6,
double precision, dimension(mvsiz) zd7,
double precision, dimension(mvsiz) zd8,
double precision, dimension(3,3,mvsiz) r,
integer nel )

Definition at line 28 of file crframe_imp.F.

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
max
#define max(a, b)
Definition macros.h:21