OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
ale51_gradient_reconstruction2.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!|| ale51_gradient_reconstruction2 ../engine/source/ale/alemuscl/ale51_gradient_reconstruction2.f
25!||--- called by ------------------------------------------------------
26!|| alethe ../engine/source/ale/alethe.F
27!||--- calls -----------------------------------------------------
28!|| gradient_limitation2 ../engine/source/ale/alemuscl/gradient_limitation2.F
29!|| gradient_reconstruction2 ../engine/source/ale/alemuscl/gradient_reconstruction2.F
30!|| initbuf ../engine/share/resol/initbuf.F
31!|| my_barrier ../engine/source/system/machine.F
32!|| spmd_e1vois ../engine/source/mpi/fluid/spmd_cfd.F
33!|| spmd_exch_min_max ../engine/source/mpi/ale/spmd_exch_min_max.F
34!|| spmd_exchange_grad ../engine/source/mpi/fluid/spmd_exchange_grad.F
35!||--- uses -----------------------------------------------------
36!|| ale_connectivity_mod ../common_source/modules/ale/ale_connectivity_mod.F
37!|| alemuscl_mod ../common_source/modules/ale/alemuscl_mod.F
38!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
39!|| initbuf_mod ../engine/share/resol/initbuf.F
40!|| multimat_param_mod ../common_source/modules/multimat_param_mod.F90
41!|| segvar_mod ../engine/share/modules/segvar_mod.F
42!|| trimat_mod ../engine/share/modules/trimat.F
43!||====================================================================
44 SUBROUTINE ale51_gradient_reconstruction2(IPARG ,ELBUF_TAB,IXQ ,X ,ALE_CONNECT,
45 . NV46 ,NERCVOIS ,NESDVOIS,LERCVOIS,LESDVOIS ,LENCOM, ITASK,
46 . IAD_ELEM,FR_ELEM ,SEGVAR)
47C-----------------------------------------------
48C D e s c r i p t i o n
49C Computes limited gradients for volumic fractions
50C of LAW51 species
51C-----------------------------------------------
52C M o d u l e s
53C-----------------------------------------------
54 USE initbuf_mod
55 USE elbufdef_mod
56 USE alemuscl_mod , only : alemuscl_buffer
57 USE trimat_mod
58 USE segvar_mod
59 USE ale_connectivity_mod
60 USE multimat_param_mod , ONLY : m51_n0phas, m51_nvphas
61C-----------------------------------------------
62C I m p l i c i t T y p e s
63C-----------------------------------------------
64#include "implicit_f.inc"
65C-----------------------------------------------
66C C o m m o n B l o c k s
67C-----------------------------------------------
68#include "scr07_c.inc"
69#include "spmd_c.inc"
70#include "com01_c.inc"
71#include "com04_c.inc"
72#include "vect01_c.inc"
73#include "param_c.inc"
74#include "task_c.inc"
75C-----------------------------------------------
76C D u m m y A r g u m e n t s
77C-----------------------------------------------
78 INTEGER :: NV46, ITASK
79 INTEGER IPARG(NPARG,NGROUP), IXQ(NIXQ,NUMELQ)
80 my_real :: x(3,numnod)
81 TYPE(elbuf_struct_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
82 INTEGER :: LENCOM, NERCVOIS(*),NESDVOIS(*),LERCVOIS(*),LESDVOIS(*)
83 INTEGER :: IAD_ELEM(2, *), FR_ELEM(*)
84 TYPE(t_segvar) :: SEGVAR
85 TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECT
86C-----------------------------------------------
87C L o c a l V a r i a b l e s
88C-----------------------------------------------
89 INTEGER :: NG
90 INTEGER :: ITRIMAT
91 my_real, DIMENSION(:), POINTER :: volg, volp, uvar
92 INTEGER :: ADD
93 INTEGER :: K, I, II, JJ, NODE_ID, JMIN, JMAX
94 INTEGER :: ELEM_ID
95 INTEGER :: FIRST,LAST
96C-----------------------------------------------
97C S o u r c e L i n e s
98C-----------------------------------------------
99 DO ng=itask+1,ngroup,nthread
100C ALE ON / OFF
101 IF (iparg(76, ng) == 1) cycle ! --> OFF
102 CALL initbuf(iparg ,ng ,
103 2 mtn ,llt ,nft ,iad ,ity ,
104 3 npt ,jale ,ismstr ,jeul ,jtur ,
105 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
106 5 nvaux ,jpor ,jcvt ,jclose ,jplasol ,
107 6 irep ,iint ,igtyp ,israt ,isrot ,
108 7 icsen ,isorth ,isorthg ,ifailure,jsms )
109 IF(jale+jeul == 0) cycle
110 IF(iparg(8,ng) == 1) cycle
111 IF(iparg(1,ng) /= 51) cycle
112 IF ((jale /= 0) .OR. ((jeul /= 0) .AND. (ncycle == 0 .OR. mcheck /= 0))) THEN
113 !!! Volume fraction
114 DO i=lft,llt
115 ii = i+nft
116 !!! Element centroid
117 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)))
118 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)))
119 ENDDO
120 ENDIF
121 ENDDO ! NG=ITASK+1,NGROUP,NTHREAD
122 DO ng=itask+1,ngroup,nthread
123C ALE ON / OFF
124 IF (iparg(76, ng) == 1) cycle ! --> OFF
125 CALL initbuf(iparg ,ng ,
126 2 mtn ,llt ,nft ,iad ,ity ,
127 3 npt ,jale ,ismstr ,jeul ,jtur ,
128 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
129 5 nvaux ,jpor ,jcvt ,jclose ,jplasol ,
130 6 irep ,iint ,igtyp ,israt ,isrot ,
131 7 icsen ,isorth ,isorthg ,ifailure,jsms )
132 IF(jale+jeul == 0) cycle
133 IF(iparg(8,ng) == 1) cycle
134 IF(iparg(1,ng) /= 51) cycle
135 volg => elbuf_tab(ng)%GBUF%VOL
136 uvar => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)%VAR
137 lft=1
138 DO itrimat = 1, trimat
139 add = m51_n0phas + (itrimat-1)*m51_nvphas ! ADD => SIG(1)
140 add = add + 11 ! ADD + 11 => VOLUME_Phase
141 k = llt*(add-1) ! VAR(I,ADD) = VAR(K+I)
142 volp =>uvar(k+1:k+llt)
143 !!! Volume fraction
144 DO i=lft,llt
145 ii = i+nft
146 alemuscl_buffer%VOLUME_FRACTION(ii,itrimat) = volp(i)/volg(i)
147 alemuscl_buffer%VOLUME_FRACTION(ii,itrimat) = max(zero,min(one,alemuscl_buffer%VOLUME_FRACTION(ii,itrimat)))
148 ENDDO
149 ENDDO
150 ENDDO ! NG=ITASK+1,NGROUP,NTHREAD
151
152 CALL my_barrier
153
154 !!! MPI Comm
155 IF(nspmd > 1)THEN
156!$OMP SINGLE
157 !!! Volumic fractions comm
158 DO itrimat = 1, trimat
159 CALL spmd_e1vois(alemuscl_buffer%VOLUME_FRACTION(1,itrimat), nercvois, nesdvois,lercvois, lesdvois, lencom)
160 ENDDO
161 !!! Centroid coordinates comm
162 DO jj = 1, 3
163 CALL spmd_e1vois(alemuscl_buffer%ELCENTER(1,jj), nercvois, nesdvois,lercvois, lesdvois, lencom)
164 ENDDO
165!$OMP END SINGLE
166 ENDIF
167 CALL my_barrier
168
169 first = 1 + itask * numnod / nthread
170 last = (1 + itask) * numnod / nthread
171 alemuscl_buffer%NODE_MAX_VALUE(first:last,1:trimat) = -ep30
172 alemuscl_buffer%NODE_MIN_VALUE(first:last,1:trimat) = ep30
173 DO itrimat = 1, trimat
174 DO node_id = first,last
175 jmin = alemuscl_buffer%pADDCNEL(node_id)
176 jmax = alemuscl_buffer%pADDTMPL(node_id) - 1
177 DO jj = jmin, jmax
178 elem_id = alemuscl_buffer%pCNEL(jj)
179 IF (elem_id /= 0 .AND. elem_id <= numelq) THEN
180 alemuscl_buffer%NODE_MAX_VALUE(node_id,itrimat) = max(alemuscl_buffer%NODE_MAX_VALUE(node_id,itrimat),
181 . alemuscl_buffer%VOLUME_FRACTION(elem_id,itrimat))
182 alemuscl_buffer%NODE_MIN_VALUE(node_id,itrimat) = min(alemuscl_buffer%NODE_MIN_VALUE(node_id,itrimat),
183 . alemuscl_buffer%VOLUME_FRACTION(elem_id,itrimat))
184 ENDIF
185 ENDDO
186 ENDDO
187 ENDDO
188 CALL my_barrier
189 !!! MPI Comm
190 IF(nspmd > 1)THEN
191!$OMP SINGLE
192 DO itrimat = 1, trimat
193 CALL spmd_exch_min_max(iad_elem ,fr_elem ,
194 . alemuscl_buffer%NODE_MIN_VALUE(1,itrimat), alemuscl_buffer%NODE_MAX_VALUE(1,itrimat) )
195 ENDDO
196!$OMP END SINGLE
197 ENDIF
198 CALL my_barrier
199
200 DO ng=itask+1,ngroup,nthread
201C ALE ON / OFF
202 IF (iparg(76, ng) == 1) cycle ! --> OFF
203 CALL initbuf(iparg ,ng ,
204 2 mtn ,llt ,nft ,iad ,ity ,
205 3 npt ,jale ,ismstr ,jeul ,jtur ,
206 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
207 5 nvaux ,jpor ,jcvt ,jclose ,jplasol ,
208 6 irep ,iint ,igtyp ,israt ,isrot ,
209 7 icsen ,isorth ,isorthg ,ifailure,jsms )
210 IF(jale+jeul == 0) cycle
211 IF(iparg(8,ng) == 1) cycle
212 IF(iparg(1,ng) /= 51) cycle
213 lft = 1
214 !!! Reconstruct gradient
215 DO itrimat = 1, trimat
216 CALL gradient_reconstruction2(ixq, x, ale_connect, nv46, itrimat, segvar)
217 ENDDO ! ITRIMAT = 1, TRIMAT
218 END DO ! NG=ITASK+1,NGROUP,NTHREAD
219
220 CALL my_barrier
221
222 IF (nspmd > 1) THEN
223C MPI exchange for gradients
224!$OMP SINGLE
225 DO itrimat = 1, trimat
226 CALL spmd_exchange_grad(3, numels + nsvois + numelq + nqvois,3,alemuscl_buffer%GRAD(1,1,itrimat),
227 . nercvois, nesdvois, lercvois, lesdvois, lencom)
228 ENDDO
229!$OMP END SINGLE
230 ENDIF
231 CALL my_barrier
232
233 DO ng=itask+1,ngroup,nthread
234C ALE ON / OFF
235 IF (iparg(76, ng) == 1) cycle ! --> OFF
236 CALL initbuf(iparg ,ng ,
237 2 mtn ,llt ,nft ,iad ,ity ,
238 3 npt ,jale ,ismstr ,jeul ,jtur ,
239 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
240 5 nvaux ,jpor ,jcvt ,jclose ,jplasol ,
241 6 irep ,iint ,igtyp ,israt ,isrot ,
242 7 icsen ,isorth ,isorthg ,ifailure,jsms )
243 IF(jale+jeul == 0) cycle
244 IF(iparg(8,ng) == 1) cycle
245 IF(iparg(1,ng) /= 51) cycle
246 lft = 1
247
248 CALL gradient_limitation2(ixq, x, trimat)
249 ENDDO
250 CALL my_barrier
251
252C-----------------------------------------------
253 END SUBROUTINE ale51_gradient_reconstruction2
254
ale51_gradient_reconstruction2
subroutine ale51_gradient_reconstruction2(iparg, elbuf_tab, ixq, x, ale_connect, nv46, nercvois, nesdvois, lercvois, lesdvois, lencom, itask, iad_elem, fr_elem, segvar)
Definition ale51_gradient_reconstruction2.F:47
my_real
#define my_real
Definition cppsort.cpp:32
gradient_limitation2
subroutine gradient_limitation2(ixq, x, trimat)
Definition gradient_limitation2.F:31
gradient_reconstruction2
subroutine gradient_reconstruction2(ixq, x, ale_connect, nv46, itrimat, segvar)
Definition gradient_reconstruction2.F:33
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
ale_connectivity_mod::t_ale_connectivity
Definition ale_connectivity_mod.F:254
segvar_mod::t_segvar
Definition segvar_mod.F:69