OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
alemuscl_upwind.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!|| alemuscl_upwind ../engine/source/ale/alemuscl/alemuscl_upwind.F
25!||--- called by ------------------------------------------------------
26!|| afluxt ../engine/source/ale/ale51/afluxt.F
27!||--- uses -----------------------------------------------------
28!|| ale_connectivity_mod ../common_source/modules/ale/ale_connectivity_mod.F
29!|| alemuscl_mod ../common_source/modules/ale/alemuscl_mod.F
30!|| i22bufbric_mod ../common_source/modules/interfaces/cut-cell-search_mod.F
31!|| i22tri_mod ../common_source/modules/interfaces/cut-cell-search_mod.F
32!|| segvar_mod ../engine/share/modules/segvar_mod.F
33!||====================================================================
34 SUBROUTINE alemuscl_upwind(FLUX, ALE_CONNECT, X, IXS, FLUX_VOIS,
35 . N4_VOIS, ITAB, NV46, ITRIMAT, SEGVAR)
36C-----------------------------------------------
37C D e s c r i p t i o n
38C This subroutines performs the following steps:
39C 1 - compute a gradient for volume fraction ALPH
40C (calls GRADIENT_RECONSTRUCTION)
41C 2 - reconstruct a value for volume fraction on each edge of the mesh
42C based on an affine approximation
43C 3 - upwind this value on the edge and store it in the flux
44C-----------------------------------------------
45 USE i22bufbric_mod
46 USE i22tri_mod
47 USE alemuscl_mod
48 USE segvar_mod
49 USE ale_connectivity_mod
50C-----------------------------------------------
51C I m p l i c i t T y p e s
52C-----------------------------------------------
53#include "implicit_f.inc"
54C-----------------------------------------------
55C C o m m o n B l o c k s
56C-----------------------------------------------
57#include "spmd_c.inc"
58#include "vect01_c.inc"
59#include "com04_c.inc"
60C-----------------------------------------------
61C D u m m y A r g u m e n t s
62C-----------------------------------------------
63 INTEGER, INTENT(IN) :: NV46
64 my_real, INTENT(OUT) :: flux(nv46, *)
65 my_real, INTENT(IN) :: x(3,numnod)
66 INTEGER, INTENT(IN) :: IXS(NIXS,NUMELS)
67 my_real, INTENT(OUT) :: flux_vois(numels+nsvois, nv46)
68 INTEGER, INTENT(OUT) :: N4_VOIS(NUMELS+NSVOIS,8)
69 INTEGER, INTENT(IN) :: ITAB(NUMNOD)
70 INTEGER, INTENT(IN) :: ITRIMAT
71 TYPE(t_segvar),INTENT(IN) :: SEGVAR
72 TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECT
73C-----------------------------------------------
74C L o c a l V a r i a b l e s
75C-----------------------------------------------
76 INTEGER :: I, II, KK, JJ, IAD2, IAD3
77 INTEGER :: NEIGHBOOR_LIST(NV46), FACE_NEIGHBOOR(NV46)
78 my_real :: alphak
79 my_real :: xk, yk, zk
80 my_real :: xf, yf, zf
81 INTEGER :: FACE_TO_NODE_LOCAL_ID(6, 4)
82 my_real :: norm(3), a(3), b(3), c(3), surf, surf1, surf2
83C-----------------------------------------------
84C S o u r c e L i n e s
85C-----------------------------------------------
86!!! Once for all, associate node local id to a face number
87!!! Face 1
88 face_to_node_local_id(1, 1) = 1 ; face_to_node_local_id(1, 2) = 4
89 face_to_node_local_id(1, 3) = 3 ; face_to_node_local_id(1, 4) = 2
90!!! Face 2
91 face_to_node_local_id(2, 1) = 3 ; face_to_node_local_id(2, 2) = 4
92 face_to_node_local_id(2, 3) = 8 ; face_to_node_local_id(2, 4) = 7
93!!! Face 3
94 face_to_node_local_id(3, 1) = 5 ; face_to_node_local_id(3, 2) = 6
95 face_to_node_local_id(3, 3) = 7 ; face_to_node_local_id(3, 4) = 8
96!!! Face 4
97 face_to_node_local_id(4, 1) = 1 ; face_to_node_local_id(4, 2) = 2
98 face_to_node_local_id(4, 3) = 6 ; face_to_node_local_id(4, 4) = 5
99!!! Face 5
100 face_to_node_local_id(5, 1) = 2 ; face_to_node_local_id(5, 2) = 3
101 face_to_node_local_id(5, 3) = 7 ; face_to_node_local_id(5, 4) = 6
102!!! Face 6
103 face_to_node_local_id(6, 1) = 1 ; face_to_node_local_id(6, 2) = 5
104 face_to_node_local_id(6, 3) = 8 ; face_to_node_local_id(6, 4) = 4
105
106!!! First of all, compute gradient for alpha
107 DO i = lft, llt
108 ii = i + nft
109 iad2 = ale_connect%ee_connect%iad_connect(ii)
110 !!! Element centroid
111 xk = alemuscl_buffer%ELCENTER(ii,1) ;
112 yk = alemuscl_buffer%ELCENTER(ii,2) ;
113 zk = alemuscl_buffer%ELCENTER(ii,3)
114 !!! Neighbors
115 DO kk = 1, nv46
116 !!! Only for outgoing fluxes
117 IF (flux(kk, ii) > zero) THEN
118 !!! Storing neighbor indexes
119 neighboor_list(kk) = ale_connect%ee_connect%connected(iad2 + kk - 1)
120 face_neighboor(kk) = kk
121 IF (neighboor_list(kk) <= 0) THEN
122 IF(neighboor_list(kk)==0)neighboor_list(kk) = ii
123 !case <0 is for eBCS. -NEIGHBOR_LIST is then the segment number
124 ELSEIF (neighboor_list(kk) <= numels) THEN
125 iad3 = ale_connect%ee_connect%iad_connect(neighboor_list(kk))
126 !!! Store the face number to which II and NEIGHBOR_LIST(KK) are adjacent
127 DO jj = 1, nv46
128 IF (ale_connect%ee_connect%connected(iad3 + jj - 1) == ii) THEN
129 face_neighboor(kk) = jj
130 ENDIF
131 ENDDO ! JJ = 1, NV46
132 ENDIF
133
134 !!! Face centroid
135 xf = zero
136 yf = zero
137 zf = zero
138
139 a(1:3) = x(1:3, ixs(face_to_node_local_id(kk, 1) + 1, ii))
140 b(1:3) = x(1:3, ixs(face_to_node_local_id(kk, 2) + 1, ii))
141 c(1:3) = x(1:3, ixs(face_to_node_local_id(kk, 3) + 1, ii))
142
143 norm(1) = (b(2) - a(2)) * (c(3) - a(3)) - (b(3) - a(3)) * (c(2) - a(2))
144 norm(2) = (b(3) - a(3)) * (c(1) - a(1)) - (b(1) - a(1)) * (c(3) - a(3))
145 norm(3) = (b(1) - a(1)) * (c(2) - a(2)) - (b(2) - a(2)) * (c(1) - a(1))
146
147 surf1 = half * abs(sqrt(norm(1) * norm(1) + norm(2) * norm(2) + norm(3) * norm(3)))
148 xf = surf1 * third * (a(1) + b(1) + c(1))
149 yf = surf1 * third * (a(2) + b(2) + c(2))
150 zf = surf1 * third * (a(3) + b(3) + c(3))
151
152 a(1:3) = x(1:3, ixs(face_to_node_local_id(kk, 1) + 1, ii))
153 b(1:3) = x(1:3, ixs(face_to_node_local_id(kk, 3) + 1, ii))
154 c(1:3) = x(1:3, ixs(face_to_node_local_id(kk, 4) + 1, ii))
155
156 norm(1) = (b(2) - a(2)) * (c(3) - a(3)) - (b(3) - a(3)) * (c(2) - a(2))
157 norm(2) = (b(3) - a(3)) * (c(1) - a(1)) - (b(1) - a(1)) * (c(3) - a(3))
158 norm(3) = (b(1) - a(1)) * (c(2) - a(2)) - (b(2) - a(2)) * (c(1) - a(1))
159
160 surf2 = half * abs(sqrt(norm(1) * norm(1) + norm(2) * norm(2) + norm(3) * norm(3)))
161 xf = xf + surf2 * third * (a(1) + b(1) + c(1))
162 yf = yf + surf2 * third * (a(2) + b(2) + c(2))
163 zf = zf + surf2 * third * (a(3) + b(3) + c(3))
164
165 surf = surf1 + surf2
166 xf = xf / surf
167 yf = yf / surf
168 zf = zf / surf
169
170 !!! Reconstruct second order value for ALPHA(II) on the face
171 alphak = alemuscl_buffer%VOLUME_FRACTION(ii,itrimat)
172 . + alemuscl_buffer%GRAD(ii,1,itrimat) * (xf - xk)
173 . + alemuscl_buffer%GRAD(ii,2,itrimat) * (yf - yk)
174 . + alemuscl_buffer%GRAD(ii,3,itrimat) * (zf - zk)
175 !!! Partial volume flux is then computed as:
176 flux(kk, ii) = alphak * flux(kk, ii)
177 IF (neighboor_list(kk) > 0)THEN
178 IF (neighboor_list(kk) <= numels .AND. neighboor_list(kk) > 0) THEN
179 !!! The opposite of the flux goes to the neighboord
180 flux(face_neighboor(kk), neighboor_list(kk)) = -flux(kk, ii)
181 ELSE
182 !!! ALE51_ANTIDIFF3
183 flux_vois(ii, kk) = flux(kk, ii)
184 n4_vois(ii, 1) = itab(ixs(2, ii))
185 n4_vois(ii, 2) = itab(ixs(3, ii))
186 n4_vois(ii, 3) = itab(ixs(4, ii))
187 n4_vois(ii, 4) = itab(ixs(5, ii))
188 n4_vois(ii, 5) = itab(ixs(6, ii))
189 n4_vois(ii, 6) = itab(ixs(7, ii))
190 n4_vois(ii, 7) = itab(ixs(8, ii))
191 n4_vois(ii, 8) = itab(ixs(9, ii))
192 ENDIF
193 ENDIF
194 ENDIF ! (FLUX(KK, II) > ZERO)
195 ENDDO ! KK = 1, NV46
196 ENDDO ! i = lft, llt
197
198C-----------------------------------------------
199C incoming volume fluxes from EBCS
200C-----------------------------------------------
201 IF(nsegflu > 0)THEN
202 DO i = lft, llt
203 ii = i + nft
204 iad2 = ale_connect%ee_connect%iad_connect(ii)
205 DO kk=1,nv46
206 IF(flux(kk,ii) < zero .AND. ale_connect%ee_connect%connected(iad2 + kk - 1) < 0)THEN
207 flux(kk,ii) = segvar%PHASE_ALPHA(itrimat,-ale_connect%ee_connect%connected(iad2 + kk - 1))*flux(kk,ii)
208 ENDIF
209 ENDDO
210 ENDDO
211 ENDIF
212
213C-----------------------------------------------
214 END SUBROUTINE alemuscl_upwind
alemuscl_upwind
subroutine alemuscl_upwind(flux, ale_connect, x, ixs, flux_vois, n4_vois, itab, nv46, itrimat, segvar)
Definition alemuscl_upwind.F:36
my_real
#define my_real
Definition cppsort.cpp:32
norm
norm(diag(diag(diag(inv(mat))) -id.SOL), 2) % destroy mumps instance id.JOB
ale_connectivity_mod
Definition ale_connectivity_mod.F:223
alemuscl_mod
Definition alemuscl_mod.F:54
alemuscl_mod::alemuscl_buffer
type(alemuscl_buffer_) alemuscl_buffer
Definition alemuscl_mod.F:74
i22bufbric_mod
Definition cut-cell-search_mod.F:95
i22tri_mod
Definition cut-cell-search_mod.F:212
segvar_mod
Definition segvar_mod.F:61
ale_connectivity_mod::t_ale_connectivity
Definition ale_connectivity_mod.F:254
segvar_mod::t_segvar
Definition segvar_mod.F:69