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 45 of file ale51_gradient_reconstruction.F.

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