OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
ebcs5_normv_mod Module Reference

Functions/Subroutines

subroutine ebcs5_normv (nseg, iseg, segvar, a, v, x, liste, nod, irect, la, fv, ms, stifn, ebcs, output, dt1, time)

Function/Subroutine Documentation

◆ ebcs5_normv()

subroutine ebcs5_normv_mod::ebcs5_normv ( integer nseg,
integer, dimension(nseg) iseg,
type(t_segvar) segvar,
a,
v,
x,
integer, dimension(nod) liste,
integer nod,
integer, dimension(4,nseg) irect,
la,
fv,
ms,
stifn,
type(t_ebcs_normv), intent(in) ebcs,
type(output_), intent(inout) output,
intent(in) dt1,
intent(in) time )
Parameters
[in,out]outputoutput structure

Definition at line 40 of file ebcs5_normv.F.

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
#define my_real
Definition cppsort.cpp:32
#define min(a, b)
Definition macros.h:20
#define max(a, b)
Definition macros.h:21