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 40 of file ale51_finish.F.

43C-----------------------------------------------
44C M o d u l e s
45C-----------------------------------------------
46 USE initbuf_mod
47 USE elbufdef_mod
48 USE i22bufbric_mod
49 USE i22tri_mod
50 USE ale_connectivity_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)
182 CALL ale51_upwind3_int22
183 + (pm , ixs , 0 , 0,
184 + iparg, elbuf_tab ,itask )
185
186 ENDIF
187
188C-----------------------------------------------
189 RETURN
ale51_upwind2
subroutine ale51_upwind2(pm, x, ixq, flux, flu1, ale_connect, itrimat, ddvol, qmv, iflg)
Definition ale51_upwind2.F:34
ale51_upwind3
subroutine ale51_upwind3(pm, ixs, flux, flu1, ale_connect, itrimat, ddvol, qmv, iflg, nv46)
Definition ale51_upwind3.F:36
ale51_upwind3_int22
subroutine ale51_upwind3_int22(pm, ixs, itrimat, iflg, iparg, elbuf_tab, itask)
Definition ale51_upwind3_int22.F:40
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:223
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