OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sortho31.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!|| sortho31 ../starter/source/output/anim/sortho31.F
25!||--- called by ------------------------------------------------------
26!|| srota6 ../starter/source/output/anim/srota6.F
27!|| srota6_m1 ../starter/source/output/anim/srota6_M1.F
28!||====================================================================
29 SUBROUTINE sortho31(
30 . X1, X2, X3, X4, X5, X6, X7, X8,
31 . Y1, Y2, Y3, Y4, Y5, Y6, Y7, Y8,
32 . Z1, Z2, Z3, Z4, Z5, Z6, Z7, Z8,
33 . E1X, E2X, E3X, E1Y, E2Y, E3Y, E1Z, E2Z, E3Z )
34C-----------------------------------------------
35C I m p l i c i t T y p e s
36C-----------------------------------------------
37#include "implicit_f.inc"
38C-----------------------------------------------
39C D u m m y A r g u m e n t s
40C-----------------------------------------------
41 my_real
42 . x1, x2, x3, x4, x5, x6, x7, x8,
43 . y1, y2, y3, y4, y5, y6, y7, y8,
44 . z1, z2, z3, z4, z5, z6, z7, z8,
45 . e1x, e1y, e1z,
46 . e2x, e2y, e2z,
47 . e3x, e3y, e3z
48C-----------------------------------------------
49C L o c a l V a r i a b l e s
50C-----------------------------------------------
51 INTEGER N,NITER
52 my_real
53 . X17 , X28 , X35 , X46,
54 . Y17 , Y28 , Y35 , Y46,
55 . z17 , z28 , z35 , z46,
56 . a17 , a28 ,
57 . b17 , b28 ,
58 . c17 , c28 ,
59 . rx , ry , rz ,
60 . sx , sy , sz ,
61 . tx , ty , tz
62 my_real
63 . aa,bb
64 DATA niter/3/
65C-----------------------------------------------
66 x17=x7-x1
67 x28=x8-x2
68 x35=x5-x3
69 x46=x6-x4
70 y17=y7-y1
71 y28=y8-y2
72 y35=y5-y3
73 y46=y6-y4
74 z17=z7-z1
75 z28=z8-z2
76 z35=z5-z3
77 z46=z6-z4
78 rx=x17+x28-x35-x46
79 ry=y17+y28-y35-y46
80 rz=z17+z28-z35-z46
81 a17=x17+x46
82 a28=x28+x35
83 b17=y17+y46
84 b28=y28+y35
85 c17=z17+z46
86 c28=z28+z35
87 sx=a17+a28
88 sy=b17+b28
89 sz=c17+c28
90 tx=a17-a28
91 ty=b17-b28
92 tz=c17-c28
93c~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
94c norme r s t
95c~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
96 aa = sqrt(rx*rx + ry*ry + rz*rz)
97 if ( aa/=zero) aa = one / aa
98 rx = rx * aa
99 ry = ry * aa
100 rz = rz * aa
101 aa = sqrt(sx*sx + sy*sy + sz*sz)
102 if ( aa/=zero) aa = one / aa
103 sx = sx * aa
104 sy = sy * aa
105 sz = sz * aa
106 aa = sqrt(tx*tx + ty*ty + tz*tz)
107 if ( aa/=zero) aa = one / aa
108 tx = tx * aa
109 ty = ty * aa
110 tz = tz * aa
111c~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
112c iterations
113c~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
114 n=0
115111 CONTINUE
116 n=n+1
117c~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
118 e1x = sy * tz - sz * ty + rx
119 e1y = sz * tx - sx * tz + ry
120 e1z = sx * ty - sy * tx + rz
121c
122 e2x = ty * rz - tz * ry + sx
123 e2y = tz * rx - tx * rz + sy
124 e2z = tx * ry - ty * rx + sz
125c
126 e3x = ry * sz - rz * sy + tx
127 e3y = rz * sx - rx * sz + ty
128 e3z = rx * sy - ry * sx + tz
129c
130 bb = sqrt(e1x*e1x + e1y*e1y + e1z*e1z)
131 if ( bb/=zero) bb = one / bb
132 rx = e1x * bb
133 ry = e1y * bb
134 rz = e1z * bb
135c
136 bb = sqrt(e2x*e2x + e2y*e2y + e2z*e2z)
137 if ( bb/=zero) bb = one / bb
138 sx = e2x * bb
139 sy = e2y * bb
140 sz = e2z * bb
141c
142 bb = sqrt(e3x*e3x + e3y*e3y + e3z*e3z)
143 if ( bb/=zero) bb = one / bb
144 tx = e3x * bb
145 ty = e3y * bb
146 tz = e3z * bb
147c
148 IF (n<niter) GOTO 111
149c norme et orthogonalisation
150c~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
151 e1x = rx
152 e1y = ry
153 e1z = rz
154c
155 e3x = e1y * sz - e1z * sy
156 e3y = e1z * sx - e1x * sz
157 e3z = e1x * sy - e1y * sx
158c
159 aa = sqrt(e3x*e3x + e3y*e3y + e3z*e3z)
160 if ( aa/=zero) aa = one / aa
161 e3x = e3x * aa
162 e3y = e3y * aa
163 e3z = e3z * aa
164c
165 e2x = e3y * e1z - e3z * e1y
166 e2y = e3z * e1x - e3x * e1z
167 e2z = e3x * e1y - e3y * e1x
168c~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
169 RETURN
170 END
my_real
#define my_real
Definition cppsort.cpp:32
sortho31
subroutine sortho31(x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z)
Definition sortho31.F:34