xref: /phasta/phSolver/incompressible/getdiff.f (revision 595995161822a203c8467e0e4a253d7bd7d6df32)
1*59599516SKenneth E. Jansen      subroutine getDiff( dwl,yl, shape, xmudmi, xl, rmu,  rho)
2*59599516SKenneth E. Jansenc-----------------------------------------------------------------------
3*59599516SKenneth E. Jansenc  compute and add the contribution of the turbulent
4*59599516SKenneth E. Jansenc  eddy viscosity to the molecular viscosity.
5*59599516SKenneth E. Jansenc-----------------------------------------------------------------------
6*59599516SKenneth E. Jansen      use     turbSA
7*59599516SKenneth E. Jansen      include "common.h"
8*59599516SKenneth E. Jansen
9*59599516SKenneth E. Jansen      real*8  yl(npro,nshl,ndof), rmu(npro), xmudmi(npro,ngauss),
10*59599516SKenneth E. Jansen     &        shape(npro,nshl),   rho(npro),
11*59599516SKenneth E. Jansen     &        dwl(npro,nshl),     sclr(npro),
12*59599516SKenneth E. Jansen     &        xl(npro,nenl,nsd)
13*59599516SKenneth E. Jansen      integer n, e
14*59599516SKenneth E. Jansen
15*59599516SKenneth E. Jansen      real*8  epsilon_ls, kay, epsilon
16*59599516SKenneth E. Jansen     &        h_param, prop_blend(npro),test_it(npro)
17*59599516SKenneth E. Jansenc
18*59599516SKenneth E. Jansenc
19*59599516SKenneth E. Jansenc.... get the material properties (2 fluid models will need to determine
20*59599516SKenneth E. Jansenc     the "interpolated in phase space" properties....constant for now.
21*59599516SKenneth E. Jansenc     two options exist in the interpolation 1) smooth (recommended)
22*59599516SKenneth E. Jansenc     interpolation of nodal data, 2) discontinuous "sampling" phase at
23*59599516SKenneth E. Jansenc     quadrature points.
24*59599516SKenneth E. Jansenc
25*59599516SKenneth E. JansenCAD
26*59599516SKenneth E. JansenCAD    prop_blend is a smoothing function to avoid possible large density
27*59599516SKenneth E. JansenCAD   gradients, e.g., water and air flows where density ratios can approach
28*59599516SKenneth E. JansenCAD   1000.
29*59599516SKenneth E. JansenCAD
30*59599516SKenneth E. JansenCAD    epsilon_ls is an adjustment to control the width of the band over which
31*59599516SKenneth E. JansenCAD    the properties are blended.
32*59599516SKenneth E. Jansen
33*59599516SKenneth E. Jansen
34*59599516SKenneth E. Jansen
35*59599516SKenneth E. Jansen      if (iLSet .eq. 0)then
36*59599516SKenneth E. Jansen
37*59599516SKenneth E. Jansen         rho  = datmat(1,1,1)	! single fluid model, i.e., only 1 density
38*59599516SKenneth E. Jansen         rmu = datmat(1,2,1)
39*59599516SKenneth E. Jansen
40*59599516SKenneth E. Jansen      else     !  two fluid properties used in this model
41*59599516SKenneth E. Jansen
42*59599516SKenneth E. Jansen!        Smooth the tranistion of properties for a "distance" of epsilon_ls
43*59599516SKenneth E. Jansen!        around the interface.  Here "distance" is define as the value of the
44*59599516SKenneth E. Jansen!        levelset function.  If the levelset function is properly defined,
45*59599516SKenneth E. Jansen!        this is the true distance normal from the front.  Of course, the
46*59599516SKenneth E. Jansen!        distance is in a driection normal to the front.
47*59599516SKenneth E. Jansen
48*59599516SKenneth E. Jansen         Sclr = zero
49*59599516SKenneth E. Jansen         isc=abs(iRANS)+6
50*59599516SKenneth E. Jansen         do n = 1, nshl
51*59599516SKenneth E. Jansen            Sclr = Sclr + shape(:,n) * yl(:,n,isc)
52*59599516SKenneth E. Jansen         enddo
53*59599516SKenneth E. Jansen         do i= 1, npro
54*59599516SKenneth E. Jansen            if (sclr(i) .lt. - epsilon_ls)then
55*59599516SKenneth E. Jansen               prop_blend(i) = zero
56*59599516SKenneth E. Jansen            elseif  (abs(sclr(i)) .le. epsilon_ls)then
57*59599516SKenneth E. Jansen               prop_blend(i) = 0.5*(one + Sclr(i)/epsilon_ls +
58*59599516SKenneth E. Jansen     &              (sin(pi*Sclr(i)/epsilon_ls))/pi )
59*59599516SKenneth E. Jansen            elseif (sclr(i) .gt. epsilon_ls) then
60*59599516SKenneth E. Jansen               prop_blend(i) = one
61*59599516SKenneth E. Jansen            endif
62*59599516SKenneth E. Jansen         enddo
63*59599516SKenneth E. Jansenc
64*59599516SKenneth E. Jansen        rho = datmat(1,1,2) + (datmat(1,1,1)-datmat(1,1,2))*prop_blend
65*59599516SKenneth E. Jansen        rmu = datmat(1,2,2) + (datmat(1,2,1)-datmat(1,2,2))*prop_blend
66*59599516SKenneth E. Jansen
67*59599516SKenneth E. Jansen      endif
68*59599516SKenneth E. Jansen
69*59599516SKenneth E. JansenCAD	At this point we have a rho that is bounded by the two values for
70*59599516SKenneth E. JansenCAD 	density 1, datmat(1,1,1), the fluid,  and density 2, datmat(1,1,2)
71*59599516SKenneth E. JansenCAD     the gas
72*59599516SKenneth E. Jansen
73*59599516SKenneth E. Jansenc
74*59599516SKenneth E. Jansenc  The above approach evaluates all intermediate quantities at the
75*59599516SKenneth E. Jansenc  quadrature point, then combines them to form the needed quantities there.
76*59599516SKenneth E. Jansenc  1 alternative is calculating all quanties (only rho here) at the nodes and
77*59599516SKenneth E. Jansenc  then interpolating the result to the quadrature points.  If this is done,
78*59599516SKenneth E. Jansenc  do not forget to do the same thing for rou in e3b!!!
79*59599516SKenneth E. Jansenc  ^^^^^^^^^^
80*59599516SKenneth E. Jansenc  ||||||||||
81*59599516SKenneth E. Jansenc  WARNING
82*59599516SKenneth E. Jansenc
83*59599516SKenneth E. Jansenc.... dynamic model
84*59599516SKenneth E. Jansenc
85*59599516SKenneth E. Jansen      if (iLES .gt. 0 .and. iRANS.eq.0) then   ! simple LES
86*59599516SKenneth E. Jansen         rmu = rmu + xmudmi(:,intp)
87*59599516SKenneth E. Jansen      else if (iRANS.lt.0) then
88*59599516SKenneth E. Jansen         if (iRANS .eq. -1) then ! RANS (Spalart-Allmaras)
89*59599516SKenneth E. Jansen            call AddEddyViscSA(yl, shape, rmu)
90*59599516SKenneth E. Jansen         else if(iRANS.eq.-2) then ! RANS-KE
91*59599516SKenneth E. Jansen            sigmaInv=1.0        ! use full eddy viscosity for flow equations
92*59599516SKenneth E. Jansen            call AddEddyViscKE(yl, dwl, shape, rho, sigmaInv, rmu)
93*59599516SKenneth E. Jansen         endif
94*59599516SKenneth E. Jansen         if (iLES.gt.0) then    ! this is DES so we have to blend in
95*59599516SKenneth E. Jansen                                ! xmudmi based on max edge length of
96*59599516SKenneth E. Jansen                                ! element
97*59599516SKenneth E. Jansen            call EviscDESIC (xl,rmu,xmudmi)
98*59599516SKenneth E. Jansen         endif
99*59599516SKenneth E. Jansen      endif                     ! check for LES or RANS
100*59599516SKenneth E. Jansenc
101*59599516SKenneth E. Jansen      return
102*59599516SKenneth E. Jansen      end
103*59599516SKenneth E. Jansen
104*59599516SKenneth E. Jansen      subroutine EviscDESIC(xl,xmut,xmudmi)
105*59599516SKenneth E. Jansen
106*59599516SKenneth E. Jansen      include "common.h"
107*59599516SKenneth E. Jansen      real*8 xmut(npro),xl(npro,nenl,nsd),xmudmi(npro,ngauss)
108*59599516SKenneth E. Jansen
109*59599516SKenneth E. Jansen
110*59599516SKenneth E. Jansen      do i=1,npro
111*59599516SKenneth E. Jansen         dx=maxval(xl(i,:,1))-minval(xl(i,:,1))
112*59599516SKenneth E. Jansen         dy=maxval(xl(i,:,2))-minval(xl(i,:,2))
113*59599516SKenneth E. Jansen         dz=maxval(xl(i,:,3))-minval(xl(i,:,3))
114*59599516SKenneth E. Jansen         emax=max(dx,max(dy,dz))
115*59599516SKenneth E. Jansen         if(emax.lt.eles) then  ! pure les
116*59599516SKenneth E. Jansen            xmut(i)=xmudmi(i,intp)
117*59599516SKenneth E. Jansen         else if(emax.lt.two*eles) then ! blend
118*59599516SKenneth E. Jansen            xi=(emax-eles)/(eles)
119*59599516SKenneth E. Jansen            xmut(i)=xi*xmut(i)+(one-xi)*(xmudmi(1,intp)+datmat(1,2,2))
120*59599516SKenneth E. Jansen         endif                  ! leave at RANS value as edge is twice pure les
121*59599516SKenneth E. Jansen      enddo
122*59599516SKenneth E. Jansen !this was made messy by the addEddyVisc routines  Must clean up later.
123*59599516SKenneth E. Jansen
124*59599516SKenneth E. Jansen
125*59599516SKenneth E. Jansen
126*59599516SKenneth E. Jansen      return
127*59599516SKenneth E. Jansen      end
128*59599516SKenneth E. Jansen
129*59599516SKenneth E. Jansen      subroutine getdiffsclr(shape, dwl, yl, diffus)
130*59599516SKenneth E. Jansen
131*59599516SKenneth E. Jansen      use turbSA
132*59599516SKenneth E. Jansen      use turbKE ! access to KE model constants
133*59599516SKenneth E. Jansen      include "common.h"
134*59599516SKenneth E. Jansen
135*59599516SKenneth E. Jansen      real*8   diffus(npro), rho(npro)
136*59599516SKenneth E. Jansen      real*8   yl(npro,nshl,ndof), dwl(npro,nshl), shape(npro,nshl)
137*59599516SKenneth E. Jansen      integer n, e
138*59599516SKenneth E. Jansen      rho(:)  = datmat(1,1,1)	! single fluid model, i.e., only 1 density
139*59599516SKenneth E. Jansen      if(isclr.eq.0) then  ! solving the temperature equation
140*59599516SKenneth E. Jansen         diffus(:) = datmat(1,4,1)
141*59599516SKenneth E. Jansen      else if(iRANS.eq.-1) then ! solving SA model
142*59599516SKenneth E. Jansen         diffus(:) = datmat(1,2,1)
143*59599516SKenneth E. Jansen         call AddSAVar(yl, shape, diffus)
144*59599516SKenneth E. Jansen      else if(iRANS.eq.-2)then ! solving KE model
145*59599516SKenneth E. Jansen         diffus(:) = datmat(1,2,1)
146*59599516SKenneth E. Jansen         if(isclr.eq.2) then
147*59599516SKenneth E. Jansen            sigmaInv=1.0/ke_sigma ! different eddy viscosity for epsilon
148*59599516SKenneth E. Jansen         else
149*59599516SKenneth E. Jansen            sigmaInv=1.0 ! full eddy viscosity for solving kay equation
150*59599516SKenneth E. Jansen         endif
151*59599516SKenneth E. Jansen         call AddEddyViscKE(yl, dwl, shape, rho, sigmaInv, diffus)
152*59599516SKenneth E. Jansen      else                      ! solving scalar advection diffusion equations
153*59599516SKenneth E. Jansen         diffus = scdiff(isclr)
154*59599516SKenneth E. Jansen      endif
155*59599516SKenneth E. Jansenc
156*59599516SKenneth E. Jansen      return
157*59599516SKenneth E. Jansen      end
158*59599516SKenneth E. Jansen
159*59599516SKenneth E. Jansen      function ev2sa(xmut,rm,cv1)
160*59599516SKenneth E. Jansen      implicit none
161*59599516SKenneth E. Jansen      real*8 err,ev2sa,rm,cv1,f,dfds,rat,efac
162*59599516SKenneth E. Jansen      real*8 pt5,kappa,B,xmut,chi3,denom,cv1_3
163*59599516SKenneth E. Jansen      integer iter
164*59599516SKenneth E. Jansen      pt5=0.5
165*59599516SKenneth E. Jansen      err=1.0d-6
166*59599516SKenneth E. Jansen      ev2sa=rm*cv1*1.2599       ! inflection point chi=cv1*cuberoot(2)
167*59599516SKenneth E. Jansen      kappa=0.4
168*59599516SKenneth E. Jansenc$$$        B=5.5
169*59599516SKenneth E. Jansen      efac=0.1108               ! exp(-kappa*B)
170*59599516SKenneth E. Jansen      do iter=1,50
171*59599516SKenneth E. Jansen         chi3=ev2sa/rm
172*59599516SKenneth E. Jansen         chi3=chi3*chi3*chi3
173*59599516SKenneth E. Jansen         cv1_3=cv1**3
174*59599516SKenneth E. Jansen         denom=chi3+cv1_3
175*59599516SKenneth E. Jansen
176*59599516SKenneth E. Jansen         f=ev2sa*chi3/denom - xmut
177*59599516SKenneth E. Jansen         dfds=chi3*(chi3+4.0*cv1_3)/(denom**2)
178*59599516SKenneth E. Jansen         rat=-f/dfds
179*59599516SKenneth E. Jansen         ev2sa=ev2sa+rat
180*59599516SKenneth E. Jansen         if(abs(rat).le.err) goto 20
181*59599516SKenneth E. Jansen      enddo
182*59599516SKenneth E. Jansen      write(*,*)'ev2sa failed to converge'
183*59599516SKenneth E. Jansen      write(*,*) 'dfds,        rat,        ev2sa,        mu'
184*59599516SKenneth E. Jansen      write(*,*) dfds,rat,ev2sa,rm
185*59599516SKenneth E. Jansen 20   continue
186*59599516SKenneth E. Jansen      return
187*59599516SKenneth E. Jansen      end
188*59599516SKenneth E. Jansenc
189*59599516SKenneth E. Jansen
190*59599516SKenneth E. Jansen
191*59599516SKenneth E. Jansen      subroutine AddEddyViscSA(yl,shape,rmu)
192*59599516SKenneth E. Jansen      use turbSA
193*59599516SKenneth E. Jansen      include "common.h"
194*59599516SKenneth E. Jansenc     INPUTS
195*59599516SKenneth E. Jansen      double precision, intent(in), dimension(npro,nshl,ndof) ::
196*59599516SKenneth E. Jansen     &     yl
197*59599516SKenneth E. Jansen      double precision, intent(in), dimension(npro,nshl) ::
198*59599516SKenneth E. Jansen     &     shape
199*59599516SKenneth E. Jansenc     INPUT-OUTPUTS
200*59599516SKenneth E. Jansen      double precision, intent(inout), dimension(npro) ::
201*59599516SKenneth E. Jansen     &     rmu
202*59599516SKenneth E. Jansenc     LOCALS
203*59599516SKenneth E. Jansen      logical, dimension(nshl) ::
204*59599516SKenneth E. Jansen     &     wallnode
205*59599516SKenneth E. Jansen      integer e, n
206*59599516SKenneth E. Jansen      double precision xki, xki3, fv1, evisc
207*59599516SKenneth E. Jansenc
208*59599516SKenneth E. Jansenc     Loop over elements in this block
209*59599516SKenneth E. Jansen      do e = 1, npro
210*59599516SKenneth E. Jansenc        assume no wall nodes on this element
211*59599516SKenneth E. Jansen         wallnode(:) = .false.
212*59599516SKenneth E. Jansen         if(itwmod.eq.-2) then  ! effective viscosity
213*59599516SKenneth E. Jansenc           mark the wall nodes for this element, if there are any
214*59599516SKenneth E. Jansen            do n = 1, nshl
215*59599516SKenneth E. Jansen               u1=yl(e,n,2)
216*59599516SKenneth E. Jansen               u2=yl(e,n,3)
217*59599516SKenneth E. Jansen               u3=yl(e,n,4)
218*59599516SKenneth E. Jansen               if((u1.eq.zero).and.(u2.eq.zero).and.(u3.eq.zero))
219*59599516SKenneth E. Jansen     &              then
220*59599516SKenneth E. Jansen                  wallnode(n)=.true.
221*59599516SKenneth E. Jansen               endif
222*59599516SKenneth E. Jansen            enddo
223*59599516SKenneth E. Jansen         endif
224*59599516SKenneth E. Jansenc
225*59599516SKenneth E. Jansen         if( any(wallnode(:)) ) then
226*59599516SKenneth E. Jansenc if there are wall nodes for this elt, then we are using effective-
227*59599516SKenneth E. Jansenc viscosity near-wall modeling, and eddy viscosity has been stored
228*59599516SKenneth E. Jansenc at the wall nodes in place of the spalart-allmaras variable; the
229*59599516SKenneth E. Jansenc eddy viscosity for the whole element is taken to be the avg of the
230*59599516SKenneth E. Jansenc wall values
231*59599516SKenneth E. Jansen            evisc = zero
232*59599516SKenneth E. Jansen            nwnode=0
233*59599516SKenneth E. Jansen            do n = 1, nshl
234*59599516SKenneth E. Jansen               if(wallnode(n)) then
235*59599516SKenneth E. Jansen                  evisc = evisc + yl(e,n,6)
236*59599516SKenneth E. Jansen                  nwnode = nwnode + 1
237*59599516SKenneth E. Jansen               endif
238*59599516SKenneth E. Jansen            enddo
239*59599516SKenneth E. Jansen            evisc = evisc/nwnode
240*59599516SKenneth E. Jansen            rmu(e) = rmu(e) + abs(evisc)
241*59599516SKenneth E. Jansenc this is what we would use instead of the above if we were allowing
242*59599516SKenneth E. Jansenc the eddy viscosity to vary through the element based on non-wall nodes
243*59599516SKenneth E. Jansenc$$$               evisc = zero
244*59599516SKenneth E. Jansenc$$$               Turb = zero
245*59599516SKenneth E. Jansenc$$$               do n = 1, nshl
246*59599516SKenneth E. Jansenc$$$                  if(wallmask(n).eq.1) then
247*59599516SKenneth E. Jansenc$$$                     evisc = evisc + shape(e,n) * yl(e,n,6)
248*59599516SKenneth E. Jansenc$$$                  else
249*59599516SKenneth E. Jansenc$$$                     Turb = Turb + shape(e,n) * yl(e,n,6)
250*59599516SKenneth E. Jansenc$$$                  endif
251*59599516SKenneth E. Jansenc$$$               enddo
252*59599516SKenneth E. Jansenc$$$               xki    = abs(Turb)/rmu(e)
253*59599516SKenneth E. Jansenc$$$               xki3   = xki * xki * xki
254*59599516SKenneth E. Jansenc$$$               fv1    = xki3 / (xki3 + saCv1P3)
255*59599516SKenneth E. Jansenc$$$               rmu(e) = rmu(e) + fv1*abs(Turb)
256*59599516SKenneth E. Jansenc$$$               rmu(e) = rmu(e) + abs(evisc)
257*59599516SKenneth E. Jansen         else
258*59599516SKenneth E. Jansenc else one of the following is the case:
259*59599516SKenneth E. Jansenc   using effective-viscosity, but no wall nodes on this elt
260*59599516SKenneth E. Jansenc   using slip-velocity
261*59599516SKenneth E. Jansenc   using no model; walls are resolved
262*59599516SKenneth E. Jansenc in all of these cases, eddy viscosity is calculated normally
263*59599516SKenneth E. Jansen            Turb = zero
264*59599516SKenneth E. Jansen            do n = 1, nshl
265*59599516SKenneth E. Jansen               Turb = Turb + shape(e,n) * yl(e,n,6)
266*59599516SKenneth E. Jansen            enddo
267*59599516SKenneth E. Jansen            xki    = abs(Turb)/rmu(e)
268*59599516SKenneth E. Jansen            xki3   = xki * xki * xki
269*59599516SKenneth E. Jansen            fv1    = xki3 / (xki3 + saCv1P3)
270*59599516SKenneth E. Jansen            rmu(e) = rmu(e) + fv1*abs(Turb)
271*59599516SKenneth E. Jansen         endif
272*59599516SKenneth E. Jansen      enddo                     ! end loop over elts
273*59599516SKenneth E. Jansen      return
274*59599516SKenneth E. Jansen      end subroutine AddEddyViscSA
275*59599516SKenneth E. Jansen
276*59599516SKenneth E. Jansen
277*59599516SKenneth E. Jansen
278*59599516SKenneth E. Jansen      subroutine AddSAVar(yl,shape,rmu)
279*59599516SKenneth E. Jansen      use turbSA
280*59599516SKenneth E. Jansen      include "common.h"
281*59599516SKenneth E. Jansenc     INPUTS
282*59599516SKenneth E. Jansen      double precision, intent(in), dimension(npro,nshl,ndof) ::
283*59599516SKenneth E. Jansen     &     yl
284*59599516SKenneth E. Jansen      double precision, intent(in), dimension(npro,nshl) ::
285*59599516SKenneth E. Jansen     &     shape
286*59599516SKenneth E. Jansenc     INPUT-OUTPUTS
287*59599516SKenneth E. Jansen      double precision, intent(inout), dimension(npro) ::
288*59599516SKenneth E. Jansen     &     rmu
289*59599516SKenneth E. Jansenc     LOCALS
290*59599516SKenneth E. Jansen      logical, dimension(nshl) ::
291*59599516SKenneth E. Jansen     &     wallnode
292*59599516SKenneth E. Jansen      integer e, n
293*59599516SKenneth E. Jansen      double precision savar, savarw
294*59599516SKenneth E. Jansenc     Loop over elements in this block
295*59599516SKenneth E. Jansen      do e = 1, npro
296*59599516SKenneth E. Jansenc        assume no wall nodes on this element
297*59599516SKenneth E. Jansen         wallnode(:) = .false.
298*59599516SKenneth E. Jansen         if(itwmod.eq.-2) then  ! effective viscosity
299*59599516SKenneth E. Jansenc           mark the wall nodes for this element, if there are any
300*59599516SKenneth E. Jansen            do n = 1, nshl
301*59599516SKenneth E. Jansen               u1=yl(e,n,2)
302*59599516SKenneth E. Jansen               u2=yl(e,n,3)
303*59599516SKenneth E. Jansen               u3=yl(e,n,4)
304*59599516SKenneth E. Jansen               if((u1.eq.zero).and.(u2.eq.zero).and.(u3.eq.zero))
305*59599516SKenneth E. Jansen     &              then
306*59599516SKenneth E. Jansen                  wallnode(n)=.true.
307*59599516SKenneth E. Jansen               endif
308*59599516SKenneth E. Jansen            enddo
309*59599516SKenneth E. Jansen         endif
310*59599516SKenneth E. Jansenc
311*59599516SKenneth E. Jansen         savar=zero
312*59599516SKenneth E. Jansen         do n = 1, nshl
313*59599516SKenneth E. Jansen            if( wallnode(n) ) then
314*59599516SKenneth E. Jansenc if wallmask was set, we're using effective-viscosity wall-model and
315*59599516SKenneth E. Jansenc this node is on a wall.  Eddy viscosity has been stored at the wall
316*59599516SKenneth E. Jansenc nodes in place of the S-A variable, so we must convert it
317*59599516SKenneth E. Jansen               savarw = ev2sa(yl(e,n,6),datmat(1,2,1),saCv1)
318*59599516SKenneth E. Jansen               savar  = savar + shape(e,n) * savarw
319*59599516SKenneth E. Jansen            else
320*59599516SKenneth E. Jansenc if wallmask wasn't set, then one of the following is the case:
321*59599516SKenneth E. Jansenc   using effective-viscosity, but this isn't a wall node
322*59599516SKenneth E. Jansenc   using slip-velocity
323*59599516SKenneth E. Jansenc   using no wall model; wall is resolved
324*59599516SKenneth E. Jansenc in all these cases, the S-A variable is calculated normally
325*59599516SKenneth E. Jansen               savar  = savar + shape(e,n) * yl(e,n,6)
326*59599516SKenneth E. Jansen            endif
327*59599516SKenneth E. Jansen         enddo
328*59599516SKenneth E. Jansen         rmu(e)=datmat(1,2,1)
329*59599516SKenneth E. Jansen         rmu(e) = (rmu(e) + abs(savar)) * saSigmaInv
330*59599516SKenneth E. Jansen      enddo                     ! end loop over elts
331*59599516SKenneth E. Jansen      return
332*59599516SKenneth E. Jansen      end subroutine AddSAVar
333*59599516SKenneth E. Jansen
334*59599516SKenneth E. Jansen
335*59599516SKenneth E. Jansen
336*59599516SKenneth E. Jansen      subroutine AddEddyViscKE(yl, dwl, shape, rho, sigmaInv, rmu)
337*59599516SKenneth E. Jansen      use turbKE ! access to KE model constants
338*59599516SKenneth E. Jansen      include "common.h"
339*59599516SKenneth E. Jansenc     INPUTS
340*59599516SKenneth E. Jansen      double precision, intent(in), dimension(npro,nshl,ndof) ::
341*59599516SKenneth E. Jansen     &     yl
342*59599516SKenneth E. Jansen      double precision, intent(in), dimension(npro,nshl) ::
343*59599516SKenneth E. Jansen     &     shape, dwl
344*59599516SKenneth E. Jansen      double precision, intent(in), dimension(npro) ::
345*59599516SKenneth E. Jansen     &     rho
346*59599516SKenneth E. Jansen      double precision sigmaInv
347*59599516SKenneth E. Jansenc     INPUT-OUTPUTS
348*59599516SKenneth E. Jansen      double precision, intent(inout), dimension(npro) ::
349*59599516SKenneth E. Jansen     &     rmu
350*59599516SKenneth E. Jansenc     LOCALS
351*59599516SKenneth E. Jansen      double precision eviscKE, kay, epsilon, dw, CmuKE
352*59599516SKenneth E. Jansen      double precision epsInv, Rey, Ret, RetInv, tmp1, fmuKE
353*59599516SKenneth E. Jansen      integer e,n
354*59599516SKenneth E. Jansenc
355*59599516SKenneth E. Jansen      do e = 1, npro
356*59599516SKenneth E. Jansen         kay = 0.0
357*59599516SKenneth E. Jansen         epsilon = 0.0
358*59599516SKenneth E. Jansen         dw = 0.0
359*59599516SKenneth E. Jansen         do n = 1, nshl
360*59599516SKenneth E. Jansen            kay = kay + shape(e,n)*yl(e,n,6)
361*59599516SKenneth E. Jansen            epsilon = epsilon + shape(e,n)*yl(e,n,7)
362*59599516SKenneth E. Jansen            dw = dw + shape(e,n)*dwl(e,n)
363*59599516SKenneth E. Jansen         enddo
364*59599516SKenneth E. Jansen         kay = abs(kay)
365*59599516SKenneth E. Jansen         if(kay.lt.1.0e-32) kay=0.0
366*59599516SKenneth E. Jansen         epsInv	    = 0
367*59599516SKenneth E. Jansen         if ( abs(epsilon) .gt.1.e-32) then
368*59599516SKenneth E. Jansen            epsInv        = 1. / abs(epsilon)
369*59599516SKenneth E. Jansen         endif
370*59599516SKenneth E. Jansen
371*59599516SKenneth E. Jansen         Rey                 = sqrt(kay) *    dw * rho(e) / rmu(e)
372*59599516SKenneth E. Jansen         Ret                 = kay*kay   * epsInv * rho(e) / rmu(e)
373*59599516SKenneth E. Jansen         RetInv              = 0
374*59599516SKenneth E. Jansen         if(Ret.lt.1.d100.AND.Ret.gt.zero) RetInv=1./Ret
375*59599516SKenneth E. Jansen         tmp1     = exp(-0.0165*Rey)
376*59599516SKenneth E. Jansen         fmuKE    = (1. -tmp1) ** 2 * (1.+20.5*RetInv) ! fmu of Lam-Bremhorst
377*59599516SKenneth E. Jansen
378*59599516SKenneth E. Jansen         eviscKE=rho(e)*ke_C_mu*fmuKE*kay*kay*epsInv
379*59599516SKenneth E. Jansen
380*59599516SKenneth E. Jansen         rmu(e) = rmu(e) + eviscKE*sigmaInv
381*59599516SKenneth E. Jansen      enddo
382*59599516SKenneth E. Jansen      return
383*59599516SKenneth E. Jansen      end subroutine AddEddyViscKE
384*59599516SKenneth E. Jansen
385*59599516SKenneth E. Jansen
386