OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
snorm3t.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!|| snorm3t ../engine/source/multifluid/snorm3t.f
25!||--- called by ------------------------------------------------------
26!|| multi_face_elem_data ../engine/source/multifluid/multi_face_data_elem.F
27!|| multi_fvm2fem ../engine/source/multifluid/multi_fvm2fem.F
28!||--- calls -----------------------------------------------------
29!|| arret ../engine/source/system/arret.F
30!||====================================================================
31 SUBROUTINE snorm3t (NEL, NFT, JALE, IXS, XGRID, WGRID,
32 . NORM, WFAC, SURF)
33C-----------------------------------------------
34C D e s c r i p t i o n
35C-----------------------------------------------
36C Computes normal vector to the faces of each element in a group
37C for a 3d solid element (hence Snorm3)
38C-----------------------------------------------
39C I m p l i c i t T y p e s
40C-----------------------------------------------
41#include "implicit_f.inc"
42C-----------------------------------------------
43C C o m m o n B l o c k s
44C-----------------------------------------------
45! NIXS
46C-----------------------------------------------
47C D u m m y A r g u m e n t s
48C-----------------------------------------------
49 INTEGER, INTENT(IN) :: NEL, NFT, JALE, IXS(NIXS, *)
50 my_real, INTENT(IN) ::
51 . xgrid(3, *), wgrid(*)
52 my_real, INTENT(OUT) :: wfac(3, 6, nel), surf(6, nel)
53 my_real, INTENT(OUT), TARGET :: norm(3, 6, nel)
54C-----------------------------------------------
55C L o c a l V a r i a b l e s
56C-----------------------------------------------
57 INTEGER :: II, NODE1, NODE2, NODE3, NODE4, KFACE
58 my_real
59 . x1(3), x2(3), x3(3), x4(3),
60 . w1(3), w2(3), w3(3), w4(3), xc(3), xf(3)
61 my_real, POINTER :: nx, ny, nz
62
63 DO ii = 1, nel
64C Nodes of the element locally stored in NODE* for memory access
65 node1 = ixs(2, ii + nft)
66 node2 = ixs(4, ii + nft)
67 node3 = ixs(7, ii + nft)
68 node4 = ixs(6, ii + nft)
69C Node coordinates
70 x1(1:3) = xgrid(1:3, node1)
71 x2(1:3) = xgrid(1:3, node2)
72 x3(1:3) = xgrid(1:3, node3)
73 x4(1:3) = xgrid(1:3, node4)
74
75 xc(1:3) = fourth * (x1(1:3) + x2(1:3) + x3(1:3) + x4(1:3))
76 IF (jale /= 0) THEN
77C Node grid velocities
78 w1(1:3) = wgrid(3 * (node1 - 1) + 1 : 3 * (node1 - 1) + 3)
79 w2(1:3) = wgrid(3 * (node2 - 1) + 1 : 3 * (node2 - 1) + 3)
80 w3(1:3) = wgrid(3 * (node3 - 1) + 1 : 3 * (node3 - 1) + 3)
81 w4(1:3) = wgrid(3 * (node4 - 1) + 1 : 3 * (node4 - 1) + 3)
82 ELSE
83! Euler
84 w1(1:3) = zero
85 w2(1:3) = zero
86 w3(1:3) = zero
87 w4(1:3) = zero
88 ENDIF
89C Face normal
90C Face 1 -> nodes 1 2 3
91 kface = 5
92 norm(1, kface, ii) = half * ((x3(2) - x1(2)) * (x2(3) - x1(3)) -
93 . (x3(3) - x1(3)) * (x2(2) - x1(2)))
94 norm(2, kface, ii) = half * ((x3(3) - x1(3)) * (x2(1) - x1(1)) -
95 . (x3(1) - x1(1)) * (x2(3) - x1(3)))
96 norm(3, kface, ii) = half * ((x3(1) - x1(1)) * (x2(2) - x1(2)) -
97 . (x3(2) - x1(2)) * (x2(1) - x1(1)))
98 nx => norm(1, kface, ii)
99 ny => norm(2, kface, ii)
100 nz => norm(3, kface, ii)
101 surf(kface, ii) = sqrt(nx * nx + ny * ny + nz * nz)
102 nx = -nx / surf(kface, ii)
103 ny = -ny / surf(kface, ii)
104 nz = -nz / surf(kface, ii)
105 xf(1:3) = third * (x1 + x2 + x3)
106 IF ((xf(1) - xc(1)) * nx + (xf(2) - xc(2)) * ny + (xf(3) - xc(3)) * nz < zero) THEN
107 CALL arret(2)
108 ENDIF
109C Face 2
110 kface = 6
111 norm(1, kface, ii) = half * ((x1(2) - x4(2)) * (x2(3) - x4(3)) -
112 . (x1(3) - x4(3)) * (x2(2) - x4(2)))
113 norm(2, kface, ii) = half * ((x1(3) - x4(3)) * (x2(1) - x4(1)) -
114 . (x1(1) - x4(1)) * (x2(3) - x4(3)))
115 norm(3, kface, ii) = half * ((x1(1) - x4(1)) * (x2(2) - x4(2)) -
116 . (x1(2) - x4(2)) * (x2(1) - x4(1)))
117 nx => norm(1, kface, ii)
118 ny => norm(2, kface, ii)
119 nz => norm(3, kface, ii)
120 surf(kface, ii) = sqrt(nx * nx + ny * ny + nz * nz)
121 nx = -nx / surf(kface, ii)
122 ny = -ny / surf(kface, ii)
123 nz = -nz / surf(kface, ii)
124 xf(1:3) = third * (x1 + x2 + x4)
125 IF ((xf(1) - xc(1)) * nx + (xf(2) - xc(2)) * ny + (xf(3) - xc(3)) * nz < zero) THEN
126 CALL arret(2)
127 ENDIF
128C Face 3
129 kface = 2
130 norm(1, kface, ii) = half * ((x2(2) - x4(2)) * (x3(3) - x4(3)) -
131 . (x2(3) - x4(3)) * (x3(2) - x4(2)))
132 norm(2, kface, ii) = half * ((x2(3) - x4(3)) * (x3(1) - x4(1)) -
133 . (x2(1) - x4(1)) * (x3(3) - x4(3)))
134 norm(3, kface, ii) = half * ((x2(1) - x4(1)) * (x3(2) - x4(2)) -
135 . (x2(2) - x4(2)) * (x3(1) - x4(1)))
136 nx => norm(1, kface, ii)
137 ny => norm(2, kface, ii)
138 nz => norm(3, kface, ii)
139 surf(kface, ii) = sqrt(nx * nx + ny * ny + nz * nz)
140 nx = -nx / surf(kface, ii)
141 ny = -ny / surf(kface, ii)
142 nz = -nz / surf(kface, ii)
143 xf(1:3) = third * (x4 + x2 + x3)
144 IF ((xf(1) - xc(1)) * nx + (xf(2) - xc(2)) * ny + (xf(3) - xc(3)) * nz < zero) THEN
145 CALL arret(2)
146 ENDIF
147C Face 4
148 kface = 4
149 norm(1, kface, ii) = half * ((x3(2) - x4(2)) * (x1(3) - x4(3)) -
150 . (x3(3) - x4(3)) * (x1(2) - x4(2)))
151 norm(2, kface, ii) = half * ((x3(3) - x4(3)) * (x1(1) - x4(1)) -
152 . (x3(1) - x4(1)) * (x1(3) - x4(3)))
153 norm(3, kface, ii) = half * ((x3(1) - x4(1)) * (x1(2) - x4(2)) -
154 . (x3(2) - x4(2)) * (x1(1) - x4(1)))
155 nx => norm(1, kface, ii)
156 ny => norm(2, kface, ii)
157 nz => norm(3, kface, ii)
158 surf(kface, ii) = sqrt(nx * nx + ny * ny + nz * nz)
159 nx = -nx / surf(kface, ii)
160 ny = -ny / surf(kface, ii)
161 nz = -nz / surf(kface, ii)
162 xf(1:3) = third * (x1 + x4 + x3)
163 IF ((xf(1) - xc(1)) * nx + (xf(2) - xc(2)) * ny + (xf(3) - xc(3)) * nz < zero) THEN
164 CALL arret(2)
165 ENDIF
166C Face grid velocity 1
167 wfac(1:3, 5, ii) = third * (w1(1:3) + w2(1:3) + w3(1:3))
168C Face grid velocity 2
169 wfac(1:3, 6, ii) = third * (w1(1:3) + w4(1:3) + w2(1:3))
170C Face grid velocity 3
171 wfac(1:3, 2, ii) = third * (w2(1:3) + w4(1:3) + w3(1:3))
172C Face grid velocity 4
173 wfac(1:3, 4, ii) = third * (w1(1:3) + w3(1:3) + w4(1:3))
174C Nullify quantities for KFACE = 1, 3
175 wfac(1:3, 1, ii) = zero
176 wfac(1:3, 3, ii) = zero
177 surf(1, ii) = zero
178 surf(3, ii) = zero
179 norm(1:3, 1, ii) = zero
180 norm(1:3, 3, ii) = zero
181 ENDDO
182 END SUBROUTINE snorm3t
my_real
#define my_real
Definition cppsort.cpp:32
norm
norm(diag(diag(diag(inv(mat))) -id.SOL), 2) % destroy mumps instance id.JOB
snorm3t
subroutine snorm3t(nel, nft, jale, ixs, xgrid, wgrid, norm, wfac, surf)
Definition snorm3t.F:33
arret
subroutine arret(nn)
Definition arret.F:87