OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
alemuscl_upwind.F File Reference
#include "implicit_f.inc"
#include "spmd_c.inc"
#include "vect01_c.inc"
#include "com04_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine alemuscl_upwind (flux, ale_connect, x, ixs, flux_vois, n4_vois, itab, nv46, itrimat, segvar)

Function/Subroutine Documentation

◆ alemuscl_upwind()

subroutine alemuscl_upwind ( dimension(nv46, *), intent(out) flux,
type(t_ale_connectivity), intent(in) ale_connect,
dimension(3,numnod), intent(in) x,
integer, dimension(nixs,numels), intent(in) ixs,
dimension(numels+nsvois, nv46), intent(out) flux_vois,
integer, dimension(numels+nsvois,8), intent(out) n4_vois,
integer, dimension(numnod), intent(in) itab,
integer, intent(in) nv46,
integer, intent(in) itrimat,
type(t_segvar), intent(in) segvar )

Definition at line 34 of file alemuscl_upwind.F.

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-----------------------------------------------
46 USE i22tri_mod
47 USE alemuscl_mod
48 USE segvar_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-----------------------------------------------
#define my_real
Definition cppsort.cpp:32
norm(diag(diag(diag(inv(mat))) -id.SOL), 2) % destroy mumps instance id.JOB
type(alemuscl_buffer_) alemuscl_buffer