OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sorthdir3.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!|| sorthdir3 ../engine/source/elements/solid/solide/sorthdir3.F
25!||--- called by ------------------------------------------------------
26!|| s10forc3 ../engine/source/elements/solid/solide10/s10forc3.F
27!|| s10ke3 ../engine/source/elements/solid/solide10/s10ke3.F
28!|| s20ke3 ../engine/source/elements/solid/solide20/s20ke3.F
29!|| s4forc3 ../engine/source/elements/solid/solide4/s4forc3.F
30!|| s4ke3 ../engine/source/elements/solid/solide4/s4ke3.F
31!|| scoor3 ../engine/source/elements/solid/solide/scoor3.F
32!|| srcoor3 ../engine/source/elements/solid/solide/srcoor3.f
33!|| srcoork ../engine/source/elements/solid/solide8z/srcoork.F
34!||====================================================================
35 SUBROUTINE sorthdir3(
36 1 RX, RY, RZ, SX,
37 2 SY, SZ, TX, TY,
38 3 TZ, E1X, E2X, E3X,
39 4 E1Y, E2Y, E3Y, E1Z,
40 5 E2Z, E3Z, GAMA0, GAMA,
41 6 NEL, IREP)
42C-----------------------------------------------
43C I m p l i c i t T y p e s
44C-----------------------------------------------
45#include "implicit_f.inc"
46C-----------------------------------------------
47C G l o b a l P a r a m e t e r s
48C-----------------------------------------------
49#include "mvsiz_p.inc"
50C-----------------------------------------------
51C D u m m y A r g u m e n t s
52C-----------------------------------------------
53 INTEGER, INTENT(IN) :: NEL
54 INTEGER, INTENT(IN) :: IREP
55 my_real, DIMENSION(NEL), INTENT(IN) ::
56 . RX, RY, RZ, SX, SY, SZ, TX, TY, TZ,
57 . E1X, E1Y, E1Z, E2X, E2Y, E2Z, E3X, E3Y, E3Z
58 my_real,
59 . DIMENSION(NEL,6), INTENT(IN) :: gama0
60 my_real,
61 . DIMENSION(MVSIZ,6), INTENT(OUT) :: gama
62C-----------------------------------------------
63C C o m m o n B l o c k s
64C-----------------------------------------------
65C-----------------------------------------------
66C L o c a l V a r i a b l e s
67C-----------------------------------------------
68 INTEGER I
69C REAL
70 my_real
71 . UX,UY,UZ,VX,VY,VZ,WX,WY,WZ,D1,D2,D3,GX,GY,GZ,SUMA,S2,S3
72C=======================================================================
73 IF (IREP == 0) then
74 DO i=1,nel
75 gama(i,1) = gama0(i,1)
76 gama(i,2) = gama0(i,2)
77 gama(i,3) = gama0(i,3)
78 gama(i,4) = gama0(i,4)
79 gama(i,5) = gama0(i,5)
80 gama(i,6) = gama0(i,6)
81 ENDDO
82 ELSEIF (irep > 0) THEN
83ctmp ELSEIF (IREP == 1) THEN
84C dir 1 = const
85 DO i=1,nel
86C Dir 1
87
88 d1 = gama0(i,1)*rx(i) + gama0(i,2)*sx(i) + gama0(i,3)*tx(i)
89 d2 = gama0(i,1)*ry(i) + gama0(i,2)*sy(i) + gama0(i,3)*ty(i)
90 d3 = gama0(i,1)*rz(i) + gama0(i,2)*sz(i) + gama0(i,3)*tz(i) !DIRECTION1 DS GLOBAL
91 ! ISO -> ELEM
92 ux = d1*e1x(i)+ d2*e1y(i) + d3*e1z(i)
93 uy = d1*e2x(i)+ d2*e2y(i) + d3*e2z(i)
94 uz = d1*e3x(i)+ d2*e3y(i) + d3*e3z(i) ! COORD DU ORTHO DS ELEME
95 suma = one/sqrt(ux*ux + uy*uy + uz*uz)
96 gama(i,1) = ux*suma
97 gama(i,2) = uy*suma
98 gama(i,3) = uz*suma
99C Dir 2
100 d1 = gama0(i,4)*rx(i) + gama0(i,5)*sx(i) + gama0(i,6)*tx(i)
101 d2 = gama0(i,4)*ry(i) + gama0(i,5)*sy(i) + gama0(i,6)*ty(i)
102 d3 = gama0(i,4)*rz(i) + gama0(i,5)*sz(i) + gama0(i,6)*tz(i)
103 vx = d1*e1x(i)+ d2*e1y(i) + d3*e1z(i)
104 vy = d1*e2x(i)+ d2*e2y(i) + d3*e2z(i)
105 vz = d1*e3x(i)+ d2*e3y(i) + d3*e3z(i)
106 suma = one/sqrt(vx*vx + vy*vy + vz*vz)
107 vx = vx*suma
108 vy = vy*suma
109 vz = vz*suma
110C Orthogonalisation:
111C Dir1' = Dir1, Dir3 = Dir1 x Dir2, Dir2' = Dir3 x Dir1
112C ON VEUT LA 3EME DIRECTION DE GAMA (ELEM -> ORTHO)
113 d1 = gama(i,2) * vz - gama(i,3) * vy
114 d2 = gama(i,3) * vx - gama(i,1) * vz
115 d3 = gama(i,1) * vy - gama(i,2) * vx
116 gama(i,4) = d2 * gama(i,3) - d3 * gama(i,2)
117 gama(i,5) = d3 * gama(i,1) - d1 * gama(i,3)
118 gama(i,6) = d1 * gama(i,2) - d2 * gama(i,1)
119
120 ENDDO
121c ELSEIF (IREP == 2) THEN
122C Plan (dir1,dir2) = const
123c DO I=1,NEL
124C Dir 1 - normale au plan
125c D1 = GAMA0(I,1)*RX(I) + GAMA0(I,2)*SX(I) + GAMA0(I,3)*TX(I)
126c D2 = GAMA0(I,1)*RY(I) + GAMA0(I,2)*SY(I) + GAMA0(I,3)*TY(I)
127c D3 = GAMA0(I,1)*RZ(I) + GAMA0(I,2)*SZ(I) + GAMA0(I,3)*TZ(I)
128c UX = D1*E1X(I)+ D2*E1Y(I) + D3*E1Z(I)
129c UY = D1*E2X(I)+ D2*E2Y(I) + D3*E2Z(I)
130c UZ = D1*E3X(I)+ D2*E3Y(I) + D3*E3Z(I)
131c SUM= ONE/SQRT(UX*UX + UY*UY + UZ*UZ)
132c UX = UX*S2
133c UY = UY*S2
134c UZ = UZ*S2
135C Dir 2
136c D1 = GAMA0(I,4)*RX(I) + GAMA0(I,5)*SX(I) + GAMA0(I,6)*TX(I)
137c D2 = GAMA0(I,4)*RY(I) + GAMA0(I,5)*SY(I) + GAMA0(I,6)*TY(I)
138c D3 = GAMA0(I,4)*RZ(I) + GAMA0(I,5)*SZ(I) + GAMA0(I,6)*TZ(I)
139c VX = D1*E1X(I)+ D2*E1Y(I) + D3*E1Z(I)
140c VY = D1*E2X(I)+ D2*E2Y(I) + D3*E2Z(I)
141c VZ = D1*E3X(I)+ D2*E3Y(I) + D3*E3Z(I)
142c S2 = ONE/SQRT(VX*VX + VY*VY + VZ*VZ)
143c VX = VX*S2
144c VY = VY*S2
145c VZ = VZ*S2
146C Dir 3
147c UX = VY*WZ - VZ*WY
148c UY = VZ*WX - VX*WZ
149c UZ = VX*WY - VY*WX
150c
151c D1 = GAMA0(I,7)*RX(I) + GAMA0(I,8)*SX(I) + GAMA0(I,9)*TX(I)
152c D2 = GAMA0(I,7)*RY(I) + GAMA0(I,8)*SY(I) + GAMA0(I,9)*TY(I)
153c D3 = GAMA0(I,7)*RZ(I) + GAMA0(I,8)*SZ(I) + GAMA0(I,9)*TZ(I)
154c WX = D1*E1X(I)+ D2*E1Y(I) + D3*E1Z(I)
155c WY = D1*E2X(I)+ D2*E2Y(I) + D3*E2Z(I)
156c WZ = D1*E3X(I)+ D2*E3Y(I) + D3*E3Z(I)
157c S3 = ONE/SQRT(WX*WX + WY*WY + WZ*WZ)
158c WX = WX*S3
159c WY = WY*S3
160c WZ = WZ*S3
161C Dir 1 = Dir2 x Dir3
162c UX = VY*WZ - VZ*WY
163c UY = VZ*WX - VX*WZ
164c UZ = VX*WY - VY*WX
165C Orthogonalisation de la base dir2/dir3 :
166C Dir2'/Dir3' = dir2/dir3 orthogonalize symmetriquement, Dir1=Dir3xDir2
167c SUMA = SQRT(S2/S3)
168c D1 = VX + (WY*UZ-WZ*UY)*SUMA
169c D2 = VY + (WZ*UX-WX*UZ)*SUMA
170c D3 = VZ + (WX*UY-WY*UX)*SUMA
171c SUMA = ONE/SQRT(D1*D1 + D2*D2 + D3*D3)
172c SUMA = ONE / MAX(SQRT(SUMA),EM20)
173c GAMA(1,I) = UX
174c GAMA(2,I) = UY
175c GAMA(3,I) = UZ
176c GAMA(4,I) = D1 * SUMA
177c GAMA(5,I) = D2 * SUMA
178c GAMA(6,I) = D3 * SUMA
179c ENDDO
180 ENDIF
181C-------------
182 RETURN
183 END SUBROUTINE sorthdir3
sorthdir3
subroutine sorthdir3(rx, ry, rz, sx, sy, sz, tx, ty, tz, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z, gama0, gama, nel, irep)
Definition sorthdir3.F:42
srcoor3
subroutine srcoor3(x, xrefs, ixs, geo, mxt, ngeo, ngl, jhbe, ix1, ix2, ix3, ix4, ix5, ix6, ix7, ix8, x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, rx, ry, rz, sx, sy, sz, tx, ty, tz, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z, f1x, f1y, f1z, f2x, f2y, f2z, temp0, temp, nintemp, xd1, xd2, xd3, xd4, xd5, xd6, xd7, xd8, yd1, yd2, yd3, yd4, yd5, yd6, yd7, yd8, zd1, zd2, zd3, zd4, zd5, zd6, zd7, zd8)
Definition srcoor3.F:52