OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
ale51_gradient_reconstruction2.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_reconstruction2 (iparg, elbuf_tab, ixq, x, ale_connect, nv46, nercvois, nesdvois, lercvois, lesdvois, lencom, itask, iad_elem, fr_elem, segvar)

Function/Subroutine Documentation

◆ ale51_gradient_reconstruction2()

subroutine ale51_gradient_reconstruction2 ( integer, dimension(nparg,ngroup) iparg,
type(elbuf_struct_), dimension(ngroup), target elbuf_tab,
integer, dimension(nixq,numelq) ixq,
x,
type(t_ale_connectivity), intent(in) ale_connect,
integer nv46,
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_reconstruction2.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 , only : alemuscl_buffer
58 USE trimat_mod
59 USE segvar_mod
60 USE ale_connectivity_mod
61 USE multimat_param_mod , ONLY : m51_n0phas, m51_nvphas
62 use element_mod , only :nixq
63C-----------------------------------------------
64C I m p l i c i t T y p e s
65C-----------------------------------------------
66#include "implicit_f.inc"
67C-----------------------------------------------
68C C o m m o n B l o c k s
69C-----------------------------------------------
70#include "scr07_c.inc"
71#include "spmd_c.inc"
72#include "com01_c.inc"
73#include "com04_c.inc"
74#include "vect01_c.inc"
75#include "param_c.inc"
76#include "task_c.inc"
77C-----------------------------------------------
78C D u m m y A r g u m e n t s
79C-----------------------------------------------
80 INTEGER :: NV46, ITASK
81 INTEGER IPARG(NPARG,NGROUP), IXQ(NIXQ,NUMELQ)
82 my_real :: x(3,numnod)
83 TYPE(ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
84 INTEGER :: LENCOM, NERCVOIS(*),NESDVOIS(*),LERCVOIS(*),LESDVOIS(*)
85 INTEGER :: IAD_ELEM(2, *), FR_ELEM(*)
86 TYPE(t_segvar) :: SEGVAR
87 TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECT
88C-----------------------------------------------
89C L o c a l V a r i a b l e s
90C-----------------------------------------------
91 INTEGER :: NG
92 INTEGER :: ITRIMAT
93 my_real, DIMENSION(:), POINTER :: volg, volp, uvar
94 INTEGER :: ADD
95 INTEGER :: K, I, II, JJ, NODE_ID, JMIN, JMAX
96 INTEGER :: ELEM_ID
97 INTEGER :: FIRST,LAST
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 !!!centroid element
119 alemuscl_buffer%ELCENTER(ii,2) = fourth * (x(2, ixq(2, ii)) + x(2, ixq(3, ii)) + x(2, ixq(4, ii)) + x(2, ixq(5, ii)))
120 alemuscl_buffer%ELCENTER(ii,3) = fourth * (x(3, ixq(2, ii)) + x(3, ixq(3, ii)) + x(3, ixq(4, ii)) + x(3, ixq(5, ii)))
121 ENDDO
122 ENDIF
123 ENDDO ! NG=ITASK+1,NGROUP,NTHREAD
124 DO ng=itask+1,ngroup,nthread
125C ALE ON / OFF
126 IF (iparg(76, ng) == 1) cycle ! --> OFF
127 CALL initbuf(iparg ,ng ,
128 2 mtn ,llt ,nft ,iad ,ity ,
129 3 npt ,jale ,ismstr ,jeul ,jtur ,
130 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
131 5 nvaux ,jpor ,jcvt ,jclose ,jplasol ,
132 6 irep ,iint ,igtyp ,israt ,isrot ,
133 7 icsen ,isorth ,isorthg ,ifailure,jsms )
134 IF(jale+jeul == 0) cycle
135 IF(iparg(8,ng) == 1) cycle
136 IF(iparg(1,ng) /= 51) cycle
137 volg => elbuf_tab(ng)%GBUF%VOL
138 uvar => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)%VAR
139 lft=1
140 DO itrimat = 1, trimat
141 add = m51_n0phas + (itrimat-1)*m51_nvphas ! ADD => SIG(1)
142 add = add + 11 ! ADD + 11 => VOLUME_Phase
143 k = llt*(add-1) ! VAR(I,ADD) = VAR(K+I)
144 volp =>uvar(k+1:k+llt)
145 !!! Volume fraction
146 DO i=lft,llt
147 ii = i+nft
148 alemuscl_buffer%VOLUME_FRACTION(ii,itrimat) = volp(i)/volg(i)
149 alemuscl_buffer%VOLUME_FRACTION(ii,itrimat) = max(zero,min(one,alemuscl_buffer%VOLUME_FRACTION(ii,itrimat)))
150 ENDDO
151 ENDDO
152 ENDDO ! NG=ITASK+1,NGROUP,NTHREAD
153
154 CALL my_barrier
155
156 !!! MPI Comm
157 IF(nspmd > 1)THEN
158!$OMP SINGLE
159 !!! Volumic fractions comm
160 DO itrimat = 1, trimat
161 CALL spmd_e1vois(alemuscl_buffer%VOLUME_FRACTION(1,itrimat), nercvois, nesdvois,lercvois, lesdvois, lencom)
162 ENDDO
163 !!! Centroid coordinates comm
164 DO jj = 1, 3
165 CALL spmd_e1vois(alemuscl_buffer%ELCENTER(1,jj), nercvois, nesdvois,lercvois, lesdvois, lencom)
166 ENDDO
167!$OMP END SINGLE
168 ENDIF
169 CALL my_barrier
170
171 first = 1 + itask * numnod / nthread
172 last = (1 + itask) * numnod / nthread
173 alemuscl_buffer%NODE_MAX_VALUE(first:last,1:trimat) = -ep30
174 alemuscl_buffer%NODE_MIN_VALUE(first:last,1:trimat) = ep30
175 DO itrimat = 1, trimat
176 DO node_id = first,last
177 jmin = alemuscl_buffer%pADDCNEL(node_id)
178 jmax = alemuscl_buffer%pADDTMPL(node_id) - 1
179 DO jj = jmin, jmax
180 elem_id = alemuscl_buffer%pCNEL(jj)
181 IF (elem_id /= 0 .AND. elem_id <= numelq) THEN
182 alemuscl_buffer%NODE_MAX_VALUE(node_id,itrimat) = max(alemuscl_buffer%NODE_MAX_VALUE(node_id,itrimat),
183 . alemuscl_buffer%VOLUME_FRACTION(elem_id,itrimat))
184 alemuscl_buffer%NODE_MIN_VALUE(node_id,itrimat) = min(alemuscl_buffer%NODE_MIN_VALUE(node_id,itrimat),
185 . alemuscl_buffer%VOLUME_FRACTION(elem_id,itrimat))
186 ENDIF
187 ENDDO
188 ENDDO
189 ENDDO
190 CALL my_barrier
191 !!! MPI Comm
192 IF(nspmd > 1)THEN
193!$OMP SINGLE
194 DO itrimat = 1, trimat
195 CALL spmd_exch_min_max(iad_elem ,fr_elem ,
196 . alemuscl_buffer%NODE_MIN_VALUE(1,itrimat), alemuscl_buffer%NODE_MAX_VALUE(1,itrimat) )
197 ENDDO
198!$OMP END SINGLE
199 ENDIF
200 CALL my_barrier
201
202 DO ng=itask+1,ngroup,nthread
203C ALE ON / OFF
204 IF (iparg(76, ng) == 1) cycle ! --> OFF
205 CALL initbuf(iparg ,ng ,
206 2 mtn ,llt ,nft ,iad ,ity ,
207 3 npt ,jale ,ismstr ,jeul ,jtur ,
208 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
209 5 nvaux ,jpor ,jcvt ,jclose ,jplasol ,
210 6 irep ,iint ,igtyp ,israt ,isrot ,
211 7 icsen ,isorth ,isorthg ,ifailure,jsms )
212 IF(jale+jeul == 0) cycle
213 IF(iparg(8,ng) == 1) cycle
214 IF(iparg(1,ng) /= 51) cycle
215 lft = 1
216 !!! Reconstruct gradient
217 DO itrimat = 1, trimat
218 CALL gradient_reconstruction2(ixq, x, ale_connect, nv46, itrimat, segvar)
219 ENDDO ! ITRIMAT = 1, TRIMAT
220 END DO ! ng=itask+1,ngroup,nthread
221
222 CALL my_barrier
223
224 IF (nspmd > 1) THEN
225C MPI exchange for gradients
226!$OMP SINGLE
227 DO itrimat = 1, trimat
228 CALL spmd_exchange_grad(3, numels + nsvois + numelq + nqvois,3,alemuscl_buffer%GRAD(1,1,itrimat),
229 . nercvois, nesdvois, lercvois, lesdvois, lencom)
230 ENDDO
231!$OMP END SINGLE
232 ENDIF
233 CALL my_barrier
234
235 DO ng=itask+1,ngroup,nthread
236C ALE ON / OFF
237 IF (iparg(76, ng) == 1) cycle ! --> OFF
238 CALL initbuf(iparg ,ng ,
239 2 mtn ,llt ,nft ,iad ,ity ,
240 3 npt ,jale ,ismstr ,jeul ,jtur ,
241 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
242 5 nvaux ,jpor ,jcvt ,jclose ,jplasol ,
243 6 irep ,iint ,igtyp ,israt ,isrot ,
244 7 icsen ,isorth ,isorthg ,ifailure,jsms )
245 IF(jale+jeul == 0) cycle
246 IF(iparg(8,ng) == 1) cycle
247 IF(iparg(1,ng) /= 51) cycle
248 lft = 1
249
250 CALL gradient_limitation2(ixq, x, trimat)
251 ENDDO
252 CALL my_barrier
253
254C-----------------------------------------------
my_real
#define my_real
Definition cppsort.cpp:32
gradient_limitation2
subroutine gradient_limitation2(ixq, x, trimat)
Definition gradient_limitation2.F:32
gradient_reconstruction2
subroutine gradient_reconstruction2(ixq, x, ale_connect, nv46, itrimat, segvar)
Definition gradient_reconstruction2.F:34
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