OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
ale51_finish.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_finish ../engine/source/ale/ale51/ale51_finish.F
25!||--- called by ------------------------------------------------------
26!|| alethe ../engine/source/ale/alethe.F
27!||--- calls -----------------------------------------------------
28!|| ale51_upwind2 ../engine/source/ale/ale51/ale51_upwind2.F
29!|| ale51_upwind3 ../engine/source/ale/ale51/ale51_upwind3.f
30!|| ale51_upwind3_int22 ../engine/source/ale/alefvm/cut_cells/ale51_upwind3_int22.F
31!|| initbuf ../engine/share/resol/initbuf.F
32!|| my_barrier ../engine/source/system/machine.F
33!||--- uses -----------------------------------------------------
34!|| ale_connectivity_mod ../common_source/modules/ale/ale_connectivity_mod.F
35!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
36!|| element_mod ../common_source/modules/elements/element_mod.F90
37!|| i22bufbric_mod ../common_source/modules/interfaces/cut-cell-search_mod.F
38!|| i22tri_mod ../common_source/modules/interfaces/cut-cell-search_mod.F
39!|| initbuf_mod ../engine/share/resol/initbuf.F
40!||====================================================================
41 SUBROUTINE ale51_finish(IPARG, PM ,IXS ,IXQ ,
42 . X ,FLUX ,FLU2 ,
43 . ALPHA, ALE_CONNECT ,ITASK,FLUX_SAV,QMV,NV46,ELBUF_TAB)
44C-----------------------------------------------
45C M o d u l e s
46C-----------------------------------------------
47 USE initbuf_mod
48 USE elbufdef_mod
50 USE i22tri_mod
52 use element_mod , only : nixs
53C-----------------------------------------------
54C I m p l i c i t T y p e s
55C-----------------------------------------------
56#include "implicit_f.inc"
57C-----------------------------------------------
58C C o m m o n B l o c k s
59C-----------------------------------------------
60#include "com01_c.inc"
61#include "com04_c.inc"
62#include "vect01_c.inc"
63#include "param_c.inc"
64#include "task_c.inc"
65#include "inter22.inc"
66C-----------------------------------------------
67C D u m m y A r g u m e n t s
68C-----------------------------------------------
69 TYPE(elbuf_struct_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
70 my_real PM(NPROPM,NUMMAT), X(3,NUMNOD),
71 . flux(nv46,*), flu2(*),
72 . alpha(*), flux_sav(nv46,*), qmv(*)
73 INTEGER IPARG(NPARG,NGROUP), IXS(NIXS,NUMELS), IXQ(7,NUMELQ),ITASK,NV46, J
74 TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECT
75C-----------------------------------------------
76C L o c a l V a r i a b l e s
77C-----------------------------------------------
78 my_real :: bid
79 INTEGER :: NG, I, K, II, NF1
80 INTEGER :: NIN, IB, NBF, NBL, IE, MLW
81C-----------------------------------------------
82
83C-----------------------------------------------
84C S o u r c e L i n e s
85C-----------------------------------------------
86
87 CALL my_barrier
88
89C-----------------------------------------------
90C VOLUME FLUXES BACKUP
91C-----------------------------------------------
92 DO ng=itask+1,ngroup,nthread
93C ALE ON / OFF
94 IF (iparg(76, ng) == 1) cycle ! --> OFF
95 CALL initbuf(iparg ,ng ,
96 2 mtn ,llt ,nft ,iad ,ity ,
97 3 npt ,jale ,ismstr ,jeul ,jtur ,
98 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
99 5 nvaux ,jpor ,jcvt ,jclose ,jplasol ,
100 6 irep ,iint ,igtyp ,israt ,isrot ,
101 7 icsen ,isorth ,isorthg ,ifailure,jsms )
102 !------------------------------!
103 ! DEBRANCHING CONDITIONS !
104 !------------------------------!
105 IF(jale+jeul == 0) cycle
106 IF(iparg(8,ng) == 1) cycle
107 IF(iparg(1,ng) /= 51) cycle
108 !------------------------------!
109 lft=1
110 DO i=lft,llt
111 ii = i+nft
112 alpha(ii) = one
113 ENDDO
114 DO k=1,nv46
115 DO ii=nft+lft,nft+llt
116 flux(k,ii)=flux_sav(k,ii)
117 ENDDO !next II
118 ENDDO !next K
119 END DO !next NG
120
121C--------------------
122 CALL my_barrier
123C--------------------
124
125C-----------------------------------------------
126C REMISE A JOUR DES FLUX ET UPWIND POUR SRHO3
127C-----------------------------------------------
128 DO ng=itask+1,ngroup,nthread
129C ALE ON / OFF
130 IF (iparg(76, ng) == 1) cycle ! --> OFF
131 CALL initbuf(iparg ,ng ,
132 2 mtn ,llt ,nft ,iad ,ity ,
133 3 npt ,jale ,ismstr ,jeul ,jtur ,
134 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
135 5 nvaux ,jpor ,jcvt ,jclose ,jplasol ,
136 6 irep ,iint ,igtyp ,israt ,isrot ,
137 7 icsen ,isorth ,isorthg ,ifailure,jsms )
138 !------------------------------!
139 ! CONDITIONS DE DEBRANCHEMENT !
140 !------------------------------!
141 IF(jale+jeul == 0) cycle
142 IF(iparg(8,ng) == 1) cycle
143 IF(iparg(1,ng) /= 51) cycle
144 !------------------------------!
145 lft=1
146 nf1=nft+1
147 !------------------------------!
148 ! UPWIND, QMV, DDVOL !
149 !------------------------------!
150 IF(n2d == 0)THEN
151 CALL ale51_upwind3(pm,ixs,flux(1,nf1),flu2(nf1),ale_connect,
152 + 0 ,bid,qmv(12*nft+1) ,0 ,
153 + nv46)
154 ELSE
155 CALL ale51_upwind2(pm,x,ixq,flux(1,nf1),flu2(nf1),ale_connect,
156 + 0,bid,qmv(8*nft+1), 0)
157 ENDIF
158 END DO !next NG
159
160C--------------------
161 CALL my_barrier
162C--------------------
163
164 IF(int22 /= 0)THEN ! obsolete
165 !Restore Volume Fluxes
166 nin = 1
167 nbf = 1+itask*nb/nthread
168 nbl = (itask+1)*nb/nthread
169 nbl = min(nbl,nb)
170 DO ib=nbf,nbl
171 ie = brick_list(nin,ib)%ID
172 mlw = brick_list(nin,ib)%MLW
173 IF(mlw /= 51)cycle
174 DO j=1,6
175 brick_list(nin,ib)%POLY(1:9)%FACE(j)%Adjacent_UpwFLUX(1) = brick_list(nin,ib)%POLY(1:9)%FACE(j)%Adjacent_FLUX(1)
176 brick_list(nin,ib)%POLY(1:9)%FACE(j)%Adjacent_UpwFLUX(2) = brick_list(nin,ib)%POLY(1:9)%FACE(j)%Adjacent_FLUX(2)
177 brick_list(nin,ib)%POLY(1:9)%FACE(j)%Adjacent_UpwFLUX(3) = brick_list(nin,ib)%POLY(1:9)%FACE(j)%Adjacent_FLUX(3)
178 brick_list(nin,ib)%POLY(1:9)%FACE(j)%Adjacent_UpwFLUX(4) = brick_list(nin,ib)%POLY(1:9)%FACE(j)%Adjacent_FLUX(4)
179 brick_list(nin,ib)%POLY(1:9)%FACE(j)%Adjacent_UpwFLUX(5) = brick_list(nin,ib)%POLY(1:9)%FACE(j)%Adjacent_FLUX(5)
180 ENDDO !next J
181 ENDDO
182
183 !Computing Upwind fluxes (inter22 - obsolete)
185 + (pm , ixs , 0 , 0,
186 + iparg, elbuf_tab ,itask )
187
188 ENDIF
189
190C-----------------------------------------------
191 RETURN
192 END
193C
subroutine ale51_finish(iparg, pm, ixs, ixq, x, flux, flu2, alpha, ale_connect, itask, flux_sav, qmv, nv46, elbuf_tab)
subroutine ale51_upwind2(pm, x, ixq, flux, flu1, ale_connect, itrimat, ddvol, qmv, iflg)
subroutine ale51_upwind3(pm, ixs, flux, flu1, ale_connect, itrimat, ddvol, qmv, iflg, nv46)
subroutine ale51_upwind3_int22(pm, ixs, itrimat, iflg, iparg, elbuf_tab, itask)
#define alpha
Definition eval.h:35
#define min(a, b)
Definition macros.h:20
type(brick_entity), dimension(:,:), allocatable, target brick_list
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
subroutine my_barrier
Definition machine.F:31