OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
ebcs5_normv.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_normv_mod ../engine/source/boundary_conditions/ebcs/ebcs5_normv.F
25!||--- called by ------------------------------------------------------
26!|| ebcs_main ../engine/source/boundary_conditions/ebcs/ebcs_main.F
27!||====================================================================
28 MODULE ebcs5_normv_mod
29 IMPLICIT NONE
30 CONTAINS
31!||====================================================================
32!|| ebcs5_normv ../engine/source/boundary_conditions/ebcs/ebcs5_normv.F
33!||--- called by ------------------------------------------------------
34!|| ebcs_main ../engine/source/boundary_conditions/ebcs/ebcs_main.F
35!||--- uses -----------------------------------------------------
36!|| ebcs_mod ../common_source/modules/boundary_conditions/ebcs_mod.F90
37!|| output_mod ../common_source/modules/output/output_mod.F90
38!|| segvar_mod ../engine/share/modules/segvar_mod.F
39!||====================================================================
40 SUBROUTINE ebcs5_normv(NSEG,ISEG,SEGVAR,
41 . A,V,X,
42 . LISTE,NOD,IRECT,
43 . LA,FV,MS,STIFN,EBCS,OUTPUT,DT1,TIME)
44C-----------------------------------------------
45C M o d u l e s
46C-----------------------------------------------
47 USE ebcs_mod
48 USE segvar_mod
49 USE output_mod , ONLY : output_
50C-----------------------------------------------
51C I m p l i c i t T y p e s
52C-----------------------------------------------
53#include "implicit_f.inc"
54C-----------------------------------------------
55C C o m m o n B l o c k s
56C-----------------------------------------------
57C-----------------------------------------------
58C D u m m y A r g u m e n t s
59C-----------------------------------------------
60 INTEGER NSEG,NOD,ISEG(NSEG),LISTE(NOD),IRECT(4,NSEG)
61 my_real :: A(3,*),V(3,*),X(3,*), LA(3,NOD),MS(*),STIFN(*),FV(*)
62 TYPE(t_ebcs_normv), INTENT(IN) :: EBCS
63 TYPE(t_segvar) :: SEGVAR
64 my_real,INTENT(IN) :: dt1, time
65 TYPE(output_), INTENT(INOUT) :: OUTPUT !< output structure
66C-----------------------------------------------
67C L o c a l V a r i a b l e s
68C-----------------------------------------------
69 INTEGER :: I,IS,KSEG,N1,N2,N3,N4,NG1,NG2,NG3,NG4,N,IVIMP,IRHO,IENER
70 my_real :: ORIENT,RHO,C,ROC,FAC,
71 . X13,Y13,Z13,X24,Y24,Z24,NX,NY,NZ,S,
72 . roou,enou,vmx,vmy,vmz,fluxi,fluxo,p,dvx,dvy,dvz,vimp,ener
73 my_real :: de_in, de_out, dm_in, dm_out
74C-----------------------------------------------
75 ivimp=ebcs%ivimp
76 irho=ebcs%irho
77 iener=ebcs%iener
78 de_in = zero
79 de_out = zero
80 dm_in = zero
81 dm_out = zero
82
83 IF(ivimp > 0)THEN
84 vimp=ebcs%vimp*fv(ivimp)
85 ELSE
86 vimp=ebcs%vimp
87 ENDIF
88 IF(irho > 0)THEN
89 rho=ebcs%rho*fv(irho)
90 ELSE
91 rho=ebcs%rho
92 ENDIF
93 IF(iener > 0)THEN
94 ener=ebcs%ener*fv(iener)
95 ELSE
96 ener=ebcs%ener
97 ENDIF
98c write(6,*)'ebcs5 V rho e',VIMP,RHO,ENER
99 c=ebcs%c
100 roc=rho*c
101C
102C initialization of initial densities and energies
103C
104 ! Normal Vectors at Nodes
105 DO i=1,nod
106 la(1,i)=zero
107 la(2,i)=zero
108 la(3,i)=zero
109 ENDDO
110
111 DO is=1,nseg
112 kseg=abs(iseg(is))
113 orient=float(iseg(is)/kseg)
114 n1=irect(1,is)
115 n2=irect(2,is)
116 n3=irect(3,is)
117 n4=irect(4,is)
118 IF(n4==0 .OR. n4==n3) THEN
119 fac=one_over_6*orient
120 n4=n3
121 ELSE
122 fac=one_over_8*orient
123 ENDIF
124c
125 ng1=liste(n1)
126 ng2=liste(n2)
127 ng3=liste(n3)
128 ng4=liste(n4)
129 x13=x(1,ng3)-x(1,ng1)
130 y13=x(2,ng3)-x(2,ng1)
131 z13=x(3,ng3)-x(3,ng1)
132 x24=x(1,ng4)-x(1,ng2)
133 y24=x(2,ng4)-x(2,ng2)
134 z24=x(3,ng4)-x(3,ng2)
135c
136 nx=(y13*z24-z13*y24)*fac
137 ny=(z13*x24-x13*z24)*fac
138 nz=(x13*y24-y13*x24)*fac
139c
140 la(1,n1)=la(1,n1)+nx
141 la(2,n1)=la(2,n1)+ny
142 la(3,n1)=la(3,n1)+nz
143 la(1,n2)=la(1,n2)+nx
144 la(2,n2)=la(2,n2)+ny
145 la(3,n2)=la(3,n2)+nz
146 la(1,n3)=la(1,n3)+nx
147 la(2,n3)=la(2,n3)+ny
148 la(3,n3)=la(3,n3)+nz
149C
150 vmx=v(1,ng1)+v(1,ng2)+v(1,ng3)
151 vmy=v(2,ng1)+v(2,ng2)+v(2,ng3)
152 vmz=v(3,ng1)+v(3,ng2)+v(3,ng3)
153 IF(n4/=n3) THEN
154 la(1,n4)=la(1,n4)+nx
155 la(2,n4)=la(2,n4)+ny
156 la(3,n4)=la(3,n4)+nz
157 vmx=vmx+v(1,ng4)
158 vmy=vmy+v(2,ng4)
159 vmz=vmz+v(3,ng4)
160 ENDIF
161C
162c mass and total energy balance
163c
164 roou = segvar%RHO(kseg)
165 enou = segvar%EINT(kseg)
166c
167 fluxo=(vmx*nx+vmy*ny+vmz*nz)*dt1
168 fluxi=min(fluxo,zero)
169 fluxo=max(fluxo,zero)
170 dm_out=dm_out-fluxo*roou
171 dm_in=dm_in-fluxi*rho
172 de_out=de_out-fluxo*enou
173 de_in=de_in-fluxi*ener
174C
175C storage of density and incoming energy in facet buffer
176C
177 segvar%RHO(kseg)=rho
178 segvar%EINT(kseg)=ener
179 ENDDO
180
181!$OMP CRITICAL
182 output%DATA%INOUT%DM_IN = output%DATA%INOUT%DM_IN + dm_in
183 output%DATA%INOUT%DM_OUT = output%DATA%INOUT%DM_OUT + dm_out
184 output%DATA%INOUT%DE_IN = output%DATA%INOUT%DE_IN + de_in
185 output%DATA%INOUT%DE_OUT = output%DATA%INOUT%DE_OUT + de_out
186!$OMP END CRITICAL
187
188 IF(time == zero)THEN
189 DO i=1,nod
190 n=liste(i)
191 fac=vimp/sqrt(la(1,i)**2+la(2,i)**2+la(3,i)**2)
192 v(1,n)=fac*la(1,i)
193 v(2,n)=fac*la(2,i)
194 v(3,n)=fac*la(3,i)
195 ENDDO
196 ENDIF
197C
198 DO i=1,nod
199 n=liste(i)
200 s=sqrt(la(1,i)**2+la(2,i)**2+la(3,i)**2)
201 dvx=v(1,n)-vimp*la(1,i)/s
202 dvy=v(2,n)-vimp*la(2,i)/s
203 dvz=v(3,n)-vimp*la(3,i)/s
204c write(6,*)I,N,v(3,N),v0(3,I),roc
205 p=roc*(dvx*la(1,i)+dvy*la(2,i)+dvz*la(3,i))/s
206c
207 a(1,n)=a(1,n)-p*la(1,i)
208 a(2,n)=a(2,n)-p*la(2,i)
209 a(3,n)=a(3,n)-p*la(3,i)
210 stifn(n)=stifn(n)+(two*(s*roc)**2)/ms(n)
211 ENDDO
212c
213 RETURN
214 END SUBROUTINE ebcs5_normv
215 END MODULE ebcs5_normv_mod
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
ebcs5_normv_mod
Definition ebcs5_normv.F:28
ebcs5_normv_mod::ebcs5_normv
subroutine ebcs5_normv(nseg, iseg, segvar, a, v, x, liste, nod, irect, la, fv, ms, stifn, ebcs, output, dt1, time)
Definition ebcs5_normv.F:44
segvar_mod
Definition segvar_mod.F:63
segvar_mod::t_segvar
Definition segvar_mod.F:71