74 INTEGER,
INTENT(IN) :: ispec
75 TYPE(t_region
),
POINTER :: pregion
81 CHARACTER(CHRLEN) :: rcsidentstring
82 INTEGER :: c1,c2,ifl,ipatch,ispeceev
83 REAL(RFREAL) :: eo1,eo2,flx,idens,ir1,ir2,nx,ny,nz,nm,phi1,phi2,
p1,p2,ry, &
84 ry1,ry2,r1,r2,taucoef,
term,ts1,ts2,ug,ug1,ug2,us,us1,us2, &
85 vg,vg1,vg2,vs,vs1,vs2,wg,wg1,wg2,ws,ws1,ws2
86 REAL(RFREAL),
DIMENSION(:,:),
POINTER :: pcvmixt,pcvspec,pdvmixt,psd, &
88 REAL(RFREAL),
DIMENSION(:,:,:),
POINTER :: peev
90 TYPE(t_grid),
POINTER :: pgrid
91 TYPE(t_patch),
POINTER :: ppatch
98 rcsidentstring =
'$RCSfile: SPEC_EqEulCorr.F90,v $ $Revision: 1.8 $'
100 global => pregion%global
103 'SPEC_EqEulCorr.F90')
109 pgrid => pregion%grid
110 psd => pregion%mixt%sd
111 pcvmixt => pregion%mixt%cv
112 pcvspec => pregion%spec%cv
113 pdvmixt => pregion%mixt%cv
114 rhsmixt => pregion%mixt%rhs
115 rhsspec => pregion%spec%rhs
116 peev => pregion%spec%eev
118 pspectype => pregion%specInput%specType(ispec)
120 taucoef = pspectype%tauCoefficient
121 ispeceev = pspectype%iSpec2iSpecEEv
122 idens = 1.0_rfreal/pspectype%pMaterial%dens
128 IF ( pspectype%discreteFlag .EQV. .false. )
THEN
129 CALL
errorstop(global,err_illegal_value,__line__)
132 IF ( pspectype%velocityMethod /= spec_methv_eqeul )
THEN
133 CALL
errorstop(global,err_illegal_value,__line__)
136 IF ( taucoef <= 0.0_rfreal )
THEN
137 CALL
errorstop(global,err_illegal_value,__line__)
140 IF ( pregion%mixtInput%indSd /= 1 )
THEN
141 CALL
errorstop(global,err_illegal_value,__line__)
144 IF ( pregion%mixt%cvState /= cv_mixt_state_cons )
THEN
145 CALL
errorstop(global,err_cv_state_invalid,__line__)
148 IF ( pregion%spec%cvState /= cv_mixt_state_cons )
THEN
149 CALL
errorstop(global,err_cv_state_invalid,__line__)
156 DO ifl = 1,pgrid%nFaces
157 c1 = pgrid%f2c(1,ifl)
158 c2 = pgrid%f2c(2,ifl)
160 nx = pgrid%fn(xcoord,ifl)
161 ny = pgrid%fn(ycoord,ifl)
162 nz = pgrid%fn(zcoord,ifl)
163 nm = pgrid%fn(xyzmag,ifl)
169 ir1 = 1.0_rfreal/pcvmixt(cv_mixt_dens,c1)
170 ug1 = ir1*pcvmixt(cv_mixt_xmom,c1)
171 vg1 = ir1*pcvmixt(cv_mixt_ymom,c1)
172 wg1 = ir1*pcvmixt(cv_mixt_zmom,c1)
173 eo1 = ir1*pcvmixt(cv_mixt_ener,c1)
174 p1 = pdvmixt(dv_mixt_pres,c1)
176 ir2 = 1.0_rfreal/pcvmixt(cv_mixt_dens,c2)
177 ug2 = ir2*pcvmixt(cv_mixt_xmom,c2)
178 vg2 = ir2*pcvmixt(cv_mixt_ymom,c2)
179 wg2 = ir2*pcvmixt(cv_mixt_zmom,c2)
180 eo2 = ir2*pcvmixt(cv_mixt_ener,c2)
181 p2 = pdvmixt(dv_mixt_pres,c2)
183 ry1 = pcvspec(ispec,c1)
184 ry2 = pcvspec(ispec,c2)
189 us1 = peev(eev_spec_xvel,ispeceev,c1)
190 vs1 = peev(eev_spec_yvel,ispeceev,c1)
191 ws1 = peev(eev_spec_zvel,ispeceev,c1)
192 ts1 = peev(eev_spec_temp,ispeceev,c1)
194 us2 = peev(eev_spec_xvel,ispeceev,c2)
195 vs2 = peev(eev_spec_yvel,ispeceev,c2)
196 ws2 = peev(eev_spec_zvel,ispeceev,c2)
197 ts2 = peev(eev_spec_temp,ispeceev,c2)
203 ry = 0.5_rfreal*(ry1 + ry2)
205 ug = 0.5_rfreal*(ug1 + ug2)
206 vg = 0.5_rfreal*(vg1 + vg2)
207 wg = 0.5_rfreal*(wg1 + wg2)
209 us = 0.5_rfreal*(us1 + us2)
210 vs = 0.5_rfreal*(vs1 + vs2)
211 ws = 0.5_rfreal*(ws1 + ws2)
214 flx = ((us-ug)*nx + (vs-vg)*ny + (ws-wg)*nz)*nm
224 rhsspec(ispec ,c1) = rhsspec(ispec ,c1) +
term
225 rhsspec(ispec ,c2) = rhsspec(ispec ,c2) -
term
227 rhsmixt(cv_mixt_dens,c1) = rhsmixt(cv_mixt_dens,c1) +
term
228 rhsmixt(cv_mixt_dens,c2) = rhsmixt(cv_mixt_dens,c2) -
term
230 rhsmixt(cv_mixt_xmom,c1) = rhsmixt(cv_mixt_xmom,c1) +
term*ug1
231 rhsmixt(cv_mixt_xmom,c2) = rhsmixt(cv_mixt_xmom,c2) -
term*ug2
233 rhsmixt(cv_mixt_ymom,c1) = rhsmixt(cv_mixt_ymom,c1) +
term*vg1
234 rhsmixt(cv_mixt_ymom,c2) = rhsmixt(cv_mixt_ymom,c2) -
term*vg2
236 rhsmixt(cv_mixt_zmom,c1) = rhsmixt(cv_mixt_zmom,c1) +
term*wg1
237 rhsmixt(cv_mixt_zmom,c2) = rhsmixt(cv_mixt_zmom,c2) -
term*wg2
239 rhsmixt(cv_mixt_ener,c1) = rhsmixt(cv_mixt_ener,c1) +
term*eo1 + flx*
p1*phi1
240 rhsmixt(cv_mixt_ener,c2) = rhsmixt(cv_mixt_ener,c2) -
term*eo2 - flx*p2*phi2
247 DO ipatch=1,pregion%grid%nPatches
248 ppatch => pregion%patches(ipatch)
subroutine spec_eqeulcorr(pRegion, iSpec)
subroutine registerfunction(global, funName, fileName)
subroutine spec_eqeulcorrpatch(pRegion, pPatch, iSpec)
subroutine errorstop(global, errorCode, errorLine, addMessage)
subroutine deregisterfunction(global)