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!|| s6zrcoor3 ../engine/source/elements/solid/solide6z/s6zrcoor3.F90
32!|| scoor3 ../engine/source/elements/solid/solide/scoor3.F
33!|| srcoor3 ../engine/source/elements/solid/solide/srcoor3.F
34!|| srcoork ../engine/source/elements/solid/solide8z/srcoork.F
35!||====================================================================
36 SUBROUTINE sorthdir3(
37 1 RX, RY, RZ, SX,
38 2 SY, SZ, TX, TY,
39 3 TZ, E1X, E2X, E3X,
40 4 E1Y, E2Y, E3Y, E1Z,
41 5 E2Z, E3Z, GAMA0, GAMA,
42 6 NEL, IREP)
43C-----------------------------------------------
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46#include "implicit_f.inc"
47C-----------------------------------------------
48C G l o b a l P a r a m e t e r s
49C-----------------------------------------------
50#include "mvsiz_p.inc"
51C-----------------------------------------------
52C D u m m y A r g u m e n t s
53C-----------------------------------------------
54 INTEGER, INTENT(IN) :: NEL
55 INTEGER, INTENT(IN) :: IREP
56 my_real, DIMENSION(NEL), INTENT(IN) ::
57 . RX, RY, RZ, SX, SY, SZ, TX, TY, TZ,
58 . E1X, E1Y, E1Z, E2X, E2Y, E2Z, E3X, E3Y, E3Z
59 my_real,
60 . DIMENSION(NEL,6), INTENT(IN) :: gama0
61 my_real,
62 . DIMENSION(MVSIZ,6), INTENT(OUT) :: gama
63C-----------------------------------------------
64C C o m m o n B l o c k s
65C-----------------------------------------------
66C-----------------------------------------------
67C L o c a l V a r i a b l e s
68C-----------------------------------------------
69 INTEGER I
70C REAL
71 my_real
72 . UX,UY,UZ,VX,VY,VZ,D1,D2,D3,SUMA
73C=======================================================================
74 IF (IREP == 0) then
75 DO i=1,nel
76 gama(i,1) = gama0(i,1)
77 gama(i,2) = gama0(i,2)
78 gama(i,3) = gama0(i,3)
79 gama(i,4) = gama0(i,4)
80 gama(i,5) = gama0(i,5)
81 gama(i,6) = gama0(i,6)
82 ENDDO
83 ELSEIF (irep > 0) THEN
84ctmp ELSEIF (IREP == 1) THEN
85C dir 1 = const
86 DO i=1,nel
87C Dir 1
88
89 d1 = gama0(i,1)*rx(i) + gama0(i,2)*sx(i) + gama0(i,3)*tx(i)
90 d2 = gama0(i,1)*ry(i) + gama0(i,2)*sy(i) + gama0(i,3)*ty(i)
91 d3 = gama0(i,1)*rz(i) + gama0(i,2)*sz(i) + gama0(i,3)*tz(i) !DIRECTION1 DS GLOBAL
92 ! ISO -> ELEM
93 ux = d1*e1x(i)+ d2*e1y(i) + d3*e1z(i)
94 uy = d1*e2x(i)+ d2*e2y(i) + d3*e2z(i)
95 uz = d1*e3x(i)+ d2*e3y(i) + d3*e3z(i) ! COORD DU ORTHO DS ELEME
96 suma = one/sqrt(ux*ux + uy*uy + uz*uz)
97 gama(i,1) = ux*suma
98 gama(i,2) = uy*suma
99 gama(i,3) = uz*suma
100C Dir 2
101 d1 = gama0(i,4)*rx(i) + gama0(i,5)*sx(i) + gama0(i,6)*tx(i)
102 d2 = gama0(i,4)*ry(i) + gama0(i,5)*sy(i) + gama0(i,6)*ty(i)
103 d3 = gama0(i,4)*rz(i) + gama0(i,5)*sz(i) + gama0(i,6)*tz(i)
104 vx = d1*e1x(i)+ d2*e1y(i) + d3*e1z(i)
105 vy = d1*e2x(i)+ d2*e2y(i) + d3*e2z(i)
106 vz = d1*e3x(i)+ d2*e3y(i) + d3*e3z(i)
107 suma = one/sqrt(vx*vx + vy*vy + vz*vz)
108 vx = vx*suma
109 vy = vy*suma
110 vz = vz*suma
111C Orthogonalisation:
112C Dir1' = Dir1, Dir3 = Dir1 x Dir2, Dir2' = Dir3 x Dir1
113C WE WANT THE 3RD DIRECTION OF GAMA (ELEM -> ORTHO)
114 d1 = gama(i,2) * vz - gama(i,3) * vy
115 d2 = gama(i,3) * vx - gama(i,1) * vz
116 d3 = gama(i,1) * vy - gama(i,2) * vx
117 gama(i,4) = d2 * gama(i,3) - d3 * gama(i,2)
118 gama(i,5) = d3 * gama(i,1) - d1 * gama(i,3)
119 gama(i,6) = d1 * gama(i,2) - d2 * gama(i,1)
120
121 ENDDO
122c ELSEIF (IREP == 2) THEN
123C Plan (dir1,dir2) = const
124c DO I=1,NEL
125C Dir 1 - Normal in terms of
126c D1 = GAMA0(I,1)*RX(I) + GAMA0(I,2)*SX(I) + GAMA0(I,3)*TX(I)
127c D2 = GAMA0(I,1)*RY(I) + GAMA0(I,2)*SY(I) + GAMA0(I,3)*TY(I)
128c D3 = GAMA0(I,1)*RZ(I) + GAMA0(I,2)*SZ(I) + GAMA0(I,3)*TZ(I)
129c UX = D1*E1X(I)+ D2*E1Y(I) + D3*E1Z(I)
130c UY = D1*E2X(I)+ D2*E2Y(I) + D3*E2Z(I)
131c UZ = D1*E3X(I)+ D2*E3Y(I) + D3*E3Z(I)
132c SUM= ONE/SQRT(UX*UX + UY*UY + UZ*UZ)
133c UX = UX*S2
134c UY = UY*S2
135c UZ = UZ*S2
136C Dir 2
137c D1 = GAMA0(I,4)*RX(I) + GAMA0(I,5)*SX(I) + GAMA0(I,6)*TX(I)
138c D2 = GAMA0(I,4)*RY(I) + GAMA0(I,5)*SY(I) + GAMA0(I,6)*TY(I)
139c D3 = GAMA0(I,4)*RZ(I) + GAMA0(I,5)*SZ(I) + GAMA0(I,6)*TZ(I)
140c VX = D1*E1X(I)+ D2*E1Y(I) + D3*E1Z(I)
141c VY = D1*E2X(I)+ D2*E2Y(I) + D3*E2Z(I)
142c VZ = D1*E3X(I)+ D2*E3Y(I) + D3*E3Z(I)
143c S2 = ONE/SQRT(VX*VX + VY*VY + VZ*VZ)
144c VX = VX*S2
145c VY = VY*S2
146c VZ = VZ*S2
147C Dir 3
148c UX = VY*WZ - VZ*WY
149c UY = VZ*WX - VX*WZ
150c UZ = VX*WY - VY*WX
151c
152c D1 = GAMA0(I,7)*RX(I) + GAMA0(I,8)*SX(I) + GAMA0(I,9)*TX(I)
153c D2 = GAMA0(I,7)*RY(I) + GAMA0(I,8)*SY(I) + GAMA0(I,9)*TY(I)
154c D3 = GAMA0(I,7)*RZ(I) + GAMA0(I,8)*SZ(I) + GAMA0(I,9)*TZ(I)
155c WX = D1*E1X(I)+ D2*E1Y(I) + D3*E1Z(I)
156c WY = D1*E2X(I)+ D2*E2Y(I) + D3*E2Z(I)
157c WZ = D1*E3X(I)+ D2*E3Y(I) + D3*E3Z(I)
158c S3 = ONE/SQRT(WX*WX + WY*WY + WZ*WZ)
159c WX = WX*S3
160c WY = WY*S3
161c WZ = WZ*S3
162C Dir 1 = Dir2 x Dir3
163c UX = VY*WZ - VZ*WY
164c UY = VZ*WX - VX*WZ
165c UZ = VX*WY - VY*WX
166C Orthogonalization of the dir2/dir3 base :
167C Dir2'/Dir3' = dir2/dir3 orthogonalize symmetriquement, Dir1=Dir3xDir2
168c SUMA = SQRT(S2/S3)
169c D1 = VX + (WY*UZ-WZ*UY)*SUMA
170c D2 = VY + (WZ*UX-WX*UZ)*SUMA
171c D3 = VZ + (WX*UY-WY*UX)*SUMA
172c SUMA = ONE/SQRT(D1*D1 + D2*D2 + D3*D3)
173c SUMA = ONE / MAX(SQRT(SUMA),EM20)
174c GAMA(1,I) = UX
175c GAMA(2,I) = UY
176c GAMA(3,I) = UZ
177c GAMA(4,I) = D1 * SUMA
178c GAMA(5,I) = D2 * SUMA
179c GAMA(6,I) = D3 * SUMA
180c ENDDO
181 ENDIF
182C-------------
183 RETURN
184 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:43