OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
ale51_finish.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "vect01_c.inc"
#include "param_c.inc"
#include "task_c.inc"
#include "inter22.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine ale51_finish (iparg, pm, ixs, ixq, x, flux, flu2, alpha, ale_connect, itask, flux_sav, qmv, nv46, elbuf_tab)

Function/Subroutine Documentation

◆ ale51_finish()

subroutine ale51_finish ( integer, dimension(nparg,ngroup) iparg,
pm,
integer, dimension(nixs,numels) ixs,
integer, dimension(7,numelq) ixq,
x,
flux,
flu2,
alpha,
type(t_ale_connectivity), intent(in) ale_connect,
integer itask,
flux_sav,
qmv,
integer nv46,
type(elbuf_struct_), dimension(ngroup), target elbuf_tab )

Definition at line 41 of file ale51_finish.F.

44C-----------------------------------------------
45C M o d u l e s
46C-----------------------------------------------
47 USE initbuf_mod
48 USE elbufdef_mod
49 USE i22bufbric_mod
50 USE i22tri_mod
51 USE ale_connectivity_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)
184 CALL ale51_upwind3_int22
185 + (pm , ixs , 0 , 0,
186 + iparg, elbuf_tab ,itask )
187
188 ENDIF
189
190C-----------------------------------------------
191 RETURN
ale51_upwind2
subroutine ale51_upwind2(pm, x, ixq, flux, flu1, ale_connect, itrimat, ddvol, qmv, iflg)
Definition ale51_upwind2.F:35
ale51_upwind3
subroutine ale51_upwind3(pm, ixs, flux, flu1, ale_connect, itrimat, ddvol, qmv, iflg, nv46)
Definition ale51_upwind3.F:37
ale51_upwind3_int22
subroutine ale51_upwind3_int22(pm, ixs, itrimat, iflg, iparg, elbuf_tab, itask)
Definition ale51_upwind3_int22.F:41
my_real
#define my_real
Definition cppsort.cpp:32
alpha
#define alpha
Definition eval.h:35
min
#define min(a, b)
Definition macros.h:20
ale_connectivity_mod
Definition ale_connectivity_mod.F:225
i22bufbric_mod
Definition cut-cell-search_mod.F:95
i22bufbric_mod::brick_list
type(brick_entity), dimension(:,:), allocatable, target brick_list
Definition cut-cell-search_mod.F:105
i22tri_mod
Definition cut-cell-search_mod.F:212
i22tri_mod::nb
integer nb
Definition cut-cell-search_mod.F:487
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
my_barrier
subroutine my_barrier
Definition machine.F:31