OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
facnor.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!|| facnor ../engine/source/output/anim/generate/facnor.F
25!||--- called by ------------------------------------------------------
26!|| parsorc ../engine/source/output/anim/generate/parsorc.F
27!||====================================================================
28 SUBROUTINE facnor(X,D,II,XNORM,CDG,INVERT)
29C-----------------------------------------------
30C I m p l i c i t T y p e s
31C-----------------------------------------------
32#include "implicit_f.inc"
33C-----------------------------------------------
34C D u m m y A r g u m e n t s
35C-----------------------------------------------
36C REAL
38 . x(3,*),d(3,*),xnorm(3,*),cdg(*)
39 INTEGER II(4),INVERT
40C REAL
42 . x0(4),y0(4),z0(4),nx,ny,nz,xc,yc,zc,s
43 INTEGER I,I1,I2,I3,I4
44C-----------------------------------------------
45C FACE NORMAL
46C-----------------------------------------------
47 DO 100 i = 1,4
48 x0(i) = x(1,ii(i))-d(1,ii(i))
49 y0(i) = x(2,ii(i))-d(2,ii(i))
50 z0(i) = x(3,ii(i))-d(3,ii(i))
51 100 CONTINUE
52C
53 nx = (y0(3) - y0(1)) * (z0(4) - z0(2)) -
54 . (z0(3) - z0(1)) * (y0(4) - y0(2))
55 ny = (z0(3) - z0(1)) * (x0(4) - x0(2)) -
56 . (x0(3) - x0(1)) * (z0(4) - z0(2))
57 nz = (x0(3) - x0(1)) * (y0(4) - y0(2)) -
58 . (y0(3) - y0(1)) * (x0(4) - x0(2))
59C
60 xc = .25*(x0(1) + x0(2) + x0(3) + x0(4))
61 yc = .25*(y0(1) + y0(2) + y0(3) + y0(4))
62 zc = .25*(z0(1) + z0(2) + z0(3) + z0(4))
63 xc = xc - cdg(1)
64 yc = yc - cdg(2)
65 zc = zc - cdg(3)
66 s = nx * xc + ny * yc + nz * zc
67 invert = 1
68c IF(S<ZERO)THEN
69c INVERT = -1
70c I1 = II(2)
71c I2 = II(1)
72c I3 = II(4)
73c I4 = II(3)
74c II(1) = I1
75c II(2) = I2
76c II(3) = I3
77c II(4) = I4
78c ENDIF
79C
80 DO 200 i = 1,4
81 x0(i) = x(1,ii(i))
82 y0(i) = x(2,ii(i))
83 z0(i) = x(3,ii(i))
84 200 CONTINUE
85C
86 nx = (y0(3) - y0(1)) * (z0(4) - z0(2)) -
87 . (z0(3) - z0(1)) * (y0(4) - y0(2))
88 ny = (z0(3) - z0(1)) * (x0(4) - x0(2)) -
89 . (x0(3) - x0(1)) * (z0(4) - z0(2))
90 nz = (x0(3) - x0(1)) * (y0(4) - y0(2)) -
91 . (y0(3) - y0(1)) * (x0(4) - x0(2))
92C
93 DO 300 i = 1,4
94 xnorm(1,ii(i)) = xnorm(1,ii(i)) + nx
95 xnorm(2,ii(i)) = xnorm(2,ii(i)) + ny
96 xnorm(3,ii(i)) = xnorm(3,ii(i)) + nz
97 300 CONTINUE
98C
99C-----------------------------------------------
100 RETURN
101 END
102C
#define my_real
Definition cppsort.cpp:32
subroutine facnor(x, d, ii, xnorm, cdg, invert)
Definition facnor.F:29