OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
qnorm2t.F File Reference
#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine qnorm2t (nel, nft, jale, sym, ixtg, xgrid, wgrid, norm, wfac, surf)

Function/Subroutine Documentation

◆ qnorm2t()

subroutine qnorm2t ( integer, intent(in) nel,
integer, intent(in) nft,
integer, intent(in) jale,
integer, intent(in) sym,
integer, dimension(nixtg, *), intent(in) ixtg,
dimension(3, *), intent(in) xgrid,
dimension(*), intent(in) wgrid,
dimension(3, 3, nel), target norm,
dimension(3, 3, nel), intent(out) wfac,
dimension(3, nel), intent(out) surf )

Definition at line 32 of file qnorm2t.F.

34 use element_mod , only : nixtg
35C-----------------------------------------------
36C D e s c r i p t i o n
37C-----------------------------------------------
38C Computes normal vector to the faces of each element in a group
39C for a 3d solid element (hence Snorm3)
40C-----------------------------------------------
41C I m p l i c i t T y p e s
42C-----------------------------------------------
43#include "implicit_f.inc"
44C-----------------------------------------------
45C C o m m o n B l o c k s
46C-----------------------------------------------
47! NIXTG
48C-----------------------------------------------
49C D u m m y A r g u m e n t s
50C-----------------------------------------------
51 INTEGER, INTENT(IN) :: NEL, NFT, JALE, SYM, IXTG(NIXTG, *)
52 my_real, INTENT(IN) ::
53 . xgrid(3, *), wgrid(*)
54 my_real, INTENT(OUT) :: wfac(3, 3, nel), surf(3, nel)
55 my_real, INTENT(OUT), TARGET :: norm(3, 3, nel)
56C-----------------------------------------------
57C L o c a l V a r i a b l e s
58C-----------------------------------------------
59 INTEGER :: II, NODE1, NODE2, NODE3, KFACE
60 my_real ::
61 . x1(3), x2(3), x3(3), xk(3), xf(1:3),
62 . w1(3), w2(3), w3(3)
63 my_real, POINTER :: nx, ny, nz
64
65 DO ii = 1, nel
66 node1 = ixtg(2, ii + nft)
67 node2 = ixtg(3, ii + nft)
68 node3 = ixtg(4, ii + nft)
69 x1(1:3) = xgrid(1:3, node1)
70 x2(1:3) = xgrid(1:3, node2)
71 x3(1:3) = xgrid(1:3, node3)
72 xk(1:3) = third * (x1(1:3) + x2(1:3) + x3(1:3))
73 IF (jale /= 0) THEN
74C Node grid velocities
75 w1(1:3) = wgrid(3 * (node1 - 1) + 1 : 3 * (node1 - 1) + 3)
76 w2(1:3) = wgrid(3 * (node2 - 1) + 1 : 3 * (node2 - 1) + 3)
77 w3(1:3) = wgrid(3 * (node3 - 1) + 1 : 3 * (node3 - 1) + 3)
78 ELSE ! Euler
79 w1(1:3) = zero
80 w2(1:3) = zero
81 w3(1:3) = zero
82 ENDIF
83C Face normal
84C Face 1
85 kface = 1
86 norm(1, kface, ii) = zero
87 norm(2, kface, ii) = x2(3) - x1(3)
88 norm(3, kface, ii) = -(x2(2) - x1(2))
89 nx => norm(1, kface, ii)
90 ny => norm(2, kface, ii)
91 nz => norm(3, kface, ii)
92 surf(kface, ii) = sqrt(ny * ny + nz * nz)
93 ny = ny / surf(kface, ii)
94 nz = nz / surf(kface, ii)
95 IF (sym == 1) THEN
96 surf(kface, ii) = surf(kface, ii) * half * (x1(2) + x2(2))
97 ENDIF
98 xf(1:3) = half * (x1(1:3) + x2(1:3))
99 IF (nx * (xf(1) - xk(1)) + ny * (xf(2) - xk(2)) + nz * (xf(3) - xk(3)) <= zero) THEN
100 CALL arret(2)
101 ENDIF
102C Face 2
103 kface = 2
104 norm(1, kface, ii) = zero
105 norm(2, kface, ii) = x3(3) - x2(3)
106 norm(3, kface, ii) = -(x3(2) - x2(2))
107 nx => norm(1, kface, ii)
108 ny => norm(2, kface, ii)
109 nz => norm(3, kface, ii)
110 surf(kface, ii) = sqrt(ny * ny + nz * nz)
111 ny = ny / surf(kface, ii)
112 nz = nz / surf(kface, ii)
113 IF (sym == 1) THEN
114 surf(kface, ii) = surf(kface, ii) * half * (x2(2) + x3(2))
115 ENDIF
116 xf(1:3) = half * (x2(1:3) + x3(1:3))
117 IF (nx * (xf(1) - xk(1)) + ny * (xf(2) - xk(2)) + nz * (xf(3) - xk(3)) <= zero) THEN
118 CALL arret(2)
119 ENDIF
120C Face 3
121 kface = 3
122 norm(1, kface, ii) = zero
123 norm(2, kface, ii) = x1(3) - x3(3)
124 norm(3, kface, ii) = -(x1(2) - x3(2))
125 nx => norm(1, kface, ii)
126 ny => norm(2, kface, ii)
127 nz => norm(3, kface, ii)
128 surf(kface, ii) = sqrt(ny * ny + nz * nz)
129 ny = ny / surf(kface, ii)
130 nz = nz / surf(kface, ii)
131 IF (sym == 1) THEN
132 surf(kface, ii) = surf(kface, ii) * half * (x3(2) + x1(2))
133 ENDIF
134 xf(1:3) = half * (x3(1:3) + x1(1:3))
135 IF (nx * (xf(1) - xk(1)) + ny * (xf(2) - xk(2)) + nz * (xf(3) - xk(3)) <= zero) THEN
136 CALL arret(2)
137 ENDIF
138C Face grid velocity 1
139 wfac(1:3, 1, ii) = half * (w1(1:3) + w2(1:3))
140C Face grid velocity 2
141 wfac(1:3, 2, ii) = half * (w2(1:3) + w3(1:3))
142C Face grid velocity 3
143 wfac(1:3, 3, ii) = half * (w3(1:3) + w1(1:3))
144 ENDDO
#define my_real
Definition cppsort.cpp:32
norm(diag(diag(diag(inv(mat))) -id.SOL), 2) % destroy mumps instance id.JOB
subroutine arret(nn)
Definition arret.F:86