OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i2cin_rot27.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!|| i2cin_rot27 ../common_source/interf/i2cin_rot27.F
25!||--- called by ------------------------------------------------------
26!|| i2_dtn_27_cin ../starter/source/interfaces/inter3d1/i2_dtn_27.F
27!|| i2for27_cin ../engine/source/interfaces/interf/i2for27_cin.F
28!|| i2for27p_cin ../engine/source/interfaces/interf/i2for27p_cin.F
29!||====================================================================
30 SUBROUTINE i2cin_rot27(STBRK,RS,RM,X1,Y1,Z1,X2,Y2,Z2,X3,Y3,Z3,
31 . X4,Y4,Z4,DPARA,DWDU,E1X,E1Y,E1Z,E2X,E2Y,E2Z,E3X,E3Y,E3Z,
32 . NIR,BETAX,BETAY)
33C-----------------------------------------------
34C I m p l i c i t T y p e s
35C-----------------------------------------------
36#include "implicit_f.inc"
37C-----------------------------------------------
38C C o m m o n B l o c k s
39C-----------------------------------------------
40#include "param_c.inc"
41#include "com01_c.inc"
42C-----------------------------------------------
43C D u m m y A r g u m e n t s
44C-----------------------------------------------
45C REAL
46 INTEGER NIR
47 my_real
48 . stbrk,rs(3),rm(3),dpara(7),x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4,dwdu,
49 . e1x,e1y,e1z,e2x,e2y,e2z,e3x,e3y,e3z,betax,betay
50C-----------------------------------------------
51C L o c a l V a r i a b l e s
52C-----------------------------------------------
53C REAL
54 my_real
55 . r(3),
56 . x12,x22,x32,x42,y12,y22,y32,y42,z12,z22,z32,z42,
57 . xx,yy,zz,xxx,yyy,zzz,xy,yz,zx,xy2,yz2,zx2,
58 . b1,b2,b3,c1,c2,c3,det,bb1,bb2,bb3,cc1,cc2,cc3,
59 . mloc(3,3),mloc2(3,3),mglob(3,3),pass(3,3),tpass(3,3),
60 . vect_sx,vect_sy,vect_sz,surf,ratio,l12_2,l23_2,l34_2,l41_2
61C=======================================================================
62C
63 r(1)=rs(1)-rm(1)
64 r(2)=rs(2)-rm(2)
65 r(3)=rs(3)-rm(3)
66C
67 x12=x1*x1
68 x22=x2*x2
69 x32=x3*x3
70 x42=x4*x4
71 y12=y1*y1
72 y22=y2*y2
73 y32=y3*y3
74 y42=y4*y4
75 z12=z1*z1
76 z22=z2*z2
77 z32=z3*z3
78 z42=z4*z4
79 xx=x12 + x22 + x32 + x42
80 yy=y12 + y22 + y32 + y42
81 zz=z12 + z22 + z32 + z42
82 xy=x1*y1 + x2*y2 + x3*y3 + x4*y4
83 yz=y1*z1 + y2*z2 + y3*z3 + y4*z4
84 zx=z1*x1 + z2*x2 + z3*x3 + z4*x4
85 zzz=xx+yy
86 xxx=yy+zz
87 yyy=zz+xx
88 xy2=xy*xy
89 yz2=yz*yz
90 zx2=zx*zx
91 det= xxx*yyy*zzz - xxx*yz2 - yyy*zx2 - zzz*xy2
92 . - two*xy*yz*zx
93C
94C --- VECT_SURF = 0.5*(X1^X2 + X2^X3 + X3^X4 +X4^X1)
95C
96 IF (nir == 4) THEN
97 vect_sx = y1*z2+y2*z3+y3*z4+y4*z1-z1*y2-z2*y3-z3*y4-z4*y1
98 vect_sy = z1*x2+z2*x3+z3*x4+z4*x1-x1*z2-x2*z3-x3*z4-x4*z1
99 vect_sz = x1*y2+x2*y3+x3*y4+x4*y1-y1*x2-y2*x3-y3*x4-y4*x1
100 ELSE
101 vect_sx = y1*z2+y2*z3+y3*z1-z1*y2-z2*y3-z3*y1
102 vect_sy = z1*x2+z2*x3+z3*x1-x1*z2-x2*z3-x3*z1
103 vect_sz = x1*y2+x2*y3+x3*y1-y1*x2-y2*x3-y3*x1
104 ENDIF
105C
106 surf = sqrt(vect_sx*vect_sx+vect_sy*vect_sy+vect_sz*vect_sz)
107C
108 l12_2 = (x2-x1)**2+(y2-y1)**2+(z2-z1)**2
109 l23_2 = (x3-x2)**2+(y3-y2)**2+(z3-z2)**2
110 l34_2 = (x4-x3)**2+(y4-y3)**2+(z4-z3)**2
111 l41_2 = (x1-x4)**2+(y1-y4)**2+(z1-z4)**2
112C
113C --- RATIO = h / Lmax = 0.5*S/Lmax2
114C--> in case of triangle RATIO=h/l and in case of rectangle RATIO = 2*h/L
115 ratio = surf / max(l12_2,l23_2,l34_2,l41_2)
116C
117C IF (ABS(DET) < 1e-8) print *,"ATTENTION D < 1e-8",DET,RATIO,XX,YY
118C
119 IF (ratio > 5e-3) THEN
120C-- standard situation
121 det = one/det
122 b1=zzz*yyy-yz2
123 b2=xxx*zzz-zx2
124 b3=yyy*xxx-xy2
125 c3=zzz*xy+yz*zx
126 c1=xxx*yz+zx*xy
127 c2=yyy*zx+xy*yz
128 betax = one
129 betay = one
130 ELSEIF (yy < xx) THEN
131C-- nodes are nearly aligned on local X axis - DET = 0 - switch to 1D formulation
132 det = one
133 b1=zero
134 b2=one/xx
135 b3=one/xx
136 c3=zero
137 c1=zero
138 c2=zero
139 betax = zero
140 betay = one
141 ELSE
142C-- nodes are nearly aligned on local Y axis - DET = 0 - switch to 1D formulation
143 det = one
144 b1=one/yy
145 b2=zero
146 b3=one/yy
147 c3=zero
148 c1=zero
149 c2=zero
150 betax = one
151 betay = zero
152 ENDIF
153C
154 bb1=b1*b1
155 bb2=b2*b2
156 bb3=b3*b3
157 cc1=c1*c1
158 cc2=c2*c2
159 cc3=c3*c3
160C
161 dwdu=det*sqrt(max(bb1*(yy+zz)+cc3*(zz+xx)+cc2*(xx+yy),
162 . bb2*(zz+xx)+cc1*(xx+yy)+cc3*(yy+zz),
163 . bb3*(xx+yy)+cc2*(yy+zz)+cc1*(zz+xx)))
164C
165 stbrk=sqrt((r(1)*r(1)+r(2)*r(2)+r(3)*r(3)))*dwdu
166C
167C Matrix M-1 must be stored in global skew for i2vit3
168C
169 mloc(1,1)=b1
170 mloc(1,2)=c3
171 mloc(1,3)=c2
172 mloc(2,1)=c3
173 mloc(2,2)=b2
174 mloc(2,3)=c1
175 mloc(3,1)=c2
176 mloc(3,2)=c1
177 mloc(3,3)=b3
178C
179 pass(1,1) = e1x
180 pass(1,2) = e2x
181 pass(1,3) = e3x
182 pass(2,1) = e1y
183 pass(2,2) = e2y
184 pass(2,3) = e3y
185 pass(3,1) = e1z
186 pass(3,2) = e2z
187 pass(3,3) = e3z
188C
189 tpass(1,1) = e1x
190 tpass(1,2) = e1y
191 tpass(1,3) = e1z
192 tpass(2,1) = e2x
193 tpass(2,2) = e2y
194 tpass(2,3) = e2z
195 tpass(3,1) = e3x
196 tpass(3,2) = e3y
197 tpass(3,3) = e3z
198C
199 mloc2(1:3,1:3) = matmul(mloc(1:3,1:3),tpass(1:3,1:3))
200 mglob(1:3,1:3) = matmul(pass(1:3,1:3),mloc2(1:3,1:3))
201C
202 dpara(1)=det
203 dpara(2)=mglob(1,1)
204 dpara(3)=mglob(2,2)
205 dpara(4)=mglob(3,3)
206 dpara(5)=mglob(2,3)
207 dpara(6)=mglob(1,3)
208 dpara(7)=mglob(1,2)
209C
210C-----------
211 RETURN
212 END
i2cin_rot27
subroutine i2cin_rot27(stbrk, rs, rm, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4, dpara, dwdu, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z, nir, betax, betay)
Definition i2cin_rot27.F:33
max
#define max(a, b)
Definition macros.h:21