OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
ale51_gradient_reconstruction.F File Reference
#include "implicit_f.inc"
#include "scr07_c.inc"
#include "spmd_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "vect01_c.inc"
#include "param_c.inc"
#include "task_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine ale51_gradient_reconstruction (iparg, elbuf_tab, ixs, x, ale_connect, nercvois, nesdvois, lercvois, lesdvois, lencom, itask, iad_elem, fr_elem, segvar)

Function/Subroutine Documentation

◆ ale51_gradient_reconstruction()

subroutine ale51_gradient_reconstruction ( integer, dimension(nparg,*) iparg,
type(elbuf_struct_), dimension(ngroup), target elbuf_tab,
integer, dimension(nixs,*) ixs,
x,
type(t_ale_connectivity), intent(in) ale_connect,
integer, dimension(*) nercvois,
integer, dimension(*) nesdvois,
integer, dimension(*) lercvois,
integer, dimension(*) lesdvois,
integer lencom,
integer itask,
integer, dimension(2, *) iad_elem,
integer, dimension(*) fr_elem,
type(t_segvar) segvar )

Definition at line 46 of file ale51_gradient_reconstruction.F.

49C-----------------------------------------------
50C D e s c r i p t i o n
51C Computes limited gradients for volumic fractions
52C of LAW51 species
53C-----------------------------------------------
54C M o d u l e s
55C-----------------------------------------------
56 USE initbuf_mod
57 USE elbufdef_mod
58 USE alemuscl_mod
59 USE trimat_mod
60 USE segvar_mod
61 USE ale_connectivity_mod
62 USE multimat_param_mod , ONLY : m51_n0phas, m51_nvphas
63 use element_mod , only :nixs
64C-----------------------------------------------
65C I m p l i c i t T y p e s
66C-----------------------------------------------
67#include "implicit_f.inc"
68C-----------------------------------------------
69C C o m m o n B l o c k s
70C-----------------------------------------------
71#include "scr07_c.inc"
72#include "spmd_c.inc"
73#include "com01_c.inc"
74#include "com04_c.inc"
75#include "vect01_c.inc"
76#include "param_c.inc"
77#include "task_c.inc"
78C-----------------------------------------------
79C D u m m y A r g u m e n t s
80C-----------------------------------------------
81 INTEGER :: ITASK
82 INTEGER IPARG(NPARG,*), IXS(NIXS,*)
83 my_real :: x(3,*)
84 TYPE(ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
85 INTEGER :: LENCOM, NERCVOIS(*),NESDVOIS(*),LERCVOIS(*),LESDVOIS(*)
86 INTEGER :: IAD_ELEM(2, *), FR_ELEM(*)
87 TYPE(t_segvar) :: SEGVAR
88 TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECT
89C-----------------------------------------------
90C L o c a l V a r i a b l e s
91C-----------------------------------------------
92 INTEGER :: NG
93 INTEGER :: ITRIMAT
94 my_real, DIMENSION(:), POINTER :: volg, volp, uvar
95 INTEGER :: ADD
96 INTEGER :: K, I, II, JJ, NODE_ID, JMIN, JMAX
97 INTEGER :: ELEM_ID
98 INTEGER :: FIRST,LAST
99 my_real :: vol, a(3), b(3), c(3)
100C-----------------------------------------------
101C S o u r c e L i n e s
102C-----------------------------------------------
103 DO ng=itask+1,ngroup,nthread
104C ALE ON / OFF
105 IF (iparg(76, ng) == 1) cycle ! --> OFF
106 CALL initbuf(iparg ,ng ,
107 2 mtn ,llt ,nft ,iad ,ity ,
108 3 npt ,jale ,ismstr ,jeul ,jtur ,
109 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
110 5 nvaux ,jpor ,jcvt ,jclose ,jplasol ,
111 6 irep ,iint ,igtyp ,israt ,isrot ,
112 7 icsen ,isorth ,isorthg ,ifailure,jsms )
113 IF(jale+jeul == 0) cycle
114 IF(iparg(8,ng) == 1) cycle
115 IF(iparg(1,ng) /= 51) cycle
116 IF ((jale /= 0) .OR. ((jeul /= 0) .AND. (ncycle == 0 .OR. mcheck /= 0))) THEN
117 !!! Volume fraction
118 DO i=lft,llt
119 ii = i+nft
120
121 !!!centroid element
122 alemuscl_buffer%ELCENTER(ii,1) = zero ;
123 alemuscl_buffer%ELCENTER(ii,2) = zero ;
124 alemuscl_buffer%ELCENTER(ii,3) = zero
125 vol = zero
126 !!! Face 1
127 !!! Points 321
128 a = x(1:3, ixs(1+3, ii)) ; b = x(1:3, ixs(2+1, ii)) ; c = x(1:3, ixs(1+1, ii))
129 CALL geom(a, b, c,alemuscl_buffer%ELCENTER(ii,1),alemuscl_buffer%ELCENTER(ii,2),alemuscl_buffer%ELCENTER(ii,3), vol)
130 !!! Points 314
131 a = x(1:3, ixs(3+1, ii)) ; b = x(1:3, ixs(1+1, ii)) ; c = x(1:3, ixs(4+1, ii))
132 CALL geom(a, b, c,alemuscl_buffer%ELCENTER(ii,1),alemuscl_buffer%ELCENTER(ii,2),alemuscl_buffer%ELCENTER(ii,3), vol)
133
134 !!! Face 2
135 !!! Points 473
136 a = x(1:3, ixs(4+1, ii)) ; b = x(1:3, ixs(7+1, ii)) ; c = x(1:3, ixs(3+1, ii))
137 CALL geom(a, b, c,alemuscl_buffer%ELCENTER(ii,1),alemuscl_buffer%ELCENTER(ii,2),alemuscl_buffer%ELCENTER(ii,3), vol)
138
139 !!! Points 487
140 a = x(1:3, ixs(4+1, ii)) ; b = x(1:3, ixs(8+1, ii)) ; c = x(1:3, ixs(7+1, ii))
141 CALL geom(a, b, c,alemuscl_buffer%ELCENTER(ii,1),alemuscl_buffer%ELCENTER(ii,2),alemuscl_buffer%ELCENTER(ii,3), vol)
142
143 !!! Face 3
144 !!! Points 678
145 a = x(1:3, ixs(6+1, ii)) ; b = x(1:3, ixs(7+1, ii)) ; c = x(1:3, ixs(8+1, ii))
146 CALL geom(a, b, c,alemuscl_buffer%ELCENTER(ii,1),alemuscl_buffer%ELCENTER(ii,2),alemuscl_buffer%ELCENTER(ii,3), vol)
147
148 !!! Points 685
149 a = x(1:3, ixs(6+1, ii)) ; b = x(1:3, ixs(8+1, ii)) ; c = x(1:3, ixs(5+1, ii))
150 CALL geom(a, b, c,alemuscl_buffer%ELCENTER(ii,1),alemuscl_buffer%ELCENTER(ii,2),alemuscl_buffer%ELCENTER(ii,3), vol)
151
152 !!! Face 4
153 !!! Points 126
154 a = x(1:3, ixs(1+1, ii)) ; b = x(1:3, ixs(2+1, ii)) ; c = x(1:3, ixs(6+1, ii))
155 CALL geom(a, b, c,alemuscl_buffer%ELCENTER(ii,1),alemuscl_buffer%ELCENTER(ii,2),alemuscl_buffer%ELCENTER(ii,3), vol)
156
157 !!! Points 165
158 a = x(1:3, ixs(1+1, ii)) ; b = x(1:3, ixs(6+1, ii)) ; c = x(1:3, ixs(5+1, ii))
159 CALL geom(a, b, c,alemuscl_buffer%ELCENTER(ii,1),alemuscl_buffer%ELCENTER(ii,2),alemuscl_buffer%ELCENTER(ii,3), vol)
160
161 !!! Face 5
162 !!! Points 236
163 a = x(1:3, ixs(2+1, ii)) ; b = x(1:3, ixs(3+1, ii)) ; c = x(1:3, ixs(6+1, ii))
164 CALL geom(a, b, c,alemuscl_buffer%ELCENTER(ii,1),alemuscl_buffer%ELCENTER(ii,2),alemuscl_buffer%ELCENTER(ii,3), vol)
165
166 !!! Points 376
167 a = x(1:3, ixs(3+1, ii)) ; b = x(1:3, ixs(7+1, ii)) ; c = x(1:3, ixs(6+1, ii))
168 CALL geom(a, b, c,alemuscl_buffer%ELCENTER(ii,1),alemuscl_buffer%ELCENTER(ii,2),alemuscl_buffer%ELCENTER(ii,3), vol)
169
170 !!! Face 6
171 !!! Points 154
172 a = x(1:3, ixs(1+1, ii)) ; b = x(1:3, ixs(5+1, ii)) ; c = x(1:3, ixs(4+1, ii))
173 CALL geom(a, b, c,alemuscl_buffer%ELCENTER(ii,1),alemuscl_buffer%ELCENTER(ii,2),alemuscl_buffer%ELCENTER(ii,3), vol)
174
175 !!! Points 458
176 a = x(1:3, ixs(4+1, ii)) ; b = x(1:3, ixs(5+1, ii)) ; c = x(1:3, ixs(8+1, ii))
177 CALL geom(a, b, c,alemuscl_buffer%ELCENTER(ii,1),alemuscl_buffer%ELCENTER(ii,2),alemuscl_buffer%ELCENTER(ii,3), vol)
178
179
180 vol = vol / 6.d0
181 alemuscl_buffer%ELCENTER(ii,1:3) = alemuscl_buffer%ELCENTER(ii,1:3) / 12.d0 / vol
182
183
184 ENDDO
185 ENDIF
186 ENDDO ! NG=ITASK+1,NGROUP,NTHREAD
187 DO ng=itask+1,ngroup,nthread
188C ALE ON / OFF
189 IF (iparg(76, ng) == 1) cycle ! --> OFF
190 CALL initbuf(iparg ,ng ,
191 2 mtn ,llt ,nft ,iad ,ity ,
192 3 npt ,jale ,ismstr ,jeul ,jtur ,
193 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
194 5 nvaux ,jpor ,jcvt ,jclose ,jplasol ,
195 6 irep ,iint ,igtyp ,israt ,isrot ,
196 7 icsen ,isorth ,isorthg ,ifailure,jsms )
197 IF(jale+jeul == 0) cycle
198 IF(iparg(8,ng) == 1) cycle
199 IF(iparg(1,ng) /= 51) cycle
200 volg => elbuf_tab(ng)%GBUF%VOL
201 uvar => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)%VAR
202 lft=1
203 DO itrimat = 1, trimat
204 add = m51_n0phas + (itrimat-1)*m51_nvphas ! ADD => SIG(1)
205 add = add + 11 ! ADD + 11 => VOLUME_Phase
206 k = llt*(add-1) ! VAR(I,ADD) = VAR(K+I)
207 volp =>uvar(k+1:k+llt)
208 !!! Volume fraction
209 DO i=lft,llt
210 ii = i+nft
211 alemuscl_buffer%VOLUME_FRACTION(ii,itrimat) = volp(i)/volg(i)
212 alemuscl_buffer%VOLUME_FRACTION(ii,itrimat) =
213 . max(zero,min(one,alemuscl_buffer%VOLUME_FRACTION(ii,itrimat)))
214
215 ENDDO
216 ENDDO
217 ENDDO ! NG=ITASK+1,NGROUP,NTHREAD
218
219 CALL my_barrier
220
221 !!! MPI Comm
222 IF(nspmd > 1)THEN
223!$OMP SINGLE
224 !!! Volumic fractions comm
225 DO itrimat = 1, trimat
226 CALL spmd_e1vois(alemuscl_buffer%VOLUME_FRACTION(1,itrimat), nercvois, nesdvois,
227 . lercvois, lesdvois, lencom)
228 ENDDO
229 !!! Centroid coordinates comm
230 DO jj = 1, 3
231 CALL spmd_e1vois(alemuscl_buffer%ELCENTER(1,jj), nercvois, nesdvois,
232 . lercvois, lesdvois, lencom)
233 ENDDO
234!$OMP END SINGLE
235 ENDIF
236 CALL my_barrier
237
238 first = 1 + itask * numnod / nthread
239 last = (1 + itask) * numnod / nthread
240 alemuscl_buffer%NODE_MAX_VALUE(first:last,1:trimat) = -ep30
241 alemuscl_buffer%NODE_MIN_VALUE(first:last,1:trimat) = ep30
242 DO itrimat = 1, trimat
243 DO node_id = first,last
244 jmin = alemuscl_buffer%pADDCNEL(node_id)
245 jmax = alemuscl_buffer%pADDTMPL(node_id) - 1
246 DO jj = jmin, jmax
247 elem_id = alemuscl_buffer%pCNEL(jj)
248 IF (elem_id /= 0 .AND. elem_id <= numels) THEN
249 alemuscl_buffer%NODE_MAX_VALUE(node_id,itrimat) = max(alemuscl_buffer%NODE_MAX_VALUE(node_id,itrimat),
250 . alemuscl_buffer%VOLUME_FRACTION(elem_id,itrimat))
251 alemuscl_buffer%NODE_MIN_VALUE(node_id,itrimat) = min(alemuscl_buffer%NODE_MIN_VALUE(node_id,itrimat),
252 . alemuscl_buffer%VOLUME_FRACTION(elem_id,itrimat))
253 ENDIF
254 ENDDO
255 ENDDO
256 ENDDO
257 CALL my_barrier
258 !!! MPI Comm
259 IF(nspmd > 1)THEN
260!$OMP SINGLE
261 DO itrimat = 1, trimat
262 CALL spmd_exch_min_max(iad_elem ,fr_elem ,
263 . alemuscl_buffer%NODE_MIN_VALUE(1,itrimat), alemuscl_buffer%NODE_MAX_VALUE(1,itrimat) )
264 ENDDO
265!$OMP END SINGLE
266 ENDIF
267 CALL my_barrier
268
269 DO ng=itask+1,ngroup,nthread
270C ALE ON / OFF
271 IF (iparg(76, ng) == 1) cycle ! --> OFF
272 CALL initbuf(iparg ,ng ,
273 2 mtn ,llt ,nft ,iad ,ity ,
274 3 npt ,jale ,ismstr ,jeul ,jtur ,
275 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
276 5 nvaux ,jpor ,jcvt ,jclose ,jplasol ,
277 6 irep ,iint ,igtyp ,israt ,isrot ,
278 7 icsen ,isorth ,isorthg ,ifailure,jsms )
279 IF(jale+jeul == 0) cycle
280 IF(iparg(8,ng) == 1) cycle
281 IF(iparg(1,ng) /= 51) cycle
282 lft = 1
283 !!! Reconstruct gradient
284 DO itrimat = 1, trimat
285 CALL gradient_reconstruction( ixs, x, ale_connect, itrimat, segvar)
286 ENDDO ! ITRIMAT = 1, TRIMAT
287 END DO ! NG=ITASK+1,NGROUP,NTHREAD
288
289 CALL my_barrier
290
291 IF (nspmd > 1) THEN
292C MPI Communication for gradients
293!$OMP SINGLE
294 DO itrimat = 1, trimat
295 CALL spmd_exchange_grad(3, numels + nsvois + numelq + nqvois,3,alemuscl_buffer%GRAD(1,1,itrimat),
296 . nercvois, nesdvois, lercvois, lesdvois, lencom)
297 ENDDO
298!$OMP END SINGLE
299 ENDIF
300 CALL my_barrier
301
302 DO ng=itask+1,ngroup,nthread
303C ALE ON / OFF
304 IF (iparg(76, ng) == 1) cycle ! --> OFF
305 CALL initbuf(iparg ,ng ,
306 2 mtn ,llt ,nft ,iad ,ity ,
307 3 npt ,jale ,ismstr ,jeul ,jtur ,
308 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
309 5 nvaux ,jpor ,jcvt ,jclose ,jplasol ,
310 6 irep ,iint ,igtyp ,israt ,isrot ,
311 7 icsen ,isorth ,isorthg ,ifailure,jsms )
312 IF(jale+jeul == 0) cycle
313 IF(iparg(8,ng) == 1) cycle
314 IF(iparg(1,ng) /= 51) cycle
315 lft = 1
316
317 CALL gradient_limitation(ixs, x, trimat)
318 ENDDO
319 CALL my_barrier
320
321C-----------------------------------------------
my_real
#define my_real
Definition cppsort.cpp:32
geom
subroutine geom(a, b, c, center_x, center_y, center_z, vol)
Definition geom.F:30
gradient_limitation
subroutine gradient_limitation(ixs, x, trimat)
Definition gradient_limitation.F:32
gradient_reconstruction
subroutine gradient_reconstruction(ixs, x, ale_connect, itrimat, segvar)
Definition gradient_reconstruction.F:36
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
ale_connectivity_mod
Definition ale_connectivity_mod.F:225
alemuscl_mod
Definition alemuscl_mod.F:55
alemuscl_mod::alemuscl_buffer
type(alemuscl_buffer_) alemuscl_buffer
Definition alemuscl_mod.F:75
initbuf_mod
Definition initbuf.F:160
initbuf_mod::initbuf
subroutine initbuf(iparg, ng, mtn, llt, nft, iad, ity, npt, jale, ismstr, jeul, jtur, jthe, jlag, jmult, jhbe, jivf, mid, jpor, jcvt, jclose, jpla, irep, iint, igtyp, israt, isrot, icsen, isorth, isorthg, ifailure, jsms)
Definition initbuf.F:261
segvar_mod
Definition segvar_mod.F:63
trimat_mod
Definition trimat.F:31
spmd_e1vois
subroutine spmd_e1vois(phi, nercvois, nesdvois, lercvois, lesdvois, lencom)
Definition spmd_cfd.F:375
spmd_exch_min_max
subroutine spmd_exch_min_max(iad_elem, fr_elem, min_array, max_array)
Definition spmd_exch_min_max.F:36
spmd_exchange_grad
subroutine spmd_exchange_grad(dim, dim1, dim2, phi, nercvois, nesdvois, lercvois, lesdvois, lencom)
Definition spmd_exchange_grad.F:35
my_barrier
subroutine my_barrier
Definition machine.F:31