44
45
46
47 USE ebcs_mod
49 USE output_mod , ONLY : output_
50
51
52
53#include "implicit_f.inc"
54
55
56
57
58
59
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
65 TYPE(OUTPUT_), INTENT(INOUT) :: OUTPUT
66
67
68
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
74
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
98
99 c=ebcs%c
100 roc=rho*c
101
102
103
104
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
124
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)
135
136 nx=(y13*z24-z13*y24)*fac
137 ny=(z13*x24-x13*z24)*fac
138 nz=(x13*y24-y13*x24)*fac
139
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
149
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
161
162
163
164 roou = segvar%RHO(kseg)
165 enou = segvar%EINT(kseg)
166
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
174
175
176
177 segvar%RHO(kseg)=rho
178 segvar%EINT(kseg)=ener
179 ENDDO
180
181
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
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
197
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
204
205 p=roc*(dvx*la(1,i)+dvy*la(2,i)+dvz*la(3,i))/s
206
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
212
213 RETURN