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