OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
alemuscl_upwind2.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_upwind2 ../engine/source/ale/alemuscl/alemuscl_upwind2.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!|| element_mod ../common_source/modules/elements/element_mod.F90
31!|| i22bufbric_mod ../common_source/modules/interfaces/cut-cell-search_mod.F
32!|| i22tri_mod ../common_source/modules/interfaces/cut-cell-search_mod.F
33!|| segvar_mod ../engine/share/modules/segvar_mod.F
34!||====================================================================
35 SUBROUTINE alemuscl_upwind2(FLUX, ALE_CONNECT, X, IXQ, FLUX_VOIS,
36 . N4_VOIS, ITAB, NV46, ITRIMAT, SEGVAR)
37C-----------------------------------------------
38C D e s c r i p t i o n
39C This subroutines performs the following steps:
40C 1 - compute a gradient for volume fraction ALPH
41C (calls GRADIENT_RECONSTRUCTION)
42C 2 - reconstruct a value for volume fraction on each edge of the mesh
43C based on an affine approximation
44C 3 - upwind this value on the edge and store it in the flux
45C-----------------------------------------------
47 USE i22tri_mod
49 USE segvar_mod
51 use element_mod , only :nixq
52C-----------------------------------------------
53C I m p l i c i t T y p e s
54C-----------------------------------------------
55#include "implicit_f.inc"
56C-----------------------------------------------
57C C o m m o n B l o c k s
58C-----------------------------------------------
59#include "spmd_c.inc"
60#include "vect01_c.inc"
61#include "com04_c.inc"
62C-----------------------------------------------
63C D u m m y A r g u m e n t s
64C-----------------------------------------------
65 INTEGER, INTENT(IN) :: NV46
66 my_real, INTENT(OUT) :: flux(nv46, *)
67 my_real, INTENT(IN) :: x(3, numnod)
68 INTEGER, INTENT(IN) :: IXQ(NIXQ, NUMELQ)
69 my_real, INTENT(OUT) :: flux_vois(numelq+nqvois, nv46)
70 INTEGER, INTENT(OUT) :: N4_VOIS(NUMELQ+NQVOIS,8)
71 INTEGER, INTENT(IN) :: ITAB(NUMNOD)
72 INTEGER, INTENT(IN) :: ITRIMAT
73 TYPE(t_segvar),INTENT(IN) :: SEGVAR
74 TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECT
75C-----------------------------------------------
76C L o c a l V a r i a b l e s
77C-----------------------------------------------
78 INTEGER :: I, II, KK, JJ, IAD2, IAD3
79 INTEGER :: NEIGHBOOR_LIST(NV46), FACE_NEIGHBOOR(NV46)
80 my_real :: alphak
81 my_real :: yk, zk
82 my_real :: yf, zf
83 INTEGER :: FACE_TO_NODE_LOCAL_ID(4, 2), NODEID1, NODEID2
84C-----------------------------------------------
85C S o u r c e L i n e s
86C-----------------------------------------------
87!!! Once for all, associate node local id to a face number
88!!! Face 1
89 face_to_node_local_id(1, 1) = 1 ; face_to_node_local_id(1, 2) = 2
90!!! Face 2
91 face_to_node_local_id(2, 1) = 2 ; face_to_node_local_id(2, 2) = 3
92!!! Face 3
93 face_to_node_local_id(3, 1) = 3 ; face_to_node_local_id(3, 2) = 4
94!!! Face 4
95 face_to_node_local_id(4, 1) = 4 ; face_to_node_local_id(4, 2) = 1
96!!! First of all, compute gradient for alpha
97 DO i = lft, llt
98 ii = i + nft
99 iad2 = ale_connect%ee_connect%iad_connect(ii)
100 !!!centroid element
101 yk = alemuscl_buffer%ELCENTER(ii,2) ;
102 zk = alemuscl_buffer%ELCENTER(ii,3)
103 !!! Neighbors
104 DO kk = 1, nv46
105 !!! Only for outgoing fluxes
106 IF (flux(kk, ii) > zero) THEN
107 !!! Storing neighbor indexes
108 neighboor_list(kk) = ale_connect%ee_connect%connected(iad2 + kk - 1)
109 face_neighboor(kk) = kk
110 IF (neighboor_list(kk) <= 0) THEN
111 IF(neighboor_list(kk)==0)neighboor_list(kk) = ii
112 !case <0 is for eBCS. -NEIGHBOR_LIST is then the segment number
113 ELSEIF (neighboor_list(kk) <= numelq) THEN
114 iad3 = ale_connect%ee_connect%iad_connect(neighboor_list(kk))
115 !!! Store the face number to which II and NEIGHBOR_LIST(KK) are adjacent
116 DO jj = 1, nv46
117 IF (ale_connect%ee_connect%connected(iad3 + jj - 1) == ii) THEN
118 face_neighboor(kk) = jj
119 ENDIF
120 ENDDO ! JJ = 1, NV46
121 ENDIF
122
123 nodeid1 = ixq(1 + face_to_node_local_id(kk, 1), ii)
124 nodeid2 = ixq(1 + face_to_node_local_id(kk, 2), ii)
125
126 yf = half * (x(2, nodeid1) + x(2, nodeid2))
127 zf = half * (x(3, nodeid1) + x(3, nodeid2))
128
129 !!! Reconstruct second order value for ALPHA(II) on the face
130 alphak = alemuscl_buffer%VOLUME_FRACTION(ii,itrimat)
131 . + alemuscl_buffer%GRAD(ii,2,itrimat) * (yf - yk)
132 . + alemuscl_buffer%GRAD(ii,3,itrimat) * (zf - zk)
133
134 !!! Partial volume flux is then computed as:
135 flux(kk, ii) = alphak * flux(kk, ii)
136 IF (neighboor_list(kk) > 0)THEN
137 IF (neighboor_list(kk) <= numelq) THEN
138 !!! The opposite of the flux goes to the neighbor
139 flux(face_neighboor(kk), neighboor_list(kk)) = -flux(kk, ii)
140 ELSE
141 !!! cf. ALE51_ANTIDIFF3
142 flux_vois(ii, kk) = flux(kk, ii)
143 n4_vois(ii, 1) = itab(ixq(2, ii))
144 n4_vois(ii, 2) = itab(ixq(3, ii))
145 n4_vois(ii, 3) = itab(ixq(4, ii))
146 n4_vois(ii, 4) = itab(ixq(5, ii))
147 ENDIF
148 ENDIF
149 ENDIF ! (FLUX(KK, II) > ZERO)
150 ENDDO ! KK = 1, NV46
151 ENDDO ! I = LFT, LLT
152
153C-----------------------------------------------
154C incoming flux by EBCS
155C-----------------------------------------------
156 IF(nsegflu > 0)THEN
157 DO i = lft, llt
158 ii = i + nft
159 iad2 = ale_connect%ee_connect%iad_connect(ii)
160 DO kk=1,4
161 IF(flux(kk,ii) < zero .AND. ale_connect%ee_connect%connected(iad2 + kk - 1) < 0)THEN
162 flux(kk,ii) = segvar%PHASE_ALPHA(itrimat,-ale_connect%ee_connect%connected(iad2 + kk - 1))*flux(kk,ii)
163 ENDIF
164 ENDDO
165 ENDDO
166 ENDIF
167
168C-----------------------------------------------
169 END SUBROUTINE alemuscl_upwind2
subroutine alemuscl_upwind2(flux, ale_connect, x, ixq, flux_vois, n4_vois, itab, nv46, itrimat, segvar)
#define my_real
Definition cppsort.cpp:32
type(alemuscl_buffer_) alemuscl_buffer