OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
ebcs5.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!|| ebcs5 ../engine/source/boundary_conditions/ebcs/ebcs5.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 ebcs5(NSEG,ISEG,SEGVAR,
32 . A,V,X,
33 . LISTE,NOD,IRECT,
34 . LA,FV,MS,STIFN,EBCS)
35 USE ebcs_mod
36 USE segvar_mod
37C-----------------------------------------------
38C I m p l i c i t T y p e s
39C-----------------------------------------------
40#include "implicit_f.inc"
41C-----------------------------------------------
42C C o m m o n B l o c k s
43C-----------------------------------------------
44#include "com08_c.inc"
45#include "scr11_c.inc"
46C-----------------------------------------------
47C D u m m y A r g u m e n t s
48C-----------------------------------------------
49 INTEGER NSEG,NOD,ISEG(NSEG),LISTE(NOD),IRECT(4,NSEG)
50 my_real
51 . A(3,*),V(3,*),X(3,*),
52 . la(3,nod),ms(*),stifn(*),fv(*)
53 TYPE(t_ebcs_normv), INTENT(IN) :: EBCS
54 TYPE(t_segvar) :: SEGVAR
55C-----------------------------------------------
56C L o c a l V a r i a b l e s
57C-----------------------------------------------
58 INTEGER I,IS,KSEG,N1,N2,N3,N4,NG1,NG2,NG3,NG4,N,IVIMP,
59 . IRHO,IENER
60 my_real
61 . orient,rho,c,roc,fac,
62 . x13,y13,z13,x24,y24,z24,nx,ny,nz,s,
63 . roou,enou,vmx,vmy,vmz,fluxi,fluxo,p,dvx,dvy,dvz,vimp,ener
64C-----------------------------------------------
65 ivimp=ebcs%ivimp
66 irho=ebcs%irho
67 iener=ebcs%iener
68 IF(ivimp>0)THEN
69 vimp=ebcs%vimp*fv(ivimp)
70 ELSE
71 vimp=ebcs%vimp
72 ENDIF
73 IF(irho>0)THEN
74 rho=ebcs%rho*fv(irho)
75 ELSE
76 rho=ebcs%rho
77 ENDIF
78 IF(iener>0)THEN
79 ener=ebcs%ener*fv(iener)
80 ELSE
81 ener=ebcs%ener
82 ENDIF
83c write(6,*)'ebcs5 V rho e',VIMP,RHO,ENER
84 c=ebcs%c
85 roc=rho*c
86C
87C INITIALISATION DES DENSITES ET ENERGIES INITIALES
88C
89C SURFACE NORMALE NODALES
90 DO i=1,nod
91 la(1,i)=zero
92 la(2,i)=zero
93 la(3,i)=zero
94 ENDDO
95 DO is=1,nseg
96 kseg=abs(iseg(is))
97 orient=float(iseg(is)/kseg)
98 n1=irect(1,is)
99 n2=irect(2,is)
100 n3=irect(3,is)
101 n4=irect(4,is)
102 IF(n4==0 .OR. n4==n3) THEN
103 fac=one_over_6*orient
104 n4=n3
105 ELSE
106 fac=one_over_8*orient
107 ENDIF
108c
109 ng1=liste(n1)
110 ng2=liste(n2)
111 ng3=liste(n3)
112 ng4=liste(n4)
113 x13=x(1,ng3)-x(1,ng1)
114 y13=x(2,ng3)-x(2,ng1)
115 z13=x(3,ng3)-x(3,ng1)
116 x24=x(1,ng4)-x(1,ng2)
117 y24=x(2,ng4)-x(2,ng2)
118 z24=x(3,ng4)-x(3,ng2)
119c
120 nx=(y13*z24-z13*y24)*fac
121 ny=(z13*x24-x13*z24)*fac
122 nz=(x13*y24-y13*x24)*fac
123c
124 la(1,n1)=la(1,n1)+nx
125 la(2,n1)=la(2,n1)+ny
126 la(3,n1)=la(3,n1)+nz
127 la(1,n2)=la(1,n2)+nx
128 la(2,n2)=la(2,n2)+ny
129 la(3,n2)=la(3,n2)+nz
130 la(1,n3)=la(1,n3)+nx
131 la(2,n3)=la(2,n3)+ny
132 la(3,n3)=la(3,n3)+nz
133C
134 vmx=v(1,ng1)+v(1,ng2)+v(1,ng3)
135 vmy=v(2,ng1)+v(2,ng2)+v(2,ng3)
136 vmz=v(3,ng1)+v(3,ng2)+v(3,ng3)
137 IF(n4/=n3) THEN
138 la(1,n4)=la(1,n4)+nx
139 la(2,n4)=la(2,n4)+ny
140 la(3,n4)=la(3,n4)+nz
141 vmx=vmx+v(1,ng4)
142 vmy=vmy+v(2,ng4)
143 vmz=vmz+v(3,ng4)
144 ENDIF
145C
146c bilan masse et energie totale
147c
148 roou = segvar%RHO(kseg)
149 enou = segvar%EINT(kseg)
150c
151 fluxo=(vmx*nx+vmy*ny+vmz*nz)*dt1
152 fluxi=min(fluxo,zero)
153 fluxo=max(fluxo,zero)
154c
155 dmf=dmf-fluxo*roou-fluxi*rho
156 def=def-fluxo*enou-fluxi*ener
157C
158C stockage densit et nergie entrante dans buffer facette
159C
160 segvar%RHO(kseg)=rho
161 segvar%EINT(kseg)=ener
162 ENDDO
163C
164 IF(tt==0)THEN
165 DO i=1,nod
166 n=liste(i)
167 fac=vimp/sqrt(la(1,i)**2+la(2,i)**2+la(3,i)**2)
168 v(1,n)=fac*la(1,i)
169 v(2,n)=fac*la(2,i)
170 v(3,n)=fac*la(3,i)
171 ENDDO
172 ENDIF
173C
174 DO i=1,nod
175 n=liste(i)
176 s=sqrt(la(1,i)**2+la(2,i)**2+la(3,i)**2)
177 dvx=v(1,n)-vimp*la(1,i)/s
178 dvy=v(2,n)-vimp*la(2,i)/s
179 dvz=v(3,n)-vimp*la(3,i)/s
180c write(6,*)I,N,v(3,N),v0(3,I),roc
181 p=roc*(dvx*la(1,i)+dvy*la(2,i)+dvz*la(3,i))/s
182c
183 a(1,n)=a(1,n)-p*la(1,i)
184 a(2,n)=a(2,n)-p*la(2,i)
185 a(3,n)=a(3,n)-p*la(3,i)
186 stifn(n)=stifn(n)+(two*(s*roc)**2)/ms(n)
187 ENDDO
188c
189 RETURN
190 END
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
ebcs5
subroutine ebcs5(nseg, iseg, segvar, a, v, x, liste, nod, irect, la, fv, ms, stifn, ebcs)
Definition ebcs5.F:35
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