OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
ebcs1.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!|| ebcs1 ../engine/source/boundary_conditions/ebcs/ebcs1.F
25!||--- called by ------------------------------------------------------
26!|| ebcs_main ../engine/source/boundary_conditions/ebcs/ebcs_main.F
27!||--- uses -----------------------------------------------------
28!|| ebcs_mod ../common_source/modules/boundary_conditions/ebcs_mod.F90
29!|| segvar_mod ../engine/share/modules/segvar_mod.F
30!||====================================================================
31 SUBROUTINE ebcs1(NSEG,ISEG,SEGVAR,
32 . A,V,X,
33 . LISTE,NOD,IRECT,
34 . VO,PO,LA,
35 . FV,MS,STIFN,EBCS_TAB, IEBCS)
36 USE ebcs_mod
37 USE segvar_mod
38C-----------------------------------------------
39C I m p l i c i t T y p e s
40C-----------------------------------------------
41#include "implicit_f.inc"
42C-----------------------------------------------
43C C o m m o n B l o c k s
44C-----------------------------------------------
45#include "com08_c.inc"
46#include "scr11_c.inc"
47C-----------------------------------------------
48C D u m m y A r g u m e n t s
49C-----------------------------------------------
50 INTEGER NSEG,NOD,ISEG(NSEG),LISTE(NOD),IRECT(4,NSEG)
51 my_real
52 . A(3,*),X(3,*),V(3,*),LA(3,NOD),
53 . VO(NOD),PO(NOD),FV(*),MS(*),STIFN(*)
54 TYPE(t_ebcs_tab), TARGET, INTENT(IN) :: EBCS_TAB
55 INTEGER, INTENT(IN) :: IEBCS
56 TYPE(t_segvar) :: SEGVAR
57C-----------------------------------------------
58C L o c a l V a r i a b l e s
59C-----------------------------------------------
60 INTEGER IPRES,IRHO,I,IS,KSEG,N1,N2,N3,N4,NG1,NG2,NG3,NG4,
61 . N,IENER
62 my_real
63 . ORIENT,PRES,RHO,C,LCAR,R1,R2,ROC,ALP,FAC,
64 . x13,y13,z13,x24,y24,z24,nx,ny,nz,s,
65 . roou,enou,vmx,vmy,vmz,fluxi,fluxo,vn,pn,du,dp,p,
66 . ener,dpdv
67 CLASS(t_ebcs), POINTER :: EBCS
68C-----------------------------------------------
69C Presssion et densite imposes
70 EBCS => ebcs_tab%tab(iebcs)%poly
71 c = zero
72 lcar = zero
73 ener = zero
74 pres = zero
75 rho = zero
76 r1 = zero
77 r2 = zero
78 ipres = 0
79 irho = 0
80 iener = 0
81 SELECT TYPE (ebcs)
82 TYPE IS (t_ebcs_pres)
83 ipres=ebcs%ipres
84 irho=ebcs%irho
85 iener=ebcs%iener
86 IF(ipres>0)THEN
87 pres=ebcs%pres*fv(ipres)
88 ELSE
89 pres=ebcs%pres
90 ENDIF
91 IF(irho>0)THEN
92 rho=ebcs%rho*fv(irho)
93 ELSE
94 rho=ebcs%rho
95 ENDIF
96 IF(iener>0)THEN
97 ener=ebcs%ener*fv(iener)
98 ELSE
99 ener=ebcs%ener
100 ENDIF
101 c=ebcs%c
102 lcar=ebcs%lcar
103 r1=ebcs%r1
104 r2=ebcs%r2
105 TYPE IS (t_ebcs_valvin)
106 ipres=ebcs%ipres
107 irho=ebcs%irho
108 iener=ebcs%iener
109 IF(ipres>0)THEN
110 pres=ebcs%pres*fv(ipres)
111 ELSE
112 pres=ebcs%pres
113 ENDIF
114 IF(irho>0)THEN
115 rho=ebcs%rho*fv(irho)
116 ELSE
117 rho=ebcs%rho
118 ENDIF
119 IF(iener>0)THEN
120 ener=ebcs%ener*fv(iener)
121 ELSE
122 ener=ebcs%ener
123 ENDIF
124 c=ebcs%c
125 lcar=ebcs%lcar
126 r1=ebcs%r1
127 r2=ebcs%r2
128 TYPE IS (t_ebcs_valvout)
129 ipres=ebcs%ipres
130 irho=ebcs%irho
131 iener=ebcs%iener
132 IF(ipres>0)THEN
133 pres=ebcs%pres*fv(ipres)
134 ELSE
135 pres=ebcs%pres
136 ENDIF
137 IF(irho>0)THEN
138 rho=ebcs%rho*fv(irho)
139 ELSE
140 rho=ebcs%rho
141 ENDIF
142 IF(iener>0)THEN
143 ener=ebcs%ener*fv(iener)
144 ELSE
145 ener=ebcs%ener
146 ENDIF
147 c=ebcs%c
148 lcar=ebcs%lcar
149 r1=ebcs%r1
150 r2=ebcs%r2
151 END SELECT
152
153 roc=rho*c
154c
155c write(6,*)R1,R2,LCAR
156c
157 alp=zero
158 IF (lcar>0)alp=c*dt1/lcar
159C SURFACE NORMALE NODALES
160 DO i=1,nod
161 la(1,i)=zero
162 la(2,i)=zero
163 la(3,i)=zero
164 ENDDO
165 DO is=1,nseg
166 kseg=abs(iseg(is))
167 orient=float(iseg(is)/kseg)
168 n1=irect(1,is)
169 n2=irect(2,is)
170 n3=irect(3,is)
171 n4=irect(4,is)
172 IF(n4==0 .OR. n4==n3) THEN
173 fac=one_over_6*orient
174 n4=n3
175 ELSE
176 fac=one_over_8*orient
177 ENDIF
178c
179 ng1=liste(n1)
180 ng2=liste(n2)
181 ng3=liste(n3)
182 ng4=liste(n4)
183 x13=x(1,ng3)-x(1,ng1)
184 y13=x(2,ng3)-x(2,ng1)
185 z13=x(3,ng3)-x(3,ng1)
186 x24=x(1,ng4)-x(1,ng2)
187 y24=x(2,ng4)-x(2,ng2)
188 z24=x(3,ng4)-x(3,ng2)
189c
190 nx=(y13*z24-z13*y24)*fac
191 ny=(z13*x24-x13*z24)*fac
192 nz=(x13*y24-y13*x24)*fac
193c
194 la(1,n1)=la(1,n1)+nx
195 la(2,n1)=la(2,n1)+ny
196 la(3,n1)=la(3,n1)+nz
197 la(1,n2)=la(1,n2)+nx
198 la(2,n2)=la(2,n2)+ny
199 la(3,n2)=la(3,n2)+nz
200 la(1,n3)=la(1,n3)+nx
201 la(2,n3)=la(2,n3)+ny
202 la(3,n3)=la(3,n3)+nz
203C
204 vmx=v(1,ng1)+v(1,ng2)+v(1,ng3)
205 vmy=v(2,ng1)+v(2,ng2)+v(2,ng3)
206 vmz=v(3,ng1)+v(3,ng2)+v(3,ng3)
207 IF(n4/=n3) THEN
208 la(1,n4)=la(1,n4)+nx
209 la(2,n4)=la(2,n4)+ny
210 la(3,n4)=la(3,n4)+nz
211 vmx=vmx+v(1,ng4)
212 vmy=vmy+v(2,ng4)
213 vmz=vmz+v(3,ng4)
214 ENDIF
215C
216c bilan masse et energie totale
217c
218 roou = segvar%RHO(kseg)
219 enou = segvar%EINT(kseg)
220C
221 fluxo=(vmx*nx+vmy*ny+vmz*nz)*dt1
222 fluxi=min(fluxo,zero)
223 fluxo=max(fluxo,zero)
224 dmf=dmf-fluxo*roou-fluxi*rho
225 def=def-fluxo*enou-fluxi*ener
226C
227C stockage densite et energie entrante dans buffer facette
228C
229 segvar%RHO(kseg)=rho
230 segvar%EINT(kseg)=ener
231 ENDDO
232C
233 DO i=1,nod
234 n=liste(i)
235 s=sqrt(la(1,i)**2+la(2,i)**2+la(3,i)**2)
236 vn=(v(1,n)*la(1,i)+v(2,n)*la(2,i)+v(3,n)*la(3,i))/s
237C ajout resistance
238 pn=pres+r1*vn+r2*vn*abs(vn)
239 dpdv=roc+r1+two*r2*abs(vn)
240c condition darret
241c write(6,*)i,n,pn,pres,-0.5*RHO*VN**2
242 IF(vn<0)THEN
243 pn=pn-half*rho*vn**2
244 dpdv=dpdv-rho*vn
245 ENDIF
246c frontiere silencieuse
247 IF(tt>0)THEN
248 du=roc*(vn-vo(i))
249 ELSE
250 du=zero
251 po(i)=pn
252 ENDIF
253 dp=alp*(pn-po(i))
254c write(6,*)'vitesse',vn,vo(i)
255 vo(i)=vn
256 p=po(i)+dp+du
257 IF(c==zero)p=pn
258c write(6,*)'ebcs1 pression',p,'vn',vn,'dp',dp,'du',du
259c
260 a(1,n)=a(1,n)-p*la(1,i)
261 a(2,n)=a(2,n)-p*la(2,i)
262 a(3,n)=a(3,n)-p*la(3,i)
263C contribution des forces a la perte d'energie globale
264 def=def-half*(po(i)+p)*dt1*vn*s
265 po(i)=p
266 stifn(n)=stifn(n)+(two*(s*dpdv)**2)/ms(n)
267c write(6,*)'stifn',STIFN(N)
268 ENDDO
269c
270 RETURN
271 END
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
ebcs1
subroutine ebcs1(nseg, iseg, segvar, a, v, x, liste, nod, irect, vo, po, la, fv, ms, stifn, ebcs_tab, iebcs)
Definition ebcs1.F:36
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
segvar_mod
Definition segvar_mod.F:61