diff --git a/Allmake b/Allmake
index 82e36ce..8a437cf 100755
--- a/Allmake
+++ b/Allmake
@@ -15,8 +15,11 @@
# Make 'cappuccino' CFD solver:
make execut=bin/cappuccino makefile_dir=src/cappuccino LDFLAGS=-O2\ -Wall LDLIBS=-llapack
#
+# Make Field Operations test:
+make execut=test/testFieldOperations/testFieldOperations makefile_dir=test/testFieldOperations LDFLAGS=-O2\ -Wall LDLIBS=-llapack
+#
# Make Poisson equation solver:
-make execut=bin/poisson makefile_dir=applications/Poisson LDFLAGS=-O2\ -Wall LDLIBS=-llapack
+#make execut=bin/poisson makefile_dir=applications/Poisson LDFLAGS=-O2\ -Wall LDLIBS=-llapack
#
# Make Steady Heat Equation solver:
-make execut=bin/steadyHeatEq makefile_dir=applications/steadyHeatEq LDFLAGS=-O2\ -Wall LDLIBS=-llapack
\ No newline at end of file
+#make execut=bin/steadyHeatEq makefile_dir=applications/steadyHeatEq LDFLAGS=-O2\ -Wall LDLIBS=-llapack
diff --git a/src-par/CourantNo.h b/src-par/CourantNo.f90
similarity index 68%
rename from src-par/CourantNo.h
rename to src-par/CourantNo.f90
index 0651570..b3a9c6c 100644
--- a/src-par/CourantNo.h
+++ b/src-par/CourantNo.f90
@@ -1,15 +1,27 @@
+subroutine CourantNo
!
-! Calculate and output the mean and maximum Courant Numbers.
+! Purpose:
+! Calculate and output the mean and maximum Courant Numbers.
!
+ use types
+ use parameters, only: CoNum,meanCoNum, CoNumFixValue, CoNumFix, timestep, ltransient, itime, time, myid
+ use geometry, only: numCells, numInnerFaces, owner, neighbour, numBoundaries, bctype, nfaces, startFace, Vol
+ use sparse_matrix, only: res
+ use variables, only: flmass
- if (ltransient) then
- CoNum = 0.0_dp
- meanCoNum = 0.0_dp
+ implicit none
- res = 0.0_dp
+ integer :: i, ijp, ijn, inp, ib, iface
+ real(dp):: suma,dt
+
+if (ltransient) then
+ CoNum = 0.0_dp
+ meanCoNum = 0.0_dp
+
+ res = 0.0_dp
!
- ! Suface sum of magnitude (i.e. absolute value) of mass flux phi, over inner faces only (which includes o- c- faces)
+ ! Suface sum of magnitude (i.e. absolute value) of mass flux phi, over inner faces only
!
! Inner faces
@@ -20,12 +32,6 @@
res(ijn) = res(ijn)+abs(flmass(i))
enddo
- ! Faces on processor boundaries
- !do i=1,npro
- ! ijp = owner( iProcFacesStart + i )
- ! res(ijp) = res(ijp)+abs(fmpro(i))
- !end do
-
! Boundary faces
do ib=1,numBoundaries
@@ -55,6 +61,7 @@
enddo
+
! Accumulate by looping trough cells
suma = 0.0_dp
@@ -75,16 +82,13 @@
call global_sum(suma)
CoNum = 0.5*CoNum*timestep
+ meanCoNum = 0.5*meanCoNum/suma*timestep
! Find global maximum Courant number in the whole field.
call global_max(CoNum)
-
- ! Now use it to calculate mean Courant number
- meanCoNum = 0.5*meanCoNum/suma*timestep
-
!// If we keep the value of Courant Number fixed
- if( CoNumFix .and. itime.ne.itimes ) then
+ if( CoNumFix ) then
dt = timestep
timestep = CoNumFixValue/CoNum * timestep
@@ -94,14 +98,15 @@
time = time + timestep
-if(myid .eq. 0) then
- write(6,*)
- write(6,'(a,i0,a,es10.3,a,es10.3)') " Time step no. : ",ITIME," dt : ",timestep," Time = ",time
- write(6,*)
+ if(myid .eq. 0) then
+ write(6,'(a)') ' '
+ write(6,'(a,i0,2(a,es10.3))') " Time step no. : ",itime," dt : ",timestep," Time = ",time
+ write(6,'(a)') ' '
+ write(6,'(2(a,es10.3))') " Courant Number mean: ", meanCoNum," max: ", CoNum
+ write(6,'(a)') ' '
+ endif
- write(6,'(2(a,es10.3))') " Courant Number mean: ", meanCoNum," max: ", CoNum
endif
+end subroutine
-endif
-!// ************************************************************************* //
diff --git a/src-par/Makefile b/src-par/Makefile
index c394a41..5f6e313 100644
--- a/src-par/Makefile
+++ b/src-par/Makefile
@@ -40,7 +40,8 @@ LINEAR_SOLVER_FILES=\
iccg.f90 \
bicgstab.f90 \
dpcg.f90 \
- jacobi.f90
+ jacobi.f90 \
+ mgmres.f90
TURBULENCE_FILES=\
temperature.f90 \
@@ -61,23 +62,28 @@ CAFFA_FILES=\
bpres.f90 \
fieldManipulation.f90 \
faceflux_velocity.f90 \
- facefluxmass.f90 \
+ faceflux_mass.f90 \
calcheatflux.f90 \
- calcp-multiple_correction_SIMPLE.f90 \
+ calcp_simple.f90 \
+ calcp_piso.f90\
calcstress.f90 \
calc_strain_and_vorticity.f90 \
calcuvw.f90 \
calc_statistics.f90 \
+ CourantNo.f90 \
updateVelocityAtBoundary.f90 \
correct_turbulence.f90 \
correct_turbulence_inlet.f90 \
+ continuityErrors.f90\
+ constant_mass_flow_forcing.f90 \
+ recirculate_flow.f90 \
fvm_laplacian.f90 \
init.f90 \
- PISO_multiple_correction.f90 \
readfiles.f90 \
read_input.f90 \
random_seed.f90 \
time_shift.f90 \
+ vortexIdentification.f90\
writefiles.f90 \
write_restart_files.f90 \
writehistory.f90 \
diff --git a/src-par/adjustMassFlow.f90 b/src-par/adjustMassFlow.f90
index 19efd79..4d18959 100644
--- a/src-par/adjustMassFlow.f90
+++ b/src-par/adjustMassFlow.f90
@@ -52,6 +52,7 @@ subroutine adjustMassFlow
enddo
+ call global_sum(flowo)
! Correct mass flux to satisfy global mass conservation & add to source
fac = flomas/(flowo+small)
diff --git a/src-par/allocate.f90 b/src-par/allocate.f90
index e53d294..0984fa9 100644
--- a/src-par/allocate.f90
+++ b/src-par/allocate.f90
@@ -86,15 +86,12 @@ subroutine allocate_arrays
allocate( p( numTotal ), stat=ierr)
if(ierr /= 0)write(*,*)"allocation error: p"
+ allocate(pp(numTotal),stat=ierr)
+ if(ierr /= 0)write(*,*)"allocation error: pp"
+
allocate( dPdxi( 3,numTotal ), stat=ierr)
if(ierr /= 0)write(*,*)"allocation error: dPdxi"
- if ( simple ) then
-
- allocate(pp(numTotal),stat=ierr)
- if(ierr /= 0)write(*,*)"allocation error: pp"
-
- endif
if ( piso ) then
@@ -193,6 +190,11 @@ subroutine allocate_arrays
allocate( dCondxi( 3,numTotal ), stat=ierr)
if(ierr /= 0)write(*,*)"allocation error: dCondxi"
+ if (ltransient) then
+ allocate( con_aver( numTotal ), stat=ierr)
+ if(ierr /= 0)write(*,*)"allocation error: tt_aver"
+ endif
+
endif
! Temperature variance and dissipation of temperature variance
@@ -276,6 +278,7 @@ subroutine allocate_arrays
endif
+ ! Wall things
allocate( visw(nwal), stat=ierr)
if(ierr /= 0)write(*,*)"allocation error: visw"
@@ -285,6 +288,11 @@ subroutine allocate_arrays
allocate( tau(nwal), stat=ierr)
if(ierr /= 0)write(*,*)"allocation error: tau"
+ if (ltransient) then
+ allocate( wss_aver(nwal), stat=ierr)
+ if(ierr /= 0)write(*,*)"allocation error: wss_aver"
+ endif
+
! Turbulence production
allocate( gen( numCells ), stat=ierr)
if(ierr /= 0)write(*,*)"allocation error: gen"
diff --git a/src-par/bcin.f90 b/src-par/bcin.f90
index 3549a06..3d13c08 100644
--- a/src-par/bcin.f90
+++ b/src-par/bcin.f90
@@ -4,22 +4,23 @@ subroutine bcin
use parameters
use geometry
use variables
+ use mpi
implicit none
integer :: i,ib,ini,ino,iface
! integer :: input_unit
- integer :: totalNumInlets
+ ! integer :: totalNumInlets
real(dp) :: uav,outare
- real(dp) :: flowen, flowte, flowed
+ ! real(dp) :: flowen, flowte, flowed
real(dp) :: are
flomas = 0.0_dp
- flomom = 0.0_dp
- flowen = 0.0_dp
- flowte = 0.0_dp
- flowed = 0.0_dp
+ ! flomom = 0.0_dp
+ ! flowen = 0.0_dp
+ ! flowte = 0.0_dp
+ ! flowed = 0.0_dp
! In the case we want to read recirculated profiles
@@ -55,10 +56,10 @@ subroutine bcin
! is faced inwards. That means their scalar product will be negative,
! so minus signs here is to turn net mass influx - flomas, into positive value.
flomas = flomas - flmass(iface)
- flomom = flomom + abs(flmass(iface))*sqrt(u(ini)**2+v(ini)**2+w(ini)**2)
+ ! flomom = flomom + abs(flmass(iface))*sqrt(u(ini)**2+v(ini)**2+w(ini)**2)
! if(lcal(ien)) flowen = flowen + abs(flmass(iface)*t(ini))
- flowte = flowte + abs(flmass(iface)*te(ini))
- flowed = flowed + abs(flmass(iface)*ed(ini))
+ ! flowte = flowte + abs(flmass(iface)*te(ini))
+ ! flowed = flowed + abs(flmass(iface)*ed(ini))
end do
@@ -67,6 +68,9 @@ subroutine bcin
enddo
+ ! Correct turbulence at inlet for appropriate turbulence model
+ if(lturb) call correct_turbulence_inlet()
+
endif
! close(input_unit)
@@ -89,11 +93,10 @@ subroutine bcin
! Global sum - MPI communication
call global_sum( flomas )
- call global_sum( flomom )
- if(lcal(ien)) call global_sum( flowen )
- call global_sum( flowte )
- call global_sum( flowed )
-
+ ! call global_sum( flomom )
+ ! if(lcal(ien)) call global_sum( flowen )
+ ! call global_sum( flowte )
+ ! call global_sum( flowed )
call global_sum( outare )
! Average velocity at outlet boundary
@@ -104,7 +107,10 @@ subroutine bcin
write ( *, '(a)' ) ' Inlet boundary condition information:'
write ( *, '(a)' ) ' '
write ( *, '(a,e12.6)' ) ' Mass inflow: ', flomas
- write ( *, '(a,e12.6)' ) ' Momentum inflow: ', flomom
+ ! write ( *, '(a,e12.6)' ) ' Momentum inflow: ', flomom
+ ! write ( *, '(a,e12.6)' ) ' Temperature inflow: ', flowen
+ ! write ( *, '(a,e12.6)' ) ' TKE inflow: ', flowte
+ ! write ( *, '(a,e12.6)' ) ' Dissipation inflow: ', flowed
endif
@@ -138,22 +144,4 @@ subroutine bcin
endif
- totalNumInlets = ninl
- call global_isum( totalNumInlets )
-
-
- if ( totalNumInlets .eq. 0 ) then
- ! No inflow into the domain: eg. natural convection case, etc.
-
- flomas = 1.0_dp
- flomom = 1.0_dp
- flowen = 1.0_dp
- flowte = 1.0_dp
- flowed = 1.0_dp
-
- endif
-
- ! Correct turbulence at inlet for appropriate turbulence model
- if(lturb) call correct_turbulence_inlet()
-
end subroutine
\ No newline at end of file
diff --git a/src-par/bicgstab.f90 b/src-par/bicgstab.f90
index a7c9eda..738644a 100644
--- a/src-par/bicgstab.f90
+++ b/src-par/bicgstab.f90
@@ -162,7 +162,7 @@ subroutine bicgstab(fi,ifi)
zk(i) = zk(i)*d(i)
enddo
- call exchange( zk )
+
!
! Matvec 1: Uk = A*pk
@@ -175,25 +175,27 @@ subroutine bicgstab(fi,ifi)
enddo
- ! Processor boundaries
- ipro = 0
- do ib=1,numBoundaries
+ ! ! Processor boundaries
+ ! ipro = 0
+ ! call exchange( zk )
- if ( bctype(ib) == 'process' ) then
+ ! do ib=1,numBoundaries
- do i=1,nfaces(ib)
- iface = startFace(ib) + i
- k = owner(iface)
- ijn = iBndValueStart(ib) + i
- ipro = ipro + 1
+ ! if ( bctype(ib) == 'process' ) then
- uk( k ) = uk( k ) + apr( ipro ) * zk( ijn )
+ ! do i=1,nfaces(ib)
+ ! iface = startFace(ib) + i
+ ! k = owner(iface)
+ ! ijn = iBndValueStart(ib) + i
+ ! ipro = ipro + 1
- enddo
+ ! uk( k ) = uk( k ) + apr( ipro ) * zk( ijn )
- endif
+ ! enddo
- enddo
+ ! endif
+
+ ! enddo
!
! Calculate scalar product uk*reso, and gamma
@@ -239,8 +241,6 @@ subroutine bicgstab(fi,ifi)
zk(i) = zk(i)*d(i)
enddo
- call exchange( zk )
-
!
! Matvec 2: v = A*y (vk = A*zk); vk = csrMatVec(a,zk)
!
@@ -251,25 +251,27 @@ subroutine bicgstab(fi,ifi)
enddo
enddo
- ! Processor boundaries
- ipro = 0
- do ib=1,numBoundaries
+ ! ! Processor boundaries
+ ! ipro = 0
+ ! call exchange( zk )
+
+ ! do ib=1,numBoundaries
- if ( bctype(ib) == 'process' ) then
+ ! if ( bctype(ib) == 'process' ) then
- do i=1,nfaces(ib)
- iface = startFace(ib) + i
- k = owner(iface)
- ijn = iBndValueStart(ib) + i
- ipro = ipro + 1
+ ! do i=1,nfaces(ib)
+ ! iface = startFace(ib) + i
+ ! k = owner(iface)
+ ! ijn = iBndValueStart(ib) + i
+ ! ipro = ipro + 1
- vk( k ) = vk( k ) + apr( ipro ) * zk( ijn )
+ ! vk( k ) = vk( k ) + apr( ipro ) * zk( ijn )
- enddo
+ ! enddo
- endif
+ ! endif
- enddo
+ ! enddo
!
! Calculate alpha (alf)
diff --git a/src-par/calc_statistics.f90 b/src-par/calc_statistics.f90
index ae27469..732ccf9 100644
--- a/src-par/calc_statistics.f90
+++ b/src-par/calc_statistics.f90
@@ -6,7 +6,7 @@ subroutine calc_statistics
!
use types
use parameters
- use geometry, only: numCells
+ use geometry, only: numCells,nwal
use variables
use statistics
@@ -30,7 +30,9 @@ subroutine calc_statistics
u_aver(inp) = u_aver(inp) * n_1n + u(inp) * nr
v_aver(inp) = v_aver(inp) * n_1n + v(inp) * nr
w_aver(inp) = w_aver(inp) * n_1n + w(inp) * nr
- ! con_aver(inp) = con_aver(inp) * n_1n + con(inp) * nr
+
+ if (lcal(ien)) t_aver(inp) = t_aver(inp) * n_1n + t(inp) * nr
+ if(lcal(icon)) con_aver(inp) = con_aver(inp) * n_1n + con(inp) * nr
if(lturb) then
@@ -49,15 +51,17 @@ subroutine calc_statistics
endif
! Other...
-! concon_aver(inp) = concon_aver(inp)+ &
-! (con(inp)-con_nsample)**2
-! ucon_aver(inp) = ucon_aver(inp)+ &
-! ((u(inp)-u_aver(inp))*(con(inp)-con_nsample))
-! vcon_aver(inp) = vcon_aver(inp)+ &
-! ((v(inp)-v_aver(inp))*(con(inp)-con_nsample))
-! wcon_aver(inp) = wcon_aver(inp)+ &
-! ((w(inp)-w_aver(inp))*(con(inp)-con_nsample))
+! concon_aver(inp) = concon_aver(inp)+(con(inp)-con_nsample)**2
+! ucon_aver(inp) = ucon_aver(inp)+((u(inp)-u_aver(inp))*(con(inp)-con_nsample))
+! vcon_aver(inp) = vcon_aver(inp)+((v(inp)-v_aver(inp))*(con(inp)-con_nsample))
+! wcon_aver(inp) = wcon_aver(inp)+((w(inp)-w_aver(inp))*(con(inp)-con_nsample))
end do
+ ! Time averaged Wall Shear Stress at wall bundaries
+ wss_aver(1:nwal) = wss_aver(1:nwal) * n_1n + tau(1:nwal) * nr
+
+
+
+
end subroutine
diff --git a/src-par/PISO_multiple_correction.f90 b/src-par/calcp_piso.f90
similarity index 71%
rename from src-par/PISO_multiple_correction.f90
rename to src-par/calcp_piso.f90
index e1f365f..26e4342 100644
--- a/src-par/PISO_multiple_correction.f90
+++ b/src-par/calcp_piso.f90
@@ -1,10 +1,10 @@
!***********************************************************************
!
-subroutine PISO_multiple_correction
+subroutine calcp_piso
!
!***********************************************************************
!
-! This implementation fo PISO algorithm follows descripton given in
+! This implementation of PISO algorithm follows descripton given in
! Ferziger, Peric - Computational Methods for Fluid Dynamics, 2nd ed.
! It uses PRESSURE instead of PRESSURE CORRECTION as a variable.
! The same approach is also used in OpenFOAM library.
@@ -62,7 +62,8 @@ subroutine PISO_multiple_correction
use gradients
use hcoef
use fieldmanipulation
- use faceflux_mass, only: facefluxmass_piso,fluxmc
+ use faceflux_mass
+ use mpi
implicit none
!
@@ -72,12 +73,16 @@ subroutine PISO_multiple_correction
integer :: i, k, inp, iface, if, ib, ipro, istage
integer :: ijp, ijn
real(dp) :: cap, can
- real(dp) :: pavg,fmcor
+ real(dp) :: pavg
+ real(dp) :: ppref
+ real(dp) :: fmcor
! Before entering the corection loop backup a_nb coefficient arrays:
h = a
hpr = apr
+ ! if( const_mflux ) call constant_mass_flow_forcing
+
!+++++PISO Corrector loop++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
DO icorr=1,ncorr
@@ -98,130 +103,62 @@ subroutine PISO_multiple_correction
sw = rW
! Assemble H(U) = - sum_j {a_j*U_pj}, j - runs trough neighbour indices
- do i = 1,numInnerFaces
- ijp = owner(i)
- ijn = neighbour(i)
-
- k = icell_jcell_csr_index(i)
- su(ijp) = su(ijp) - h(k)*u(ijn)
-
- k = jcell_icell_csr_index(i)
- su(ijn) = su(ijn) - h(k)*u(ijp)
- enddo
-
- ! Processor boundary
-
- ipro = 0
-
- do ib=1,numBoundaries
-
- if ( bctype(ib) == 'process' ) then
-
- do i=1,nfaces(ib)
- iface = startFace(ib) + i
- ijp = owner(iface)
- ijn = iBndValueStart(ib) + i
- ipro = ipro + 1
-
- su(ijp) = su(ijp) - hpr(ipro)*u(ijn)
-
-
- enddo
-
- endif
-
- enddo
-
+ ! Assemble H(V) = - sum_j {a_j*V_pj}, j - runs trough neighbour indices
+ ! Assemble H(W) = - sum_j {a_j*W_pj}, j - runs trough neighbour indices
- ! Assemble H(V) = - sum_j {a_j*V_pj}, j - runs trough neighbour indices
do i = 1,numInnerFaces
- ijp = owner(i)
- ijn = neighbour(i)
+ ijp = owner(i)
+ ijn = neighbour(i)
+
+ k = icell_jcell_csr_index(i)
+ su(ijp) = su(ijp) - h(k)*u(ijn)
+ sv(ijp) = sv(ijp) - h(k)*v(ijn)
+ sw(ijp) = sw(ijp) - h(k)*w(ijn)
- k = icell_jcell_csr_index(i)
- sv(ijp) = sv(ijp) - h(k)*v(ijn)
+ k = jcell_icell_csr_index(i)
+ su(ijn) = su(ijn) - h(k)*u(ijp)
+ sv(ijn) = sv(ijn) - h(k)*v(ijp)
+ sw(ijn) = sw(ijn) - h(k)*w(ijp)
- k = jcell_icell_csr_index(i)
- sv(ijn) = sv(ijn) - h(k)*v(ijp)
enddo
! Processor boundary
ipro = 0
-
do ib=1,numBoundaries
-
if ( bctype(ib) == 'process' ) then
-
do i=1,nfaces(ib)
iface = startFace(ib) + i
ijp = owner(iface)
ijn = iBndValueStart(ib) + i
ipro = ipro + 1
-
- sv(ijp) = sv(ijp) - hpr(ipro)*v(ijn)
-
+ su(ijp) = su(ijp) - hpr(ipro)*u(ijn)
+ sv(ijp) = sv(ijp) - hpr(ipro)*v(ijn)
+ sw(ijp) = sw(ijp) - hpr(ipro)*w(ijn)
enddo
-
endif
-
enddo
- ! Assemble H(W) = - sum_j {a_j*W_pj}, j - runs trough neighbour indices
- do i = 1,numInnerFaces
- ijp = owner(i)
- ijn = neighbour(i)
-
- k = icell_jcell_csr_index(i)
- sw(ijp) = sw(ijp) - h(k)*w(ijn)
-
- k = jcell_icell_csr_index(i)
- sw(ijn) = sw(ijn) - h(k)*w(ijp)
- enddo
- ! Processor boundary
-
- ipro = 0
-
- do ib=1,numBoundaries
-
- if ( bctype(ib) == 'process' ) then
-
- do i=1,nfaces(ib)
- iface = startFace(ib) + i
- ijp = owner(iface)
- ijn = iBndValueStart(ib) + i
- ipro = ipro + 1
-
- sw(ijp) = sw(ijp) - hpr(ipro)*w(ijn)
-
- enddo
-
- endif
-
- enddo
-
! HbyA
u(1:numCells) = apu*su
v(1:numCells) = apv*sv
w(1:numCells) = apw*sw
+
! Tentative (!) velocity gradients used for velocity interpolation:
+ call updateVelocityAtBoundary
call grad(U,dUdxi)
call grad(V,dVdxi)
call grad(W,dWdxi)
+
!~~~~ Non orthogonal corrections loop ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- !
- ! Multiple non-orthogonal passes amount to Discretizing Laplacian which includes adding
- ! non-orthogonal contribution to RHS and forming RHS from mass fluxes formed using tentative velocity.
- !
- DO ipcorr=1,npcor
! Initialize coefficient array and source:
a = 0.0_dp
- apr = 0
+ apr = 0.0_dp
su = 0.0_dp
! > Assemble off diagonal entries of system matrix and find mass flux,
@@ -262,20 +199,23 @@ subroutine PISO_multiple_correction
end do
- !
- ! Loop over faces on processor boundary
- !
- ipro = 0
+
+ ! Contribution form process boundaries
+
+ iPro = 0
do ib=1,numBoundaries
-
+
if ( bctype(ib) == 'process' ) then
+ ! Faces on process boundary
+
do i=1,nfaces(ib)
if = startFace(ib) + i
ijp = owner(if)
- ipro = ipro + 1
+ ijn = iBndValueStart(ib) + i
+ ipro = ipro+1
call facefluxmass_piso(ijp, ijn, xf(if), yf(if), zf(if), arx(if), ary(if), arz(if), fpro(ipro), cap, can, flmass(if))
@@ -290,35 +230,117 @@ subroutine PISO_multiple_correction
! > Sources:
- su(ijp) = su(ijp) - flmass(i)
+ su(ijp) = su(ijp) - flmass(if)
enddo
endif
- end do
+ enddo ! Boundary loop
!// "adjusts the inlet and outlet fluxes to obey continuity, which is necessary for creating a well-posed
!// problem where a solution for pressure exists." - Comment in OF pisoFOAM code.
- if(.not.const_mflux) call adjustMassFlow
+ call adjustMassFlow
- !
- ! Laplacian source term modification due to non-orthogonality.
- !
- if(ipcorr.ne.npcor) then
+ ! Add contributions to source of the inlet and outlet boundaries.
+
+ ! Loop over boundaries
+ do ib=1,numBoundaries
+
+ if ( bctype(ib) == 'inlet' ) then
+
+ do i=1,nfaces(ib)
+
+ iface = startFace(ib) + i
+ ijp = owner(iface)
+
+ ! Minus sign is there to make fmi(i) positive since it enters the cell.
+ ! Check out comments in bcin.f90
+ su(ijp) = su(ijp) - flmass(iface)
+
+ end do
- ! Pressure gradient
- do istage=1,nipgrad
+ elseif ( bctype(ib) == 'outlet' ) then
- ! Pressure at boundaries.
- call bpres(p,istage)
+ do i=1,nfaces(ib)
- ! Calculate pressure gradient field.
- call grad(p,dPdxi,'gauss_corrected','no-limit')
+ iface = startFace(ib) + i
+ ijp = owner(iface)
+
+ ! fmout is positive because of same direction of velocity and surface normal vectors
+ ! but the mass flow is going out of the cell, therefore minus sign.
+ su(ijp) = su(ijp) - flmass(iface)
+
+ end do
+
+ endif
+
+ enddo
+
+ !
+ ! Multiple non-orthogonal passes amount to Discretizing Laplacian which includes adding
+ ! non-orthogonal contribution to RHS and forming RHS from mass fluxes formed using tentative velocity.
+ !
+ DO ipcorr=1,npcor
+
+ !! "If you have a pressure equations with boundaries that do not fix pressure level, you have to fix a reference pressure." H.Jasak cfd-online forum
+ !// In incompressible flow, only relative pressure matters. Unless there is a pressure BC present,
+ !// one cell's pressure has to be set to produce a unique pressure solution
+ ! pEqn.setReference(pRefCell, pRefValue);
+
+ ! Reference pressure correction - p'
+ if (myid .eq. iPrefProcess) then
+ ppref = p(pRefCell)
+ call MPI_BCAST(ppref,1,MPI_DOUBLE_PRECISION,iPrefProcess,MPI_COMM_WORLD,IERR)
+ endif
+
+ ! Reference pressure at process that owns that cell
+ if (myid .eq. iPrefProcess) then
+ a( ioffset(pRefCell):ioffset(pRefCell+1)-1 ) = 0.0_dp
+ a( diag(pRefCell) ) = 1.0_dp
+ su(pRefCell) = ppref
+ endif
- end do
+ !
+ ! Solve pressure equation system
+ !
+ call iccg(pp,ip)
+
+ ! ! We have pure Neumann problem - take out the average of the field as the additive constant
+ ! pavg = sum(pp(1:numCells)/dble(gloCells))
+ ! ! Find global average
+ ! call global_sum( pavg )
+ ! !pavg = pavg / dble(nproc)
+ ! ! Under-relaxation
+ ! p(1:numCells) = (1.0_dp-urf(ip))*p(1:numCells) + urf(ip)*(pp(1:numCells)-pavg)
+
+ ! Under-relaxation, if we use pressure reference value instead of pavg
+ p(1:numCells) = (1.0_dp-urf(ip))*p(1:numCells) + urf(ip)*( pp(1:numCells) - ppref )
+
+ ! Pressure gradient
+ do istage=1,nipgrad
+
+ ! Pressure at boundaries.
+ call bpres(p,istage)
+
+ ! Calculate pressure gradient field.
+ call grad(p,dPdxi)
+
+ end do
+
+ ! If simulation uses least-squares gradients call this to get conservative pressure correction gradients.
+ if ( lstsq_qr .or. lstsq_dm .or. lstsq_qr ) call grad(p,dPdxi,'gauss_corrected','no-limit')
+
+
+ ! Now that we have new pressure - copy it to pp also.
+ pp = p
+
+ !
+ ! Laplacian source term modification due to non-orthogonality.
+ !
+ if(ipcorr.ne.npcor) then
! Add nonorthogonal terms from laplacian discretization to RHS of pressure eqn.
do i=1,numInnerFaces
@@ -358,47 +380,10 @@ subroutine PISO_multiple_correction
end do
- endif
-
- !! "If you have a pressure equations with boundaries that do not fix pressure level, you have to fix a reference pressure." H.Jasak cfd-online forum
- !// In incompressible flow, only relative pressure matters. Unless there is a pressure BC present,
- !// one cell's pressure has to be set to produce a unique pressure solution
- ! pEqn.setReference(pRefCell, pRefValue);
- !//
-
- ! Reference pressure at process that owns that cell
- if (myid .eq. iPrefProcess) then
- a( ioffset(pRefCell):ioffset(pRefCell+1)-1 ) = 0.0_dp
- a( diag(pRefCell) ) = 1.0_dp
- ! Reference pressure
- su(pRefCell) = p(pRefCell)
- endif
-
!
- ! Solve pressure equation system
- !
- call iccg(p,ip)
-
-
- ! We have pure Neumann problem - take out the average of the field as the additive constant
- pavg = sum(p(1:numCells)/dble(numCells))
-
- ! Find global average
- call global_sum( pavg )
- pavg = pavg / dble(nproc)
-
- ! Substract global average from field values
- p(1:numCells) = p(1:numCells) - pavg
-
-
-
-
-
- !// On the last non-orthogonality correction, correct the flux using the most up-to-date pressure
- !// The .flux method includes contributions from all implicit terms of the pEqn (the Laplacian)
- ! phi -= pEqn.flux();
- ! We have hit the last iteration of nonorthogonality correction:
- if(ipcorr.eq.npcor) then
+ ! We have hit the last iteration of nonorthogonality correction:
+ !
+ else ! or if(ipcorr.eq.npcor) then
!
! Correct mass fluxes at inner cv-faces only (only inner flux)
@@ -446,52 +431,34 @@ subroutine PISO_multiple_correction
! Additional mass flux correction due to non-orthogonality.
!
- ! Pressure gradient
- do istage=1,nipgrad
-
- ! Pressure at boundaries.
- call bpres(p,istage)
-
- ! Calculate pressure gradient field.
- call grad(p,dPdxi,'gauss_corrected','nolimit')
-
- end do
-
- do i=1,numInnerFaces
-
- call fluxmc(ijp, ijn, xf(i), yf(i), zf(i), arx(i), ary(i), arz(i), facint(i), fmcor)
-
- flmass(i) = flmass(i)-fmcor
-
- enddo
-
- !
- ! Loop over faces on processor boundary
- !
- ipro = 0
-
- do ib=1,numBoundaries
-
- if ( bctype(ib) == 'process' ) then
-
- do i=1,nfaces(ib)
-
- iface = startFace(ib) + i
- ipro = ipro+1
-
- call fluxmc(ijp, ijn, xf(iface), yf(iface), zf(iface), arx(iface), ary(iface), arz(iface), fpro(ipro), fmcor)
-
- flmass(iface) = flmass(iface)-fmcor
-
- enddo
-
- endif
-
- end do
-
+ if (npcor > 1) then ! i.e. only if we have set multiple nonorthogonality corrections
+ !
+ ! Inner faces
+ !
+ do i=1,numInnerFaces
+ call fluxmc(ijp, ijn, xf(i), yf(i), zf(i), arx(i), ary(i), arz(i), facint(i), fmcor)
+ flmass(i) = flmass(i)-fmcor
+ enddo
+
+ !
+ ! Loop over faces on processor boundary
+ !
+ ipro = 0
+ do ib=1,numBoundaries
+ if ( bctype(ib) == 'process' ) then
+ do i=1,nfaces(ib)
+ iface = startFace(ib) + i
+ ipro = ipro+1
+ call fluxmc(ijp, ijn, xf(iface), yf(iface), zf(iface), arx(iface), ary(iface), arz(iface), fpro(ipro), fmcor)
+ flmass(iface) = flmass(iface)-fmcor
+ enddo
+ endif
+ end do
+
+ endif
! Write continuity error report:
- include 'continuityErrors.h'
+ call continuityErrors
endif
@@ -501,8 +468,6 @@ subroutine PISO_multiple_correction
!// Add pressure gradient to interior velocity and BC's. Note that this pressure is not just a small
!// correction to a previous pressure, but is the entire pressure field. Contrast this to the use of p'
!// in Ferziger & Peric, Eqn. 7.37.
- !// NOTE: This is whole pressure, opposite to what is done in SIMPLE: p(inp)+urf(ip)*(pp(inp)-ppref) !
-
!
! Correct velocities
@@ -513,7 +478,7 @@ subroutine PISO_multiple_correction
w(inp) = w(inp) - apw(inp)*dPdxi(3,inp)*vol(inp)
enddo
- ! call updateVelocityAtBoundary
+ call updateVelocityAtBoundary
!== END: PISO Corrector loop =========================================
enddo
diff --git a/src-par/calcp-multiple_correction_SIMPLE.f90 b/src-par/calcp_simple.f90
similarity index 92%
rename from src-par/calcp-multiple_correction_SIMPLE.f90
rename to src-par/calcp_simple.f90
index 7b97c1a..ba5982b 100644
--- a/src-par/calcp-multiple_correction_SIMPLE.f90
+++ b/src-par/calcp_simple.f90
@@ -1,6 +1,6 @@
!***********************************************************************
!
-subroutine calcp
+subroutine calcp_simple
!***********************************************************************
!
! Assemble and solve pressure correction equation in SIMPLE algorithm
@@ -17,7 +17,7 @@ subroutine calcp
use gradients
use fieldManipulation
use faceflux_mass
- ! use mpi
+ use mpi
implicit none
@@ -27,13 +27,15 @@ subroutine calcp
integer :: i, k, inp, iface, if, ijp, ijn, ib, ipro, istage
real(dp) :: sum, suma, ppref, cap, can, fmcor
- real(dp) :: psum
+ ! real(dp) :: psum
a = 0.0_dp
apr = 0.0_dp
su = 0.0_dp
+ ! if( const_mflux ) call constant_mass_flow_forcing
+
! Tentative (!) velocity gradients used for velocity interpolation:
call grad(U,dUdxi)
call grad(V,dVdxi)
@@ -171,6 +173,7 @@ subroutine calcp
call iccg(pp,ip)
! call dpcg(pp,ip)
! call jacobi(pp,ip)
+ ! call pmgmres_ilu ( numCells, nnz, ioffset, ja, a, diag, pp, ip, su, nsw(ip), 4, 1e-3, sor(ip) )
! SECOND STEP *** CORRECTOR STAGE
@@ -184,18 +187,18 @@ subroutine calcp
end do
- ! If simulation uses least-squares gradinets call this to get conservative pressure correction gradients.
+ ! If simulation uses least-squares gradients call this to get conservative pressure correction gradients.
if ( lstsq_qr .or. lstsq_dm .or. lstsq_qr ) call grad(pp,dPdxi,'gauss_corrected','no-limit')
- ! ! Reference pressure correction - p'
- ! if (myid .eq. iPrefProcess) then
- ! ppref = pp(pRefCell)
- ! call MPI_BCAST(ppref,1,MPI_DOUBLE_PRECISION,iPrefProcess,MPI_COMM_WORLD,IERR)
- ! endif
+ ! Reference pressure correction - p'
+ if (myid .eq. iPrefProcess) then
+ ppref = pp(pRefCell)
+ call MPI_BCAST(ppref,1,MPI_DOUBLE_PRECISION,iPrefProcess,MPI_COMM_WORLD,IERR)
+ endif
- psum = sum( pp(1:numCells) )
- call global_sum( psum )
- ppref = psum / gloCells
+ ! psum = sum( pp(1:numCells) )
+ ! call global_sum( psum )
+ ! ppref = psum / dble(gloCells)
!
! Correct mass fluxes at inner cv-faces only (only inner flux)
@@ -318,6 +321,6 @@ subroutine calcp
call exchange( p )
! Write continuity error report:
- include 'continuityErrors.h'
+ call continuityErrors
end subroutine
diff --git a/src-par/calcuvw.f90 b/src-par/calcuvw.f90
index 3a3c567..9acf76a 100644
--- a/src-par/calcuvw.f90
+++ b/src-par/calcuvw.f90
@@ -62,11 +62,11 @@ subroutine calcuvw
! If you want to use midpoint timestepping method to improve piso to 2nd order,
! extrapolate using Adams-Abshfort method extrapolation to time interval midpoint, t^n+1/2
- flmass = 1.5_dp*flmasso - 0.5_dp*flmassoo
- p = 1.5_dp*po - 0.5_dp*poo
- u = 1.5_dp*uo - 0.5_dp*uoo
- v = 1.5_dp*vo - 0.5_dp*voo
- w = 1.5_dp*wo - 0.5_dp*woo
+ ! flmass = 1.5_dp*flmasso - 0.5_dp*flmassoo
+ ! p = 1.5_dp*po - 0.5_dp*poo
+ ! u = 1.5_dp*uo - 0.5_dp*uoo
+ ! v = 1.5_dp*vo - 0.5_dp*voo
+ ! w = 1.5_dp*wo - 0.5_dp*woo
! For consistent 2nd order PISO algorithm.
! Estimate mass flux, velocity components and pressure for the current timestep
@@ -92,6 +92,7 @@ subroutine calcuvw
! Velocity gradients:
+ call updateVelocityAtBoundary
call grad(U,dUdxi)
call grad(V,dVdxi)
call grad(W,dWdxi)
@@ -101,7 +102,6 @@ subroutine calcuvw
-
! CALCULATE SOURCE TERMS INTEGRATED OVER VOLUME
do inp=1,numCells
@@ -131,7 +131,7 @@ subroutine calcuvw
!=======================================================================
if ( ltransient) then
- if( bdf ) then
+ if( bdf .or. cn ) then
!
! Backward differentiation formula of 1st order.
!
@@ -597,7 +597,6 @@ subroutine calcuvw
enddo
! Solve fvm equations
- ! call jacobi(u,iu)
call bicgstab(u,iu)
!
@@ -687,7 +686,6 @@ subroutine calcuvw
enddo
! Solve fvm equations
- ! call jacobi(v,iv)
call bicgstab(v,iv)
!
@@ -777,7 +775,6 @@ subroutine calcuvw
enddo
! Solve fvm equations
- ! call jacobi(w,iw)
call bicgstab(w,iw)
! MPI exchange:
diff --git a/src-par/concentration.f90 b/src-par/concentration.f90
index ea71c62..fc55287 100644
--- a/src-par/concentration.f90
+++ b/src-par/concentration.f90
@@ -85,7 +85,7 @@ subroutine calcsc(Fi,dFidxi,ifi)
!
! > UNSTEADY TERM
!
- if( bdf ) then
+ if( bdf .or. cn ) then
apotime = den(inp)*vol(inp)/timestep
su(inp) = su(inp) + apotime*cono(inp)
sp(inp) = sp(inp) + apotime
diff --git a/src-par/constant_mass_flow_forcing.f90 b/src-par/constant_mass_flow_forcing.f90
index 7312759..3a5c17b 100644
--- a/src-par/constant_mass_flow_forcing.f90
+++ b/src-par/constant_mass_flow_forcing.f90
@@ -1,22 +1,35 @@
- !# Correct driving force for a constant mass flow rate.......................
+subroutine constant_mass_flow_forcing
+!
+! Purpose:
+! Correct driving force for a constant mass flow rate.
+!
+ use types
+ use parameters, only: magUbar, gradPcmf, myid
+ use variables, only: U
+ use sparse_matrix, only: apu
+ use geometry, only: numCells,Vol
+ use fieldManipulation, only: volumeWeightedAverage
- ! # Extract the velocity in the flow direction
- ! magUbarStar = ( flowDirection & U ).weightedAverage( mesh.V() )
- magUbarStar = volumeWeightedAverage(U)
+ implicit none
- ! # Calculate the pressure gradient increment needed to
- ! # adjust the average flow-rate to the correct value
- ! gragPplus = ( magUbar - magUbarStar ) / rUA.weightedAverage( mesh.V() )
- rUAw = volumeWeightedAverage(APU)
- gragPplus = ( magUbar - magUbarStar ) / rUAw
+ ! integer :: inp
+ real(dp):: magUbarStar, rUAw, gragPplus
- ! # Correction
- ! U.ext_assign( U + flowDirection * rUA * gragPplus )
- flowDirection = 1.0_dp
- U = U + flowDirection * APU * gragPplus
+ ! Extract the velocity in the flow direction
+ magUbarStar = volumeWeightedAverage(U)
- ! # Pressure gradient force that will drive the flow - we use it in calcuvw.
- gradPcmf = gradPcmf + gragPplus
+ ! Calculate the pressure gradient increment needed to
+ ! adjust the average flow-rate to the correct value
+ ! gragPplus = ( magUbar - magUbarStar ) / rUA.weightedAverage( mesh.V() )
+ rUAw = volumeWeightedAverage(APU)
+ gragPplus = ( magUbar - magUbarStar ) / rUAw
- if( myid .eq. 0 ) write(6,'(2(a,es13.6))') "Uncorrected Ubar = ",magUbarStar," pressure gradient = ",gradPcmf
- !............................................................................
\ No newline at end of file
+ ! Correction of velocity to satisfy mass flow
+ U(1:numCells) = U(1:numCells) + APU(1:numCells) * gragPplus * Vol(1:numCells)
+
+ ! Pressure gradient force that will drive the flow - we use it in calcuvw.
+ gradPcmf = gradPcmf + gragPplus
+
+ if (myid == 0) write(*,'(2(a,es13.6))') " Uncorrected Ubar = ",magUbarStar," pressure gradient = ",gradPcmf
+
+end subroutine
\ No newline at end of file
diff --git a/src-par/continuityErrors.f90 b/src-par/continuityErrors.f90
new file mode 100644
index 0000000..dc34f31
--- /dev/null
+++ b/src-par/continuityErrors.f90
@@ -0,0 +1,87 @@
+subroutine continuityErrors
+!
+! Purpose:
+! Calculates and prints the continuity errors.
+!
+ use types
+ use parameters, only: sumLocalContErr, globalContErr, cumulativeContErr,myid
+ use geometry, only: numInnerFaces, owner, neighbour, numBoundaries, bctype, nfaces, startFace
+ use sparse_matrix, only: res,apu
+ use variables, only: flmass
+ use fieldManipulation, only: volumeWeightedAverage
+
+ implicit none
+
+ integer :: i, ijp, ijn, ib, iface
+
+ ! Initialize array with zero value.
+ res = 0.0_dp
+
+ ! Inner faces
+ do i=1,numInnerFaces
+ ijp = owner(i)
+ ijn = neighbour(i)
+ res(ijp) = res(ijp)-flmass(ijp)
+ res(ijn) = res(ijn)+flmass(ijp)
+ enddo
+
+
+ ! Boundary faces
+ do ib=1,numBoundaries
+
+ if ( bctype(ib) == 'inlet' ) then
+
+ ! Inlet boundaries (mass fluxes prescribed in routine 'bcin')
+ do i=1,nfaces(ib)
+
+ iface = startFace(ib) + i
+ ijp = owner(iface)
+ res(ijp)=res(ijp)-flmass(iface)
+
+ enddo
+
+ elseif ( bctype(ib) == 'outlet' ) then
+
+ do i=1,nfaces(ib)
+
+ iface = startFace(ib) + i
+ ijp = owner(iface)
+ res(ijp)=res(ijp)-flmass(iface)
+
+ enddo
+
+ elseif ( bctype(ib) == 'process' ) then
+
+ do i=1,nfaces(ib)
+
+ iface = startFace(ib) + i
+ ijp = owner(iface)
+ res(ijp)=res(ijp)-flmass(iface)
+
+ enddo
+
+ endif
+
+ enddo
+
+
+ sumLocalContErr = volumeWeightedAverage( abs(res*apu) )
+ ! globalContErr = volumeWeightedAverage( res )
+
+ ! sumLocalContErr = sum( abs( res ) )
+ globalContErr = sum( res )
+
+ call global_sum( sumLocalContErr )
+
+ call global_sum( globalContErr )
+
+ cumulativeContErr = cumulativeContErr + globalContErr
+
+ res = 0.0_dp
+
+ if ( myid .eq. 0 ) write(6,'(3(a,es10.3))') " time step continuity errors : avg local = ", sumLocalContErr, &
+ & ", global = ", globalContErr, &
+ & ", cumulative = ", cumulativeContErr
+
+end subroutine
+
diff --git a/src-par/continuityErrors.h b/src-par/continuityErrors.h
index 89246b0..7ae880d 100644
--- a/src-par/continuityErrors.h
+++ b/src-par/continuityErrors.h
@@ -53,9 +53,6 @@
enddo
- ! The way it is done in OpenFOAM:
- ! sumLocalContErr = timestep*volumeWeightedAverage( abs(res) )
- ! globalContErr = timestep*volumeWeightedAverage( res )
sumLocalContErr = sum( abs( res ) )
@@ -67,7 +64,7 @@
cumulativeContErr = cumulativeContErr + globalContErr
-
+ write(*,*) 'After comm:',sumLocalContErr,globalContErr
if ( myid .eq. 0 ) write(6,'(3(a,es10.3))') " time step continuity errors : sum local = ", sumLocalContErr, &
& ", global = ", globalContErr, &
& ", cumulative = ", cumulativeContErr
diff --git a/src-par/exchange.f90 b/src-par/exchange.f90
index c864182..7bb1023 100644
--- a/src-par/exchange.f90
+++ b/src-par/exchange.f90
@@ -21,54 +21,30 @@ subroutine exchange(phi)
implicit none
+ !
+ ! > Arguments
+ !
+ real(dp), intent(inout) :: phi(numTotal)
- integer :: i,ijn,ib,ipro
- integer :: iDomain,iDFriend,iStart,iEnd
+ !
+ ! > Locals
+ !
+ integer :: i,ijp,ijn,ib,ipro,iface
+ integer :: iConnection,iDFriend,iStart,iEnd
integer :: rectag,sendtag
integer :: length
integer :: status(mpi_status_size)
- real(dp), intent(inout) :: phi(numTotal)
!
! > Fill the buffers with new values
!
- ! Moze i da se pojednostavi punjenje buffera jer je sve vec podeseno
- do i=1,lenbuf
- buffer(i) = phi( bufind(i) )
- enddo
-
-! >> Exchange the values
-
- ! Idi po svim domenima sa kojima je ovaj konektovan
- do iDomain = 1,numConnections
-
- iDFriend = neighbProcNo(iDomain)
-
- sendtag = 123 + this + iDFriend ! tag for sending
- rectag = sendtag ! tag for receiving
-
- iStart = neighbProcOffset(iDomain)
- iEnd = neighbProcOffset(iDomain+1)-1
+ ! ! Moze i da se pojednostavi punjenje buffera jer je sve vec podeseno
+ ! do i=1,lenbuf
+ ! buffer(i) = phi( bufind(i) )
+ ! enddo
- length = iEnd-iStart+1
-
- call MPI_SENDRECV_REPLACE &
- (buffer(iStart), & ! buffer
- length, & ! length
- MPI_DOUBLE_PRECISION, & ! datatype
- iDFriend, & ! dest,
- sendtag, & ! sendtag,
- iDFriend, & ! source,
- rectag, & ! recvtag,
- MPI_COMM_WORLD, & ! communicator
- status, & ! status
- ierr) ! error
-
- end do
-
- ! Prebaci iz buffera u phi polje na odgovarajuce mesto
ipro = 0
do ib=1,numBoundaries
@@ -78,10 +54,11 @@ subroutine exchange(phi)
! Faces on process boundary
do i=1,nfaces(ib)
- ijn = iBndValueStart(ib) + i
+ iface = startFace(ib) + i
+ ijp = owner(iface)
ipro = ipro+1
- phi( ijn ) = buffer( ipro )
+ buffer( ipro ) = phi( ijp )
enddo
endif
@@ -89,67 +66,25 @@ subroutine exchange(phi)
enddo
-
-end subroutine exchange
-
-
-!***********************************************************************
-!
-subroutine exchange__(phi)
-!
-!***********************************************************************
-!
-! Exchanges field values between connected processes from their
-! respective buffers.
-! Executes a blocking send and receive. The same buffer is used both
-! for the send and for the receive, so that the message sent is
-! replaced by the message received.
-! !!!
-! This version of the exchange routine exchanges arrays of size (numPcells).
-! !!!
-!***********************************************************************
-!
-
- use types
- use parameters
- use geometry
- use my_mpi_module
- use mpi
-
- implicit none
-
-
+ ! syncronization before communication
+ call MPI_Barrier(MPI_COMM_WORLD,ierr)
- integer :: i
- integer :: iDomain,iDFriend,iStart,iEnd
- integer :: rectag,sendtag
- integer :: length
- integer :: status(mpi_status_size)
-
- real(dp), intent(inout) :: phi(numPCells)
-
!
- ! >> Fill the buffers with new values
+ ! > Exchange the values
!
- ! Moze i da se pojednostavi punjenje buffera jer je sve vec podeseno
- do i=1,lenbuf
- buffer( i ) = phi( bufind(i) )
- enddo
-
-
-! >> Exchange the values
-
- ! Idi po svim domenima sa kojima je ovaj konektovan
- do iDomain = 1,numConnections
+ !
+ ! > Idi po svim domenima sa kojima je ovaj konektovan.
+ !
+ do iConnection = 1,numConnections
- iDFriend = neighbProcNo(iDomain)
+ iDFriend = neighbProcNo(iConnection)
- sendtag = 123 + this + iDFriend ! tag for sending
- rectag = sendtag ! tag for receiving
+ sendtag = 123 + MYID + iDFriend ! tag for sending
+ rectag = sendtag ! tag for receiving
- iStart = neighbProcOffset(iDomain)
- iEnd = neighbProcOffset(iDomain+1)-1
+ iStart = neighbProcOffset(iConnection)
+ iEnd = neighbProcOffset(iConnection+1)-1
length = iEnd-iStart+1
@@ -167,10 +102,29 @@ subroutine exchange__(phi)
end do
- ! Prebaci iz buffera u phi polje na odgovarajuce mesto
- ! Paznja: ovde je kraci niz pa vrednosti idu odmah nakon numCells mesta u nizu
- do i=1,lenbuf
- phi( numCells + i ) = buffer(i)
+
+ !
+ ! Move data from the buffer to variable array where it belongs.
+ !
+
+ ipro = 0
+
+ do ib=1,numBoundaries
+
+ if ( bctype(ib) == 'process' ) then
+
+ ! Faces on process boundary
+ do i=1,nfaces(ib)
+
+ ijn = iBndValueStart(ib) + i
+ ipro = ipro+1
+
+ phi( ijn ) = buffer( ipro )
+
+ enddo
+ endif
+
enddo
-end subroutine exchange__
\ No newline at end of file
+end subroutine exchange
+
diff --git a/src-par/facefluxmass.f90 b/src-par/faceflux_mass.f90
similarity index 96%
rename from src-par/facefluxmass.f90
rename to src-par/faceflux_mass.f90
index a0ecc3b..f6b8905 100644
--- a/src-par/facefluxmass.f90
+++ b/src-par/faceflux_mass.f90
@@ -299,34 +299,35 @@ subroutine facefluxmass_piso(ijp, ijn, xf, yf, zf, arx, ary, arz, lambda, cap, c
! Local variables
real(dp) :: fxn, fxp
- real(dp) :: are,dpn
- real(dp) :: xpn,ypn,zpn,dene,smdpn
+ ! real(dp) :: are,dpn
+ real(dp) :: xpn,ypn,zpn,dene
real(dp) :: ui,vi,wi
-
+ real(dp) :: Kj
! > Geometry:
! Face interpolation factor
- fxn=lambda
- fxp=1.0_dp-lambda
+ fxn = lambda
+ fxp = 1.0_dp-lambda
! Distance vector between cell centers
- xpn=xc(ijn)-xc(ijp)
- ypn=yc(ijn)-yc(ijp)
- zpn=zc(ijn)-zc(ijp)
+ xpn = xc(ijn)-xc(ijp)
+ ypn = yc(ijn)-yc(ijp)
+ zpn = zc(ijn)-zc(ijp)
! Distance from P to neighbor N
- dpn=sqrt(xpn**2+ypn**2+zpn**2)
+ ! dpn = sqrt(xpn**2+ypn**2+zpn**2)
! cell face area
- are=sqrt(arx**2+ary**2+arz**2)
+ ! are = sqrt(arx**2+ary**2+arz**2)
! density at the cell face
- dene=den(ijp)*fxp+den(ijn)*fxn
+ dene = den(ijp)*fxp+den(ijn)*fxn
! COEFFICIENTS OF PRESSURE EQUATION
- smdpn = are/dpn
- cap = -dene*(fxp*vol(ijp)*apu(ijp)+fxn*vol(ijn)*apu(ijn))*are/dpn
+ Kj = vol(ijp)*apu(ijp)*fxp + vol(ijn)*apu(ijn)*fxn
+ ! cap = - dene*Kj*are/dpn
+ cap = -dene*Kj*(arx*arx+ary*ary+arz*arz)/(xpn*arx+ypn*ary+zpn*arz)
can = cap
diff --git a/src-par/faceflux_velocity.f90 b/src-par/faceflux_velocity.f90
index 6836deb..4274417 100644
--- a/src-par/faceflux_velocity.f90
+++ b/src-par/faceflux_velocity.f90
@@ -89,14 +89,14 @@ subroutine facefluxuvw(ijp, ijn, xf, yf, zf, arx, ary, arz, flomass, lambda, gam
are=sqrt(arx**2+ary**2+arz**2)
-
! > Equation coefficients:
! Cell face viscosity
game = vis(ijp)*fxp+vis(ijn)*fxn
! Difusion coefficient
- de = game*are/dpn
+ !de = game*are/dpn
+ de = game * (arx*arx+ary*ary+arz*arz)/(xpn*arx+ypn*ary+zpn*arz)
! > Equation coefficients - implicit diffusion and convection
diff --git a/src-par/fieldManipulation.f90 b/src-par/fieldManipulation.f90
index 9b0a0d2..4c4d309 100644
--- a/src-par/fieldManipulation.f90
+++ b/src-par/fieldManipulation.f90
@@ -29,25 +29,20 @@ function volumeWeightedAverage(U) result(wAvgU)
real(dp), dimension(numTotal), intent(in) :: U
!...Locals
- integer :: inp
real(dp) :: sumvol
!
!***********************************************************************
!
- sumvol = 0.0_dp
- wAvgU = 0.0_dp
- do inp=1,numCells
- wAvgU = wAvgU + (Vol(inp)*U(inp))
- sumvol = sumvol + vol(inp)
- enddo
+ wAvgU = sum( Vol(1:numCells)*U(1:numCells) )
+ sumvol = sum( Vol(1:numCells) )
call global_sum( wAvgU )
call global_sum( sumvol )
wAvgU = wAvgU / sumvol
- end function
+ end function
@@ -901,6 +896,8 @@ subroutine add_random_noise_to_field(Phi,percent)
enddo
+ if (myid == 0) write(*,'(a,i0,a)') ' **Added random noise of +/-',percent,' percent.'
+
end subroutine
diff --git a/src-par/field_initialization.f90 b/src-par/field_initialization.f90
index 1185044..5b03e7d 100644
--- a/src-par/field_initialization.f90
+++ b/src-par/field_initialization.f90
@@ -107,7 +107,7 @@ subroutine initialize_vector_field(u,v,w, dUdxi, field_name)
!*** which determines how will boundary face values be treated during the code run!
!
- do ib=1,numBoundaries - size(neighbProcNo) ! values at process boundary are not set here
+ do ib=1,numBoundaries
read(input_unit,*) name ! repeat bcname(ib)
if(myid .eq. 0) write(*,'(2x,a)') name
@@ -254,7 +254,7 @@ subroutine initialize_scalar_field(T, dTdxi, field_name)
!*** which determines how will boundary face values be treated during the code run!
!
- do ib=1,numBoundaries-size(neighbProcNo) ! values at process boundary are not set here
+ do ib=1,numBoundaries
read(input_unit,*) name ! repeat bcname(ib)
if(myid .eq. 0) write(*,'(2x,a)') name
diff --git a/src-par/geometry-old.f90 b/src-par/geometry-old.f90
new file mode 100644
index 0000000..5a5891e
--- /dev/null
+++ b/src-par/geometry-old.f90
@@ -0,0 +1,1223 @@
+!
+! Module for geometry definition on unstructured meshes.
+!
+module geometry
+
+use types
+use parameters, only: myid
+use utils, only: get_unit, file_row_count, r8vec_print_some, i4vec_print2, i4_to_s_left
+
+implicit none
+
+! NOTE:
+! In variable arrays, field variables defined at cell centres are written in positions from 1 to numCells, after that we write
+! variable values for boundary faces from numCells+1 to numTotal.
+
+! General mesh data
+integer :: numNodes ! no. of nodes in mesh
+integer :: numCells ! no. of cells in the mesh
+integer :: numPCells ! no. of cells in the mesh + buffer cells
+integer :: numFaces ! no. of INNER+BOUNDARY faces in the mesh
+integer :: numInnerFaces ! no. of INNER cells faces in the mesh
+integer :: numBoundaryFaces ! self explanatory
+integer :: numTotal ! number of volume field values + number of boundary field values numCells+numBoundaryFaces
+
+! To define boundary regions
+integer :: numBoundaries
+integer, dimension(:), allocatable :: nfaces,startFace,iBndValueStart
+character(len=15), dimension(:), allocatable :: bcname, bctype
+
+integer :: npro ! No. of boundary faces on 'process' boundary - connected to another computational domain
+integer :: ninl ! No. of inlet boundary faces
+integer :: nout ! No. of outlet boundary faces
+integer :: nsym ! No. of symmetry boundary faces
+integer :: nwal ! No. of wall boundary faces
+
+
+integer, parameter :: nomax = 30 ! Max no. of nodes in face - determines size of some arrays, just change this if necessary.
+real(dp), parameter :: tiny = 1e-30
+
+
+! Mesh file units
+integer :: points_file, faces_file, owner_file, neighbour_file, boundary_file, process_file
+
+! Global number of nodes, cells, faces, inner faces, and boundary faces when summed from all domains
+integer :: gloNodes,gloCells, gloFaces, gloIFaces, gloBFaces
+
+
+! Mesh geometry
+
+! Geometry parameters defined for mesh nodes [1:numNodes]
+real(dp), dimension(:), allocatable :: x,y,z ! Coordinates of mesh nodes
+
+! Geometry parameters defined cellwise [1:numCells]:
+real(dp), dimension(:), allocatable :: xc,yc,zc ! Coordinates of cell centers
+real(dp), dimension(:), allocatable :: vol ! Cell volume
+real(dp), dimension(:), allocatable :: wallDistance ! Distance to the nearest wall - needed in some turb. models
+
+! Geometry parameters defined for all (inner+boundary) cell faces [1:numFaces]
+real(dp), dimension(:), allocatable :: arx, ary, arz ! Cell face area x-, y- and z-component
+real(dp), dimension(:), allocatable :: xf, yf, zf ! Coordinates of cell face center
+
+! Geometry parameters defined for all inner cell faces [1:numInnerFaces]
+real(dp), dimension(:), allocatable :: xpp, ypp, zpp ! Coordinates of auxilliary points - owner cell
+real(dp), dimension(:), allocatable :: xnp, ynp, znp ! Coordinates of auxilliary points - neighbour cell
+real(dp), dimension(:), allocatable :: facint ! Interpolation factor
+real(dp), dimension(:), allocatable :: fpro ! Interpolation factor for faces at process boundaries
+
+
+! Geometry parameters defined for boundary faces
+real(dp), dimension(:), allocatable :: srds,dns ! srds = |are|/|dns|, dns = normal distance to cell center from face |dpn*face_normal_unit_vec|
+real(dp), dimension(:), allocatable :: srdw,dnw ! srdw = |are|/|dnw|, dnw = normal distance to cell center from face |dpn*face_normal_unit_vec|
+
+! Mesh topology information - connectivity of cells trough faces
+integer, dimension(:), allocatable :: owner ! Index of the face owner cell
+integer, dimension(:), allocatable :: neighbour ! Index of the neighbour cell - it shares the face with owner
+
+
+public
+
+contains
+
+
+subroutine read_mesh
+!
+! Description:
+! Calculates basic geometrical quantities of numerical mesh
+! defined in this module and needed for FVM computation.
+! Mesh is described in files similar to polyMesh format.
+! Mesh files are 'points', 'faces', 'owner, 'neighbour', 'boundary'
+!
+! Date:
+! 26/11/2015, 12/06/2019
+!
+! Author:
+! Nikola Mirkov nmirkov@vinca.rs
+!
+
+ use my_mpi_module
+
+ implicit none
+
+ ! Locals
+ integer :: i,j,k,l,itmp
+ integer :: ib,iwall,isym,ipro
+ integer :: iface
+ integer :: inp,inn,ijp
+ integer :: numCnct
+
+ character(len=1) :: ch
+ character(len=20) :: char_string,char_string2
+ character(len=80) :: line_string
+ character( len = 5) :: nproc_char
+
+ integer, dimension(nomax) :: node ! It will store global node numbers of cell vertexes
+ integer :: nnodes ! no. of nodes in face
+
+ real(dp), parameter :: half = 0.5_dp
+ real(dp), parameter :: third = 1./3._dp
+
+ real(dp) :: px,py,pz, qx,qy,qz, nx,ny,nz, cx,cy,cz
+ real(dp) :: riSi
+ real(dp) :: are,areasum
+ real(dp) :: xpn,ypn,zpn
+ real(dp) :: xjp,yjp,zjp
+ real(dp) :: dpn,djn
+ real(dp) :: nxf,nyf,nzf
+
+ ! Array for temporary storage of doubles
+ real(dp), dimension(:), allocatable :: r8tmp
+
+!******************************************************************************
+! > OPEN polyMesh format files: 'points', 'faces', 'owner', 'neighbour'.
+!..............................................................................
+
+ ! nproc_char <- myid zapisan levo u vidu stringa.
+ call i4_to_s_left ( myid, nproc_char )
+
+ call get_unit( points_file )
+ open( unit = points_file,file = 'processor'//trim(nproc_char)//'/constant/polyMesh/points' )
+ rewind points_file
+
+ call get_unit( faces_file )
+ open( unit = faces_file, file = 'processor'//trim(nproc_char)//'/constant/polyMesh/faces' )
+ rewind faces_file
+
+ call get_unit( owner_file )
+ open( unit = owner_file, file = 'processor'//trim(nproc_char)//'/constant/polyMesh/owner' )
+ rewind owner_file
+
+ call get_unit( neighbour_file )
+ open( unit = neighbour_file, file = 'processor'//trim(nproc_char)//'/constant/polyMesh/neighbour' )
+ rewind neighbour_file
+
+ call get_unit( boundary_file )
+ open( unit = boundary_file, file = 'processor'//trim(nproc_char)//'/constant/polyMesh/boundary' )
+ rewind boundary_file
+
+ call get_unit( process_file )
+ open( unit = process_file, file = 'processor'//trim(nproc_char)//'/constant/polyMesh/process' )
+ rewind process_file
+
+
+!
+! > Read 'process' file with domain connectivity information for MPI
+!
+
+ ! Number of rows in the file excluding #comment in header
+ call file_row_count ( process_file, numConnections)
+
+ read(process_file,'(a)') line_string ! header line
+ ! read(process_file,*) numConnections
+
+ ! Allocate domain connectivity arrays
+ allocate ( neighbProcNo( numConnections ) )
+ allocate ( neighbProcOffset( numConnections+1 ) )
+
+ do i=1,numConnections
+ read(process_file,*) neighbProcNo(i)
+ enddo
+
+!
+! > Read boundary conditions file.
+!
+
+!
+! Boundary conditions file consists of header and numBoundaries number of subsequent lines each containing:
+! boundary condition given name, bc type, number of faces belonging to that bc and starting face for that bc.
+! Possible boundary contiions types are: process, inlet, outlet, symmetry, wall, wallIsoth, wallAdiab, wallQFlux, prOutlet, etc.
+! Please check are all of these implemented, because this is still in the development. Contact me if you have any questions.
+!
+
+
+ ! Number of rows in the file excluding #comment in header to conclude the number of prescribed boundaries
+ call file_row_count ( boundary_file, numBoundaries )
+
+ read(boundary_file,'(a)') line_string ! Firts line is header.
+ ! read(boundary_file,*) numBoundaries ! it doesn't need to read the number of boundaries because of the above
+
+ ! Allocate
+ allocate ( bcname(numBoundaries) )
+ allocate ( bctype(numBoundaries) )
+ allocate ( nFaces(numBoundaries) )
+ allocate ( startFace(numBoundaries) )
+ allocate ( iBndValueStart(numBoundaries))
+
+ nwal = 0
+ nsym = 0
+ ninl = 0
+ npro = 0
+
+
+ ! Where is the data which will be sent to neighbouring process (a "connection")
+ ! is described by offsets in single buffer data array
+ numCnct = 1
+ neighbProcOffset(1) = 1
+
+
+ do i=1,numBoundaries
+ read(boundary_file,*) bcname(i), bctype(i), nfaces(i) ,startFace(i) ! Now it reads four things btw
+
+ ! We need total number of some bctype faces like wall and symmetry to make things easier for bc implementation
+ ! so lets count them.
+ if( bctype(i) == 'wall') then
+ nwal = nwal + nfaces(i)
+
+ elseif( bctype(i) == 'symmetry') then
+ nsym = nsym + nfaces(i)
+
+ elseif( bctype(i) == 'inlet') then
+ ninl = ninl + nfaces(i)
+
+ elseif( bctype(i) == 'outlet') then
+ nout = nout + nfaces(i)
+
+ elseif( bctype(i) == 'process') then
+ npro = npro + nfaces(i)
+ neighbProcOffset( numCnct+1 ) = neighbProcOffset( numCnct ) + nfaces(i)
+ numCnct = numCnct + 1
+ endif
+ enddo
+
+!******************************************************************************
+! > Find out numNodes, numFaces, numInnerFaces, etc.
+!..............................................................................
+
+ !
+ ! Code here is tested for OpenFOAM version 4.0, if they don't change polyMesh format this should be OK.
+ !
+
+ !
+ ! The 'owner' file. After reading this we will have numNodes, numCells, numInnerFaces, numFaces
+ !
+
+ k=0
+ l=0
+ char_string = ' '
+
+ owner_header_loop: do
+
+ ! Trying to find the line with mesh size info, and read numCells
+ read(owner_file,*) char_string,line_string
+ ! write(*,*) "owner file ",char_string
+
+ if (char_string == 'note') then
+
+ ! Do probing for nPoints:
+ do j=1,len_trim(line_string)-5
+ if (line_string(j:j+6)=='nPoints') then
+ k=j+8
+ endif
+ if (line_string(j:j+5)=='nCells') then
+ l=j-2
+ exit
+ endif
+ end do
+ read(line_string(k:l),*) numNodes
+ ! write(*,*) numNodes
+
+ ! Do probing for nCells:
+ do j=1,len_trim(line_string)-5
+ if (line_string(j:j+5)=='nCells') then
+ k=j+7
+ endif
+ if (line_string(j:j+5)=='nFaces') then
+ l=j-2
+ exit
+ endif
+ end do
+ read(line_string(k:l),*) numCells
+ ! write(*,*) numCells
+
+ ! Do probing for nFaces:
+ do j=1,len_trim(line_string)-5
+ if (line_string(j:j+5)=='nFaces') then
+ k=j+7
+ endif
+ if (line_string(j:j+13)=='nInternalFaces') then
+ l=j-2
+ exit
+ endif
+ end do
+ read(line_string(k:l),*) numFaces
+ ! write(*,*) numFaces
+
+ ! Do probing for nInternalFaces:
+ do j=1,len_trim(line_string)-5
+ ! write(*,*)line_string(j:j+15)
+
+ if (line_string(j:j+14)=='nInternalFaces:') then
+ read(line_string(j+15:),*) numInnerFaces
+ ! write(*,*) numInnerFaces
+ exit
+
+ endif
+ end do
+
+ exit owner_header_loop
+ endif
+
+ end do owner_header_loop
+
+ rewind owner_file
+
+ ! NOTE: Trying to acces number of faces data. So we go check line by line,
+ ! when we get to "(" we go two lines back and read numFaces.
+
+ ch = ' '
+ owner_loop: do
+ read(owner_file,*) ch
+ if (ch == '(') then
+ ! Return two lines
+ backspace(owner_file)
+ backspace(owner_file)
+ exit owner_loop
+ endif
+ end do owner_loop
+
+ read(owner_file,*) itmp
+ if (itmp /= numFaces ) then
+ write(*,*) "Error reading polyMesh format. numFaces value is not confirmed in body of the 'owner' file."
+ stop
+ endif
+ read(owner_file,*) char_string ! reads "(" again
+
+
+ !
+ ! The 'points' file
+ !
+
+ ! NOTE: Trying to acces number of points data. So we go check line by line,
+ ! when we get to "(" we go two lines back and read numNodes.
+
+ ch = ' '
+ point_header_loop: do
+ read(points_file,*) ch
+ if (ch == '(') then
+ ! Return two lines
+ backspace(points_file)
+ backspace(points_file)
+ exit point_header_loop
+ endif
+ end do point_header_loop
+
+ read(points_file,*) itmp
+ if (itmp /= numNodes ) then
+ write(*,*) "Error reading polyMesh format. numNodes value is not confirmed in 'points' file."
+ stop
+ endif
+ read(points_file,*) char_string ! reads "("
+
+ !
+ ! The 'neighbour' file
+ !
+
+ ! NOTE: Trying to acces number of inner faces data. So we go check line by line,
+ ! when we get to "(" we go two lines back and read numInnerFaces.
+
+ ch = ' '
+ neighbour_header_loop: do
+ read(neighbour_file,*) ch
+ if (ch == '(') then
+ ! Return two lines
+ backspace(neighbour_file)
+ backspace(neighbour_file)
+ exit neighbour_header_loop
+ endif
+ end do neighbour_header_loop
+
+ read(neighbour_file,*) itmp
+ if (itmp /= numInnerFaces ) then
+ write(*,*) "Error reading polyMesh format. numInnerFaces value is not confirmed in 'neighbour' file."
+ stop
+ endif
+ read(neighbour_file,*) char_string ! reads "("
+
+ !
+ ! The 'faces' file
+ !
+
+ ! NOTE: Trying to acces number of faces data. So we go check line by line,
+ ! when we get to "(" we go two lines back and read numFaces.
+
+ ch = ' '
+ faces_header_loop: do
+ read(faces_file,*) ch
+ if (ch == '(') then
+ backspace(faces_file)
+ backspace(faces_file)
+ exit faces_header_loop
+ endif
+ end do faces_header_loop
+
+ read(faces_file, *) itmp
+ if (itmp /= numFaces ) then
+ write(*,*) "Error reading polyMesh format. numFaces value is not confirmed in 'faces' file."
+ stop
+ endif
+ read(faces_file,*) char_string
+
+ ! Number of boundary faces
+ numBoundaryFaces = numFaces - numInnerFaces
+
+ ! Size of arrays storing variables numCells+numBoundaryFaces
+ numTotal = numCells + numBoundaryFaces
+
+ ! Size of array for gradients etc. which are numCells plus No. of buffer cells npro
+ numPCells = numCells + npro
+
+ ! NOTE:
+ ! The variable values defined at boundary faces are stored in variable arrays after numCells. The length of variable arrays therefore becomes numTotal = numCells + numBoundaryFaces
+ ! It is therefore important to do the following also.
+ ! Define where are the boundary field values located in the variable array, for each boundary region
+ do i=1,numBoundaries
+ iBndValueStart(i) = numCells + (startFace(i) - numInnerFaces)
+ enddo
+
+
+!
+! > Write report on mesh size into log file
+!
+
+ gloNodes = numNodes
+ call global_isum( gloNodes )
+
+ gloCells = numCells
+ call global_isum( gloCells )
+
+ gloFaces = numFaces
+ call global_isum( gloFaces )
+
+ gloIFaces = numInnerFaces
+ call global_isum( gloIFaces )
+
+ gloBFaces = numBoundaryFaces
+ call global_isum( gloBFaces )
+
+ if ( myid .eq. 0) then
+
+ write ( *, '(a)' ) ' '
+ write ( *, '(a)' ) ' '
+ write ( *, '(a)' ) ' Mesh data: '
+
+
+
+ write ( *, '(a)' ) ' '
+ write ( *, '(a,i8)' ) ' Number of nodes, numNodes = ', gloNodes
+
+
+ write ( *, '(a)' ) ' '
+ write ( *, '(a,i8)' ) ' Number of cells, numCells = ', gloCells
+
+
+ write ( *, '(a)' ) ' '
+ write ( *, '(a,i8)' ) ' Number of cell-faces, numFaces = ', gloFaces
+
+
+ write ( *, '(a)' ) ' '
+ write ( *, '(a,i8)' ) ' Number of inner cell-faces, numInnerFaces = ', gloIFaces
+
+ write ( *, '(a)' ) ' '
+ write ( *, '(a)' ) ' Boundary information:'
+ write ( *, '(a)' ) ' '
+ write ( *, '(a,i8)' ) ' Number of cell-faces on boundary, numBoundaryFaces = ', gloBFaces
+
+ write ( *, '(a)' ) ' '
+ write ( *, '(a)' ) ' Boundary information (bcname, bctype, nFaces, startFace):'
+ write ( *, '(a)' ) ' '
+
+ do i=1,numBoundaries
+ write(*,'(2x,a,1x,a,1x,2(i0,1x))') bcname(i), bctype(i), nfaces(i) ,startFace(i) ! Now it reads four things btw
+ enddo
+
+ if( npro.gt.0 ) then
+ write ( *, '(a)' ) ' '
+ write ( *, '(a,i8)' ) ' Number of processor boundary faces = ', npro
+ endif
+
+ write ( *, '(a)' ) ' '
+
+ endif
+
+!******************************************************************************
+! > Allocate arrays for Mesh description
+!..............................................................................
+
+ ! Nodal coordinates
+ allocate ( x(numNodes) )
+ allocate ( y(numNodes) )
+ allocate ( z(numNodes) )
+
+ ! Coordinates of cell centers
+
+ ! For now we will use non efficient way to have c. centers and vol of size numTotal,
+ ! this makes usage of flux routines much easier for 'process' boundaries,
+ ! in the near future maybe we should change to smaller size of arrays (numPcells)
+ ! since it is wastefull to have Volume and C. center for every boundary face.
+ ! Let us recall, cell center values are stored in positions 1,numCells, boundary face values
+ ! are stored in numCells+1, numTotal. If I want to exchange something I have only in the interior
+ ! I have these things stored in positions numCells+1, numPCells and exchange them with
+ ! subroutine exchange__ with double underscore. This one is inteded for thiese smaller arrays.
+
+ allocate ( xc(numTotal) )
+ allocate ( yc(numTotal) )
+ allocate ( zc(numTotal) )
+
+ ! Cell volumes
+ allocate ( vol(numTotal) )
+
+
+ ! Face area vector components
+ allocate ( arx(numFaces) )
+ allocate ( ary(numFaces) )
+ allocate ( arz(numFaces) )
+
+ ! Coordinates of cell face centers
+ allocate ( xf(numFaces) )
+ allocate ( yf(numFaces) )
+ allocate ( zf(numFaces) )
+
+ ! Interpolation factor for inner faces
+ allocate ( facint(numInnerFaces) )
+
+ ! Indices of owner cell (inner+boundary faces) and indices of neighbours for every inner cell-face.
+ allocate ( owner(numFaces) )
+ allocate ( neighbour(numInnerFaces) )
+
+ ! Array stroring the walue of distance to the nearest wall, needed only in some turb. models (maybe allocate only when needed)
+ allocate ( wallDistance(numCells) )
+
+ ! We need this only for wall and symmetry, so it is not bad to have nsym and nwal wich count home many of them there is.
+ allocate ( dns(nsym) )
+ allocate ( srds(nsym) )
+ allocate ( dnw(nwal) )
+ allocate ( srdw(nwal) )
+
+ ! Interpolation factor for process faces
+ allocate ( fpro(npro) )
+
+!
+! > Allocate and initialize parameters for MPI communication, declared in mpi_module
+!
+ lenbuf = npro
+ allocate ( bufind(lenbuf) )
+ allocate ( buffer(lenbuf) )
+
+
+!******************************************************************************
+! > Read and process Mesh files
+!..............................................................................
+
+ ! The 'points' file
+ do i=1,numNodes
+ ! char_string reads (number, char_string reads number), we have to strip off the brackets later.
+ read(points_file,*) char_string,y(i),char_string2
+
+ ! Char to double conversion + stripping off the brackets:
+ read(char_string(2:),*) x(i)
+ read(char_string2(1:len_trim(char_string2)-1),*) z(i)
+ end do
+
+
+ ! The 'owner' file
+ do i=1,numFaces
+ read(owner_file,*) owner(i)
+ owner(i) = owner(i) + 1 ! fortran starts from 1
+ end do
+
+
+
+ ! The 'neighbour' file
+ do i=1,numInnerFaces
+ read(neighbour_file,*) neighbour(i)
+ neighbour(i) = neighbour(i) + 1 ! fortran starts from 1
+ end do
+
+
+ !
+ ! > Array of buffer cell indices for MPI exchange
+ !
+
+ iPro = 0
+
+ do ib=1,numBoundaries
+
+ if ( bctype(ib) == 'process') then
+
+ do i=1,nfaces(ib)
+
+ iPro = iPro + 1
+
+ iface = startFace(ib) + i
+ bufind( ipro ) = owner( iface )
+
+ enddo
+ endif
+ enddo
+
+
+ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ ! > Cell volumes, cell centers and cell face centers
+ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+ ! Allocate tmp array of doubles
+ allocate( r8tmp(numCells))
+ r8tmp = 0.0_dp
+
+ do iface=1,numFaces
+
+ inp = owner(iface)
+
+ ! Initialize array of node indexes that construct the face
+ node = 0
+
+ ! Read line in 'faces' file
+ call read_line_faces_file_polyMesh(faces_file,nnodes,node,nomax)
+
+ ! Initialize total area of polygon.
+ areasum = 0.0_dp
+
+ ! We decompose a polygon to a series of triangles, all having first node in common.
+ do i=1,nnodes-2
+ ! Vectors to vertices
+ ! 2-1
+ px = x(node(i+1))-x(node(1))
+ py = y(node(i+1))-y(node(1))
+ pz = z(node(i+1))-z(node(1))
+ ! 3-1
+ qx = x(node(i+2))-x(node(1))
+ qy = y(node(i+2))-y(node(1))
+ qz = z(node(i+2))-z(node(1))
+
+
+ call triangle_area_vector( px,py,pz, qx,qy,qz, nx,ny,nz )
+
+ !
+ ! > Cell-face area vector components (Area vector lies in direction of face normal)
+ !
+
+ arx(iface) = arx(iface) + nx
+ ary(iface) = ary(iface) + ny
+ arz(iface) = arz(iface) + nz
+
+ ! Face center for a triangle
+ cx = third*( x(node(i+2)) + x(node(i+1)) + x(node(1)) )
+ cy = third*( y(node(i+2)) + y(node(i+1)) + y(node(1)) )
+ cz = third*( z(node(i+2)) + z(node(i+1)) + z(node(1)) )
+
+ !
+ ! > Cell-face centroid components - accumulation stage
+ !
+
+ are = sqrt(nx**2 + ny**2 + nz**2)
+
+ xf(iface) = xf(iface) + (are*cx)
+ yf(iface) = yf(iface) + (are*cy)
+ zf(iface) = zf(iface) + (are*cz)
+
+ ! Accumulate triangle areas to get total area of the polygon
+ areasum = areasum + are
+
+
+ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ ! > Compute cell volumes and cell centers
+ !
+ ! We compute cell volumes by aaplying divergence theorem to the position vector,
+ ! see eq. (5) in [1].
+ ! Cell center coordinates of an arbitrary polyhedron are computed using eq.(15) of ref. [1].
+ !
+ ! [1] Z.J. Wang - Improved Formulation for Geometric Properties of Arbitrary Polyhedra
+ ! AIAA Journal, Vol. 37, No. 10, October 1999
+ !
+ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+
+ riSi = ( cx*nx + cy*ny + cz*nz )
+
+ vol(inp) = vol(inp) + third * riSi
+
+ xc(inp) = xc(inp) + 0.75_dp * riSi * cx
+ yc(inp) = yc(inp) + 0.75_dp * riSi * cy
+ zc(inp) = zc(inp) + 0.75_dp * riSi * cz
+
+ ! We use r8tmp array to store accumulated denominator
+ r8tmp(inp) = r8tmp(inp) + riSi
+
+
+ if ( iface <= numInnerFaces ) then
+ inn = neighbour(iface)
+
+ riSi = -( cx*nx + cy*ny + cz*nz )
+
+ vol(inn) = vol(inn) + third * riSi
+
+ xc(inn) = xc(inn) + 0.75_dp * riSi * cx
+ yc(inn) = yc(inn) + 0.75_dp * riSi * cy
+ zc(inn) = zc(inn) + 0.75_dp * riSi * cz
+
+ ! We use r8tmp array to store accumulated denominator
+ r8tmp(inn) = r8tmp(inn) + riSi
+
+ endif
+
+ enddo
+
+ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ ! > Cell-face centroid components - final
+ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+ xf(iface) = xf(iface) / areasum
+ yf(iface) = yf(iface) / areasum
+ zf(iface) = zf(iface) / areasum
+
+ enddo
+
+ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ ! > Cell centroid components - final
+ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+ ! Do one more loop over cell volumes to divide accumulated cell center values by
+ ! denominator accumulated in wallDistance array for convenience.
+ do inp=1,numCells
+ xc(inp) = xc(inp) / r8tmp(inp)
+ yc(inp) = yc(inp) / r8tmp(inp)
+ zc(inp) = zc(inp) / r8tmp(inp)
+ enddo
+
+ ! Thank you.
+ deallocate(r8tmp)
+
+ ! We need some geometry in the buffer cells, we fill these by exchanging info with other processes
+ call exchange( xc )
+ call exchange( yc )
+ call exchange( zc )
+ call exchange( Vol )
+
+
+ ! Rewind 'faces' file for one more sweep
+ rewind( faces_file )
+ ch = ' '
+ do
+ read(faces_file,*) ch
+ if (ch == "(") then
+ exit
+ endif
+ end do
+
+
+ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ ! > Interpolation factor
+ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+ do iface=1,numFaces
+
+ !
+ ! > Interpolation factor > inner faces
+ !
+
+ if(iface <= numInnerFaces) then
+
+ inp = owner(iface)
+ inn = neighbour(iface)
+
+ node = 0
+
+ ! Read line in 'faces' file
+ call read_line_faces_file_polyMesh(faces_file,nnodes,node,nomax)
+
+ xpn = xc(inn)-xc(inp)
+ ypn = yc(inn)-yc(inp)
+ zpn = zc(inn)-zc(inp)
+
+ dpn = sqrt( xpn**2 + ypn**2 + zpn**2 )
+
+ !
+ ! > > Intersection point j' of line connecting centers with cell face, we are taking only three points assuming that other are co-planar
+ !
+ call find_intersection_point(&
+ ! plane defined by three face vertices:
+ x(node(1)),y(node(1)),z(node(1)),&
+ x(node(2)),y(node(2)),z(node(2)), &
+ x(node(3)),y(node(3)),z(node(3)), &
+ ! line defined by cell center and neighbour center:
+ xc(inp),yc(inp),zc(inp), &
+ xc(inn),yc(inn),zc(inn), &
+ ! intersection point (output):
+ xjp,yjp,zjp &
+ )
+ xpn = xjp - xc(inp)
+ ypn = yjp - yc(inp)
+ zpn = zjp - zc(inp)
+
+ djn = sqrt( xpn**2 + ypn**2 + zpn**2 )
+
+ ! Interpolation factor |P Pj'|/|P Pj| where P is cell center, Pj neighbour cell center and j' intersection point.
+ facint(iface) = djn / dpn
+
+ endif
+
+ enddo
+
+
+ !
+ ! > Interpolation factor > faces on process boundaries
+ !
+
+ iPro = 0
+
+ do ib=1,numBoundaries
+
+ if ( bctype(ib) == 'process') then
+
+ do i=1,nfaces(ib)
+
+ iface = startFace(ib) + i
+ inp = owner(iface)
+ inn = iBndValueStart(ib) + i
+
+ iPro = iPro + 1
+
+ node = 0
+
+ ! Read line in 'faces' file
+ call read_line_faces_file_polyMesh(faces_file,nnodes,node,nomax)
+
+
+ xpn = xc(inn)-xc(inp)
+ ypn = yc(inn)-yc(inp)
+ zpn = zc(inn)-zc(inp)
+
+ dpn = sqrt( xpn**2 + ypn**2 + zpn**2 )
+
+ ! > > Intersection point j' of line connecting centers with cell face, we are taking only three points assuming that other are co-planar
+ call find_intersection_point( &
+ ! plane defined by three face vertices:
+ x(node(1)),y(node(1)),z(node(1)),&
+ x(node(2)),y(node(2)),z(node(2)), &
+ x(node(3)),y(node(3)),z(node(3)), &
+ ! line defined by cell center and neighbour center:
+ xc(inp),yc(inp),zc(inp), &
+ xc(inn),yc(inn),zc(inn), &
+ ! intersection point (output):
+ xjp,yjp,zjp &
+ )
+ xpn = xjp - xc(inp)
+ ypn = yjp - yc(inp)
+ zpn = zjp - zc(inp)
+
+ djn = sqrt( xpn**2 + ypn**2 + zpn**2 )
+
+ ! Interpolation factor |P Pj'|/|P Pj| where P is cell center, Pj neighbour cell center and j' intersection point.
+ fpro(iPro) = djn/dpn
+
+ enddo
+
+ else
+ ! Not a proces boundary
+
+ do i=1,nfaces(ib)
+
+ ! Read line in 'faces' file
+ call read_line_faces_file_polyMesh(faces_file,nnodes,node,nomax)
+
+ enddo
+
+ endif
+
+ enddo ! interpolation factor loop
+
+ ! Loop over wall boundaries to calculate normal distance from cell center of the first cell layer - dnw, and
+ ! loop over symmetry boundaries to calculate normal distance from cell center of the first cell layer - dns.
+
+ iWall = 0
+ iSym = 0
+
+
+ do ib=1,numBoundaries
+
+ if ( bctype(ib) == 'symmetry') then
+
+ ! Symmetry
+ do i=1,nfaces(ib)
+
+ iface = startFace(ib) + i
+ ijp = owner(iface)
+ iSym = iSym + 1
+
+ ! Face area
+ are = sqrt(arx(iface)**2+ary(iface)**2+arz(iface)**2)
+
+ ! Face normals
+ nxf = arx(iface)/are
+ nyf = ary(iface)/are
+ nzf = arz(iface)/are
+
+ ! We need the minus sign because of the direction of normal vector to boundary face which is positive if it faces out.
+ dns(iSym) = (xf(iface)-xc(ijp))*nxf + (yf(iface)-yc(ijp))*nyf + (zf(iface)-zc(ijp))*nzf
+
+ ! Cell face area divided by distance to the cell center
+ srds(iSym) = are/dns(iSym)
+
+ end do
+
+ elseif ( bctype(ib) == 'wall') then
+
+ do i=1,nfaces(ib)
+
+ iface = startFace(ib) + i
+ ijp = owner(iface)
+ iWall = iWall + 1
+
+ ! Face area
+ are = sqrt(arx(iface)**2+ary(iface)**2+arz(iface)**2)
+
+ ! Face normals
+ nxf = arx(iface)/are
+ nyf = ary(iface)/are
+ nzf = arz(iface)/are
+
+ ! We need the minus sign because of the direction of normal vector to boundary face which is positive if it faces out.
+ dnw(iWall) = (xf(iface)-xc(ijp))*nxf + (yf(iface)-yc(ijp))*nyf + (zf(iface)-zc(ijp))*nzf
+
+ ! Cell face area divided by distance to the cell center
+ srdw(iWall) = are/dnw(iWall)
+
+ enddo
+
+ endif
+
+ enddo
+
+!******************************************************************************
+! > Report on geometrical quantities > I will leave this for debug purposes.
+!..............................................................................
+
+ if (myid .eq. 0 ) then
+
+ write ( *, '(a)' ) ' '
+ write ( *, '(a)' ) ' Cell data: '
+
+ call r8vec_print_some ( numCells, vol, 1, 10, &
+ ' First 10 elements of cell volumes array:' )
+
+ call r8vec_print_some ( numCells, xc, 1, 10, &
+ ' First 10 elements of cell x-centers array:' )
+
+ call r8vec_print_some ( numCells, yc, 1, 10, &
+ ' First 10 elements of cell y-centers array:' )
+
+ call r8vec_print_some ( numCells, zc, 1, 10, &
+ ' First 10 elements of cell z-centers array:' )
+
+ write ( *, '(a)' ) ' '
+ write ( *, '(a)' ) ' Face data: '
+
+ call i4vec_print2 ( 10, owner, neighbour, ' First 10 lines of owner and neighbour arrays:' )
+
+ call r8vec_print_some ( numFaces, arx, 1, 10, &
+ ' First 10 elements of Arx array:' )
+
+ call r8vec_print_some ( numFaces, ary, 1, 10, &
+ ' First 10 elements of Ary array:' )
+
+ call r8vec_print_some ( numFaces, arz, 1, 10, &
+ ' First 10 elements of Arz array:' )
+
+ call r8vec_print_some ( numFaces, xf, 1, 10, &
+ ' First 10 elements of xf array:' )
+
+ call r8vec_print_some ( numFaces, yf, 1, 10, &
+ ' First 10 elements of yf array:' )
+
+ call r8vec_print_some ( numFaces, zf, 1, 10, &
+ ' First 10 elements of zf array:' )
+
+ call r8vec_print_some ( numInnerFaces, facint, 1, 10, &
+ ' First 10 elements of interpolation factor (facint) array:' )
+
+ endif
+
+ ! Thank you
+ deallocate (x)
+ deallocate (y)
+ deallocate (z)
+
+!
+! > CLOSE polyMesh format file: 'points', 'faces', 'owner', 'neighbour', 'boundary', 'process'.
+!
+ close ( points_file )
+ close ( faces_file )
+ close ( owner_file )
+ close ( neighbour_file)
+ close ( boundary_file)
+ close ( process_file)
+!+-----------------------------------------------------------------------------+
+
+end subroutine read_mesh
+
+
+subroutine triangle_area_vector(px,py,pz,qx,qy,qz,nx,ny,nz)
+!
+! Ai, i=1,n are n triangular faces enclosing polyhedron P.
+! Vertices of Ai are (ai,bi,ci),
+! _ _ _ _ _ _ _ _
+! Unit normal to P on each Ai is ni = ni/|ni|, ni = (bi-ai)x(ci-ai)
+! and
+! _ _ _ _ _ _
+! p = (bi-ai); q = (ci-ai)
+!
+! Finally: _
+! Area A of Ai, A = 1/2|ni|
+!
+! Sources:
+! [1] Dr Robert Nurnberg, Imperial College London, www.ma.ic.ac.uk/~rn/centroid.pdf
+! [2] paulbourke.net/geometry/polygonmesh
+!
+ implicit none
+ real(dp), intent(in) :: px,py,pz,qx,qy,qz
+ real(dp), intent(inout) :: nx,ny,nz
+
+ real(dp), parameter :: half = 0.5_dp
+
+ ! Cross products for triangle surface vectors
+ nx = half * (py*qz-pz*qy)
+ ny = half * (pz*qx-px*qz)
+ nz = half * (px*qy-py*qx)
+
+end subroutine
+
+
+pure function cell_volume_part_polymesh(ax,ay,az,nx,ny,nz) result(volume_part)
+!
+! Ai, i=1,n are n triangular faces enclosing polyhedron P.
+! Vertices of Ai are (ai,bi,ci),
+! _ _ _ _
+! Unit normal to P on each Ai is ni = ni/|ni|, ni = (bi-ai)x(ci-ai)
+! Volume of P is given by:
+! _ _ _ _
+! V = 1/6 * sum_i=1^n (ai.ni) or sum_i=1^n 1/6*(ai.ni)
+!
+! Sources:
+! [1] Dr Robert Nurnberg, Imperial College London, www.ma.ic.ac.uk/~rn/centroid.pdf
+! [2] paulbourke.net/geometry/polygonmesh
+
+ implicit none
+ real(dp), intent(in) :: ax,ay,az
+ real(dp), intent(in) :: nx,ny,nz
+ real(dp) :: volume_part
+
+ volume_part = 1./6._dp*( ax*nx + ay*ny + az*nz )
+end function
+
+
+pure function centroid_component_part_polymesh(ax,bx,cx,nx,vol) result(cc_part)
+!
+! Ai, i=1,n are n triangular faces enclosing polyhedron P.
+! Vertices of Ai are (ai,bi,ci),
+! _ _ _ _
+! Unit normal to P on each Ai is ni = ni/|ni|, ni = (bi-ai)x(ci-ai)
+! Cell center (cc) component of P is given by:
+!
+! cc.ed = 1/2V * sum_i=1^n (x.ed)^2*(ni.ed), where ed is unit basis of R^3, d=1,2,3.
+!
+! Thios function calculates part under summation which is accumulated in outer loop.
+!
+! Sources:
+! [1] Dr Robert Nurnberg, Imperial College London, www.ma.ic.ac.uk/~rn/centroid.pdf
+! [2] paulbourke.net/geometry/polygonmesh
+
+ implicit none
+ real(dp), intent(in) :: ax,bx,cx
+ real(dp), intent(in) :: vol,nx
+ real(dp) :: cc_part
+
+ cc_part = 1./(2*vol) * 1./24._dp*nx * ( (ax+bx)**2 + (bx+cx)**2 + (cx+ax)**2 )
+
+end function
+
+
+ function determinant(a1,a2,a3,b1,b2,b3,q1,q2,q3)
+!
+! Calculates determinant of 3x3 matrix
+!
+ implicit none
+ real(dp) :: a1,a2,a3,b1,b2,b3,q1,q2,q3
+ real(dp) :: determinant
+
+ determinant = (a2*b3-b2*a3)*q1 &
+ +(b1*a3-a1*b3)*q2 &
+ +(a1*b2-a2*b1)*q3
+ end function
+
+
+
+subroutine find_intersection_point( &
+! plane defined by three face corners:
+ x1,y1,z1,&
+ x2,y2,z2, &
+ x3,y3,z3, &
+! line defined by cell center and neighbour center:
+ x4,y4,z4, &
+ x5,y5,z5, &
+! intersection point (output):
+ xjp,yjp,zjp &
+ )
+!
+!***********************************************************************
+! Find intersection point (pjp={xjp,yjp,zjp}) of
+! plane (defined by points p1={x1,y1,z1}, p2={x2,y2,z2} and p3={x3,y3,z3}),
+! and line (defined by points p4={x4,y4,z4} and p5={x5,y5,z5}).
+! The intersection point j' is not the face center j on non-orthogonal meshes.
+! There is an "intersection point offset" |jj'| which determines the level
+! of nonorthogonality.
+!
+!
+! |1 1 1 1 | |1 1 1 0 |
+! t = - |x1 x2 x3 x4| / |x1 x2 x3 x5-x4| (mind the minus sign!)
+! |y1 y2 y3 y4| / |y1 y2 y3 y5-y4|
+! |z1 z2 z3 z4| |z1 z2 z3 z5-z4|
+!
+! And intersection point is given by:
+! xj = x4 +(x5-x4)*t
+! yj = y4 +(y5-y4)*t
+! zj = z4 +(z5-z4)*t
+!
+!
+! Nikola Mirkov @2016
+!
+! example usage:
+! call find_intersection_point( &
+!! plane defined by face corners:
+! x(inp),y(inp),z(inp),&
+! x(inp-idns),y(inp-idns),z(inp-idns), &
+! x(inp-idtb),y(inp-idtb),z(inp-idtb), &
+!! line defined by cell center and neighbour center:
+! xc(inp),yc(inp),zc(inp), &
+! xc(inp+idew),yc(inp+idew),zc(inp+idew), &
+!! intersection point:
+! xj,yj,zj &
+! )
+!***********************************************************************
+ implicit none
+!
+!***********************************************************************
+!
+
+ real(dp), intent(in) :: x1,y1,z1,&
+ x2,y2,z2, &
+ x3,y3,z3, &
+ x4,y4,z4, &
+ x5,y5,z5
+ real(dp), intent(inout) :: xjp,yjp,zjp
+
+ real(dp) :: t
+
+ ! Produced by MATLAB symbolic tool.
+ t =-(x2*(y3*z4-y4*z3)-x1*(y3*z4-y4*z3)-x3*(y2*z4-y4*z2)+x1*(y2*z4-y4*z2)+x3*(y1*z4-y4*z1)-x2* &
+ (y1*z4-y4*z1)+x4*(y2*z3-y3*z2)-x1*(y2*z3-y3*z2)-x4*(y1*z3-y3*z1)+x2*(y1*z3-y3*z1)+x4* &
+ (y1*z2-y2*z1)-x3*(y1*z2-y2*z1)) &
+ /(x2*(y3*(z5-z4)-(y5-y4)*z3)-x1*(y3*(z5-z4)-(y5-y4)*z3)-x3*(y2*(z5-z4)-(y5-y4)*z2)+x1* &
+ (y2*(z5-z4)-(y5-y4)*z2)+x3*(y1*(z5-z4)-(y5-y4)*z1)-x2*(y1*(z5-z4)-(y5-y4)*z1)+(x5-x4)* &
+ (y2*z3-y3*z2)-(x5-x4)*(y1*z3-y3*z1)+(x5-x4)*(y1*z2-y2*z1) + tiny)
+
+ xjp = x4 +(x5-x4)*t
+ yjp = y4 +(y5-y4)*t
+ zjp = z4 +(z5-z4)*t
+
+end subroutine
+
+
+subroutine read_line_faces_file_polyMesh(faces_file,nn,nod,nmax)
+ implicit none
+ integer, intent(in) :: faces_file
+ integer, intent(in) :: nmax
+ integer, intent(out) :: nn
+ integer, dimension(nmax), intent(out) :: nod
+ integer :: j,m,n
+ character(len=15) :: char_string,char_string2
+
+ nn = 0
+ nod = 0
+
+ ! Read how many nodes in face
+ read(faces_file,'(a)') char_string ! e.g. 4(1 22 463 442)
+ read(char_string(1:1),*)j ! in this example j=4
+ backspace(faces_file) ! go back so you are able to read this line again (what can I do...)
+
+ read(faces_file,*) char_string,nod(2:j-1),char_string2
+
+ ! Char to double conversion:
+ read(char_string(1:1),*)j ! number of vertrices
+ read(char_string(3:),*) m ! first vertex
+ read(char_string2(1:len_trim(char_string2)-1),*) n ! last vertex
+
+ nn = j
+ nod(1) = m + 1 ! <
+ nod(2:j-1) = nod(2:j-1) + 1 ! < We are going from zero to one based numbering because of Fortran
+ nod(nn) = n + 1 ! <
+
+end subroutine
+
+
+
+end module
diff --git a/src-par/geometry.f90 b/src-par/geometry.f90
index 55cf9c4..9f377ee 100644
--- a/src-par/geometry.f90
+++ b/src-par/geometry.f90
@@ -25,7 +25,7 @@ module geometry
! To define boundary regions
integer :: numBoundaries
integer, dimension(:), allocatable :: nfaces,startFace,iBndValueStart
-character(len=15), dimension(:), allocatable :: bcname, bctype
+character(len=30), dimension(:), allocatable :: bcname, bctype
integer :: npro ! No. of boundary faces on 'process' boundary - connected to another computational domain
integer :: ninl ! No. of inlet boundary faces
@@ -42,7 +42,7 @@ module geometry
integer :: points_file, faces_file, owner_file, neighbour_file, boundary_file, process_file
! Global number of nodes, cells, faces, inner faces, and boundary faces when summed from all domains
-integer :: gloNodes,gloCells, gloFaces, gloIFaces, gloBFaces
+integer :: gloNodes,gloCells, gloFaces, gloIFaces, gloBFaces, gloNpro
! Mesh geometry
@@ -104,14 +104,15 @@ subroutine read_mesh
integer :: ib,iwall,isym,ipro
integer :: iface
integer :: inp,inn,ijp
+ integer :: numCnct
character(len=1) :: ch
character(len=20) :: char_string,char_string2
character(len=80) :: line_string
- character( len = 5) :: nproc_char
+ character(len=5) :: nproc_char
- integer, dimension(nomax) :: node ! It will store global node numbers of cell vertexes
- integer :: nnodes ! no. of nodes in face
+ integer, dimension(:,:), allocatable :: node ! It will store global node numbers of face vertices
+ integer, dimension(:), allocatable :: nnodes ! no. of nodes in face
real(dp), parameter :: half = 0.5_dp
real(dp), parameter :: third = 1./3._dp
@@ -208,7 +209,10 @@ subroutine read_mesh
ninl = 0
npro = 0
- neighbProcOffset(1) = 1
+ ! Where is the data which will be sent to neighbouring process (a "connection")
+ ! is described by offsets in single buffer data array
+ numCnct = 1
+ neighbProcOffset( numCnct ) = 1
do i=1,numBoundaries
@@ -230,14 +234,13 @@ subroutine read_mesh
elseif( bctype(i) == 'process') then
npro = npro + nfaces(i)
- neighbProcOffset(i+1) = neighbProcOffset(i) + nfaces(i)
-
+ neighbProcOffset( numCnct+1 ) = neighbProcOffset( numCnct ) + nfaces(i)
+ numCnct = numCnct + 1
endif
enddo
! This denotes position of the last plus one.
- neighbProcOffset( numConnections+1 ) = npro + 1
-
+ ! neighbProcOffset( numConnections+1 ) = npro + 1
!******************************************************************************
! > Find out numNodes, numFaces, numInnerFaces, etc.
@@ -454,6 +457,9 @@ subroutine read_mesh
gloBFaces = numBoundaryFaces
call global_isum( gloBFaces )
+ gloNpro = npro
+ call global_isum( gloNpro )
+
if ( myid .eq. 0) then
write ( *, '(a)' ) ' '
@@ -482,17 +488,17 @@ subroutine read_mesh
write ( *, '(a)' ) ' '
write ( *, '(a,i8)' ) ' Number of cell-faces on boundary, numBoundaryFaces = ', gloBFaces
- write ( *, '(a)' ) ' '
- write ( *, '(a)' ) ' Boundary information (bcname, bctype, nFaces, startFace):'
- write ( *, '(a)' ) ' '
+ ! write ( *, '(a)' ) ' '
+ ! write ( *, '(a)' ) ' Boundary information (bcname, bctype, nFaces, startFace):'
+ ! write ( *, '(a)' ) ' '
- do i=1,numBoundaries
- write(*,'(2x,a,1x,a,1x,2(i0,1x))') bcname(i), bctype(i), nfaces(i) ,startFace(i) ! Now it reads four things btw
- enddo
+ ! do i=1,numBoundaries
+ ! write(*,'(2x,a,1x,a,1x,2(i0,1x))') bcname(i), bctype(i), nfaces(i) ,startFace(i) ! Now it reads four things btw
+ ! enddo
if( npro.gt.0 ) then
write ( *, '(a)' ) ' '
- write ( *, '(a,i8)' ) ' Number of processor boundary faces = ', npro
+ write ( *, '(a,i8)' ) ' Number of processor boundary faces = ', gloNpro
endif
write ( *, '(a)' ) ' '
@@ -588,7 +594,6 @@ subroutine read_mesh
end do
-
! The 'neighbour' file
do i=1,numInnerFaces
read(neighbour_file,*) neighbour(i)
@@ -596,6 +601,16 @@ subroutine read_mesh
end do
+ ! Allocate tmp array of number of nodes for each face - nnodes, and node array
+ allocate( nnodes(numFaces) )
+ allocate( node(4,numFaces) )
+
+ ! The 'faces' file
+ do iface=1,numFaces
+ ! Read line in 'faces' file
+ call read_line_faces_file_polyMesh(faces_file,nnodes(iface),node(1:4,iface),4)
+ enddo
+
!
! > Array of buffer cell indices for MPI exchange
!
@@ -632,26 +647,26 @@ subroutine read_mesh
inp = owner(iface)
- ! Initialize array of node indexes that construct the face
- node = 0
+ ! ! Initialize array of node indexes that construct the face
+ ! node = 0
- ! Read line in 'faces' file
- call read_line_faces_file_polyMesh(faces_file,nnodes,node,nomax)
+ ! ! Read line in 'faces' file
+ ! call read_line_faces_file_polyMesh(faces_file,nnodes,node,nomax)
! Initialize total area of polygon.
areasum = 0.0_dp
! We decompose a polygon to a series of triangles, all having first node in common.
- do i=1,nnodes-2
+ do i=1, nnodes(iface)-2
! Vectors to vertices
! 2-1
- px = x(node(i+1))-x(node(1))
- py = y(node(i+1))-y(node(1))
- pz = z(node(i+1))-z(node(1))
+ px = x( node(i+1,iface) )-x( node(1,iface) )
+ py = y( node(i+1,iface) )-y( node(1,iface) )
+ pz = z( node(i+1,iface) )-z( node(1,iface) )
! 3-1
- qx = x(node(i+2))-x(node(1))
- qy = y(node(i+2))-y(node(1))
- qz = z(node(i+2))-z(node(1))
+ qx = x( node(i+2,iface) )-x( node(1,iface) )
+ qy = y( node(i+2,iface) )-y( node(1,iface) )
+ qz = z( node(i+2,iface) )-z( node(1,iface) )
call triangle_area_vector( px,py,pz, qx,qy,qz, nx,ny,nz )
@@ -665,9 +680,9 @@ subroutine read_mesh
arz(iface) = arz(iface) + nz
! Face center for a triangle
- cx = third*( x(node(i+2)) + x(node(i+1)) + x(node(1)) )
- cy = third*( y(node(i+2)) + y(node(i+1)) + y(node(1)) )
- cz = third*( z(node(i+2)) + z(node(i+1)) + z(node(1)) )
+ cx = third*( x( node(i+2,iface) ) + x( node(i+1,iface) ) + x( node(1,iface) ) )
+ cy = third*( y( node(i+2,iface) ) + y( node(i+1,iface) ) + y( node(1,iface) ) )
+ cz = third*( z( node(i+2,iface) ) + z( node(i+1,iface) ) + z( node(1,iface) ) )
!
! > Cell-face centroid components - accumulation stage
@@ -758,67 +773,48 @@ subroutine read_mesh
call exchange( Vol )
- ! Rewind 'faces' file for one more sweep
- rewind( faces_file )
- ch = ' '
- do
- read(faces_file,*) ch
- if (ch == "(") then
- exit
- endif
- end do
-
-
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
! > Interpolation factor
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
- do iface=1,numFaces
+ do iface=1,numInnerFaces
!
! > Interpolation factor > inner faces
!
- if(iface <= numInnerFaces) then
-
- inp = owner(iface)
- inn = neighbour(iface)
-
- node = 0
-
- ! Read line in 'faces' file
- call read_line_faces_file_polyMesh(faces_file,nnodes,node,nomax)
+ inp = owner(iface)
+ inn = neighbour(iface)
- xpn = xc(inn)-xc(inp)
- ypn = yc(inn)-yc(inp)
- zpn = zc(inn)-zc(inp)
+ xpn = xc(inn)-xc(inp)
+ ypn = yc(inn)-yc(inp)
+ zpn = zc(inn)-zc(inp)
- dpn = sqrt( xpn**2 + ypn**2 + zpn**2 )
+ dpn = sqrt( xpn**2 + ypn**2 + zpn**2 )
- !
- ! > > Intersection point j' of line connecting centers with cell face, we are taking only three points assuming that other are co-planar
- !
- call find_intersection_point(&
- ! plane defined by three face vertices:
- x(node(1)),y(node(1)),z(node(1)),&
- x(node(2)),y(node(2)),z(node(2)), &
- x(node(3)),y(node(3)),z(node(3)), &
- ! line defined by cell center and neighbour center:
- xc(inp),yc(inp),zc(inp), &
- xc(inn),yc(inn),zc(inn), &
- ! intersection point (output):
- xjp,yjp,zjp &
- )
- xpn = xjp - xc(inp)
- ypn = yjp - yc(inp)
- zpn = zjp - zc(inp)
-
- djn = sqrt( xpn**2 + ypn**2 + zpn**2 )
-
- ! Interpolation factor |P Pj'|/|P Pj| where P is cell center, Pj neighbour cell center and j' intersection point.
- facint(iface) = djn / dpn
+ !
+ ! > > Intersection point j' of line connecting centers with cell face, we are taking only three points assuming that other are co-planar
+ !
+ call find_intersection_point(&
+ ! plane defined by three face vertices:
+ x( node(1,iface) ), y( node(1,iface) ), z( node(1,iface) ),&
+ x( node(2,iface) ), y( node(2,iface) ), z( node(2,iface) ), &
+ x( node(3,iface) ), y( node(3,iface) ), z( node(3,iface) ), &
+ ! line defined by cell center and neighbour center:
+ xc(inp),yc(inp),zc(inp), &
+ xc(inn),yc(inn),zc(inn), &
+ ! intersection point (output):
+ xjp,yjp,zjp &
+ )
+ xpn = xjp - xc(inp)
+ ypn = yjp - yc(inp)
+ zpn = zjp - zc(inp)
+
+ djn = sqrt( xpn**2 + ypn**2 + zpn**2 )
+
+ ! Interpolation factor |P Pj'|/|P Pj| where P is cell center, Pj neighbour cell center and j' intersection point.
+ facint(iface) = djn / dpn
- endif
enddo
@@ -841,12 +837,6 @@ subroutine read_mesh
iPro = iPro + 1
- node = 0
-
- ! Read line in 'faces' file
- call read_line_faces_file_polyMesh(faces_file,nnodes,node,nomax)
-
-
xpn = xc(inn)-xc(inp)
ypn = yc(inn)-yc(inp)
zpn = zc(inn)-zc(inp)
@@ -856,9 +846,9 @@ subroutine read_mesh
! > > Intersection point j' of line connecting centers with cell face, we are taking only three points assuming that other are co-planar
call find_intersection_point( &
! plane defined by three face vertices:
- x(node(1)),y(node(1)),z(node(1)),&
- x(node(2)),y(node(2)),z(node(2)), &
- x(node(3)),y(node(3)),z(node(3)), &
+ x( node(1,iface) ), y( node(1,iface) ), z( node(1,iface) ),&
+ x( node(2,iface) ), y( node(2,iface) ), z( node(2,iface) ), &
+ x( node(3,iface) ), y( node(3,iface) ), z( node(3,iface) ), &
! line defined by cell center and neighbour center:
xc(inp),yc(inp),zc(inp), &
xc(inn),yc(inn),zc(inn), &
@@ -872,23 +862,19 @@ subroutine read_mesh
djn = sqrt( xpn**2 + ypn**2 + zpn**2 )
! Interpolation factor |P Pj'|/|P Pj| where P is cell center, Pj neighbour cell center and j' intersection point.
- fpro(iPro) = djn/dpn
+ fpro(iPro) = djn / dpn
enddo
- else
- ! Not a proces boundary
-
- do i=1,nfaces(ib)
+ endif
- ! Read line in 'faces' file
- call read_line_faces_file_polyMesh(faces_file,nnodes,node,nomax)
+ enddo
- enddo
- endif
+ ! Thank you
+ deallocate(nnodes)
+ deallocate(node)
- enddo ! interpolation factor loop
! Loop over wall boundaries to calculate normal distance from cell center of the first cell layer - dnw, and
! loop over symmetry boundaries to calculate normal distance from cell center of the first cell layer - dns.
@@ -952,56 +938,99 @@ subroutine read_mesh
enddo
+
+
+ ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ ! ! > Auxilliary points P' and N'
+ ! ! (see Ferziger and Peric book, especially
+ ! ! the segments where treatment of nonorthogonality
+ ! ! is presented.)
+ ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+ ! allocate( xpp(numInnerFaces) )
+ ! allocate( ypp(numInnerFaces) )
+ ! allocate( zpp(numInnerFaces) )
+ ! allocate( xep(numInnerFaces) )
+ ! allocate( yep(numInnerFaces) )
+ ! allocate( zep(numInnerFaces) )
+
+ ! do i=1,numInnerFaces
+
+ ! ijp = owner(i)
+ ! ijn = neighbour(i)
+
+ ! ! cell face area
+ ! are = sqrt(arx(i)**2+ary(i)**2+arz(i)**2)
+
+ ! ! Unit vectors of the normal
+ ! nxx = arx(i)/are
+ ! nyy = ary(i)/are
+ ! nzz = arz(i)/are
+
+ ! xpp(i) = xf(i)-(xf(i)-xc(ijp))*nxx
+ ! ypp(i) = yf(i)-(yf(i)-yc(ijp))*nyy
+ ! zpp(i) = zf(i)-(zf(i)-zc(ijp))*nzz
+
+ ! xep(i) = xf(i)-(xf(i)-xc(ijn))*nxx
+ ! yep(i) = yf(i)-(yf(i)-yc(ijn))*nyy
+ ! zep(i) = zf(i)-(zf(i)-zc(ijn))*nzz
+
+ ! enddo
+
+
!******************************************************************************
! > Report on geometrical quantities > I will leave this for debug purposes.
!..............................................................................
- ! if (myid .eq. 0 ) then
+ if (myid .eq. 0 ) then
- ! write ( *, '(a)' ) ' '
- ! write ( *, '(a)' ) ' Cell data: '
+ write ( *, '(a)' ) ' '
+ write ( *, '(a)' ) ' Cell data: '
- ! call r8vec_print_some ( numCells, vol, 1, 10, &
- ! ' First 10 elements of cell volumes array:' )
+ call r8vec_print_some ( numCells, vol, 1, 10, &
+ ' First 10 elements of cell volumes array:' )
- ! call r8vec_print_some ( numCells, xc, 1, 10, &
- ! ' First 10 elements of cell x-centers array:' )
+ call r8vec_print_some ( numCells, xc, 1, 10, &
+ ' First 10 elements of cell x-centers array:' )
- ! call r8vec_print_some ( numCells, yc, 1, 10, &
- ! ' First 10 elements of cell y-centers array:' )
+ call r8vec_print_some ( numCells, yc, 1, 10, &
+ ' First 10 elements of cell y-centers array:' )
- ! call r8vec_print_some ( numCells, zc, 1, 10, &
- ! ' First 10 elements of cell z-centers array:' )
+ call r8vec_print_some ( numCells, zc, 1, 10, &
+ ' First 10 elements of cell z-centers array:' )
- ! write ( *, '(a)' ) ' '
- ! write ( *, '(a)' ) ' Face data: '
-
- ! call i4vec_print2 ( 10, owner, neighbour, ' First 10 lines of owner and neighbour arrays:' )
+ write ( *, '(a)' ) ' '
+ write ( *, '(a)' ) ' Face data: '
- ! call r8vec_print_some ( numFaces, arx, 1, 10, &
- ! ' First 10 elements of Arx array:' )
+ call i4vec_print2 ( 10, owner, neighbour, ' First 10 lines of owner and neighbour arrays:' )
- ! call r8vec_print_some ( numFaces, ary, 1, 10, &
- ! ' First 10 elements of Ary array:' )
+ call r8vec_print_some ( numFaces, arx, 1, 10, &
+ ' First 10 elements of Arx array:' )
- ! call r8vec_print_some ( numFaces, arz, 1, 10, &
- ! ' First 10 elements of Arz array:' )
+ call r8vec_print_some ( numFaces, ary, 1, 10, &
+ ' First 10 elements of Ary array:' )
- ! call r8vec_print_some ( numFaces, xf, 1, 10, &
- ! ' First 10 elements of xf array:' )
+ call r8vec_print_some ( numFaces, arz, 1, 10, &
+ ' First 10 elements of Arz array:' )
- ! call r8vec_print_some ( numFaces, yf, 1, 10, &
- ! ' First 10 elements of yf array:' )
+ call r8vec_print_some ( numFaces, xf, 1, 10, &
+ ' First 10 elements of xf array:' )
- ! call r8vec_print_some ( numFaces, zf, 1, 10, &
- ! ' First 10 elements of zf array:' )
+ call r8vec_print_some ( numFaces, yf, 1, 10, &
+ ' First 10 elements of yf array:' )
- ! call r8vec_print_some ( numInnerFaces, facint, 1, 10, &
- ! ' First 10 elements of interpolation factor (facint) array:' )
+ call r8vec_print_some ( numFaces, zf, 1, 10, &
+ ' First 10 elements of zf array:' )
- ! endif
+ call r8vec_print_some ( numInnerFaces, facint, 1, 10, &
+ ' First 10 elements of interpolation factor (facint) array:' )
+ endif
+ ! Thank you
+ deallocate (x)
+ deallocate (y)
+ deallocate (z)
!
! > CLOSE polyMesh format file: 'points', 'faces', 'owner', 'neighbour', 'boundary', 'process'.
!
diff --git a/src-par/global_sum_mpi.f90 b/src-par/global_sum_mpi.f90
index 37c6053..52e7821 100644
--- a/src-par/global_sum_mpi.f90
+++ b/src-par/global_sum_mpi.f90
@@ -17,18 +17,20 @@ subroutine global_sum(phi)
implicit none
- real(dp) :: phi
+ real(dp), intent(inout) :: phi
- real(dp) :: phisum
integer :: ierr
+ real(dp) :: phisum
+
+ CALL MPI_BARRIER(MPI_COMM_WORLD,IERR)
- call mpi_allreduce &
+ CALL MPI_ALLREDUCE &
(phi, & ! send buffer
phisum, & ! recv buffer
1, & ! length
- mpi_double_precision, & ! datatype
- mpi_sum, & ! operation
- mpi_comm_world, & ! communicator
+ MPI_DOUBLE_PRECISION, & ! datatype mpi_double_precision
+ MPI_SUM, & ! operation
+ MPI_COMM_WORLD, & ! communicator
ierr)
phi = phisum
diff --git a/src-par/gradients.f90 b/src-par/gradients.f90
index 3587880..46e391a 100644
--- a/src-par/gradients.f90
+++ b/src-par/gradients.f90
@@ -83,7 +83,7 @@ subroutine create_lsq_grad_matrix(phi,dPhidxi)
implicit none
real(dp), dimension(numTotal), intent(in) :: phi
- real(dp), dimension(3,numCells), intent(inout) :: dPhidxi
+ real(dp), dimension(3,numTotal), intent(inout) :: dPhidxi
call allocate_lsq_grad_matrix
@@ -134,14 +134,14 @@ subroutine grad_scalar_field(phi,dPhidxi)
call grad_lsq_qr(phi,dPhidxi,2,dmatqr)
elseif (lstsq_dm) then
-
+
call grad_lsq_dm(phi,dPhidxi,2,dmat)
- elseif ( (lstsq_qr .and. gauss) .or. (lstsq .and. gauss) ) then
-
+ elseif ( (lstsq_dm .and. gauss) .or. (lstsq .and. gauss) ) then
! Using the lstsq or lstsq_qr switch the Least-squares gradients are already calculated above
! Using these we perform more precise interpolation of our variable to faces and get
! conservative gradients using Gauss rule.
+ ! call grad_lsq_dm(phi,dPhidxi,2,dmat)
call grad_gauss_corrected(phi,dPhidxi(1,:),dPhidxi(2,:),dPhidxi(3,:))
else
@@ -215,7 +215,7 @@ subroutine grad_vector_field(U,V,W,dUdxi,dVdxi,dWdxi)
call grad_lsq_dm(U,dUdxi,2,dmat)
call grad_lsq_dm(V,dVdxi,2,dmat)
call grad_lsq_dm(W,dWdxi,2,dmat)
- elseif ( (lstsq_qr .and. gauss) .or. (lstsq .and. gauss) ) then
+ elseif ( gauss ) then
call grad_gauss_corrected(U,dUdxi(1,:),dUdxi(2,:),dUdxi(3,:))
call grad_gauss_corrected(V,dVdxi(1,:),dVdxi(2,:),dVdxi(3,:))
call grad_gauss_corrected(W,dWdxi(1,:),dWdxi(2,:),dWdxi(3,:))
@@ -225,6 +225,11 @@ subroutine grad_vector_field(U,V,W,dUdxi,dVdxi,dWdxi)
call grad_gauss(W,dWdxi(1,:),dWdxi(2,:),dWdxi(3,:))
endif
+ ! if ( (lstsq_qr .and. gauss) .or. (lstsq .and. gauss) ) then
+ ! call grad_gauss_corrected(U,dUdxi(1,:),dUdxi(2,:),dUdxi(3,:))
+ ! call grad_gauss_corrected(V,dVdxi(1,:),dVdxi(2,:),dVdxi(3,:))
+ ! call grad_gauss_corrected(W,dWdxi(1,:),dWdxi(2,:),dWdxi(3,:))
+ ! endif
! MPI exchange:
call exchange( dUdxi(1,:) )
@@ -514,12 +519,12 @@ subroutine slope_limiter_Barth_Jespersen(phi, dPhidxi)
implicit none
- ! Input
+ ! Input
real(dp),dimension(numTotal) :: phi
real(dp),dimension(3,numTotal) :: dPhidxi
- ! Locals
+ ! Locals
integer :: inp,ijp,ijn,k
integer :: istart,iend
real(dp) :: phi_p
@@ -835,13 +840,13 @@ subroutine grad_lsq(fi,dFidxi,istage,dmat)
integer, intent(in) :: istage
real(dp),dimension(numTotal), intent(in) :: fi
- real(dp),dimension(3,numCells), intent(inout) :: dFidxi
+ real(dp),dimension(3,numTotal), intent(inout) :: dFidxi
real(dp),dimension(9,numCells), intent(inout) :: dmat
!
! Locals
!
- integer :: i,ijp,ijn,ijnp,inp,ib,iface,ipro
+ integer :: i,ijp,ijn,inp,ib,iface
real(dp), dimension(numCells) :: b1,b2,b3
real(dp) :: Dx,Dy,Dz
@@ -886,12 +891,8 @@ subroutine grad_lsq(fi,dFidxi,istage,dmat)
! Boundary faces:
-
- iPro = 0
-
do ib=1,numBoundaries
-
if ( bctype(ib) == 'process') then
! Faces on processor boundaries
@@ -899,9 +900,7 @@ subroutine grad_lsq(fi,dFidxi,istage,dmat)
iface = startFace(ib) + i
ijp = owner(iface)
-
- iPro = iPro + 1
- ijn = numCells + iPro
+ ijn = iBndValueStart(ib) + i
Dx = xc(ijn)-xc(ijp)
Dy = yc(ijn)-yc(ijp)
@@ -1010,8 +1009,6 @@ subroutine grad_lsq(fi,dFidxi,istage,dmat)
! Boundary faces:
- iPro = 0
-
do ib=1,numBoundaries
@@ -1023,12 +1020,10 @@ subroutine grad_lsq(fi,dFidxi,istage,dmat)
iface = startFace(ib) + i
ijp = owner(iface)
ijn = iBndValueStart(ib) + i
- iPro = iPro + 1
- ijnp = numCells + iPro
- Dx = ( xc(ijnp)-xc(ijp) ) * ( Fi(ijn)-Fi(ijp) )
- Dy = ( yc(ijnp)-yc(ijp) ) * ( Fi(ijn)-Fi(ijp) )
- Dz = ( zc(ijnp)-zc(ijp) ) * ( Fi(ijn)-Fi(ijp) )
+ Dx = ( xc(ijn)-xc(ijp) ) * ( Fi(ijn)-Fi(ijp) )
+ Dy = ( yc(ijn)-yc(ijp) ) * ( Fi(ijn)-Fi(ijp) )
+ Dz = ( zc(ijn)-zc(ijp) ) * ( Fi(ijn)-Fi(ijp) )
b1(ijp) = b1(ijp) + Dx
b2(ijp) = b2(ijp) + Dy
@@ -1119,13 +1114,13 @@ subroutine grad_lsq_qr(fi,dfidxi,istage,d)
integer, intent(in) :: istage
real(dp), dimension(numTotal), intent(in) :: fi
- real(dp), dimension(n,numCells), intent(inout) :: dFidxi
+ real(dp), dimension(n,numTotal), intent(inout) :: dFidxi
real(dp), dimension(n,m,numCells), intent(inout) :: D
!
! Locals
!
- integer :: i,l,k,ijp,ijn,ib,inp,iface,ipro
+ integer :: i,l,k,ijp,ijn,ib,inp,iface
integer, dimension(numCells) :: neighbour_index
@@ -1178,8 +1173,6 @@ subroutine grad_lsq_qr(fi,dfidxi,istage,d)
! Boundary faces:
- iPro = 0
-
do ib=1,numBoundaries
@@ -1190,9 +1183,7 @@ subroutine grad_lsq_qr(fi,dfidxi,istage,d)
iface = startFace(ib) + i
ijp = owner(iface)
-
- iPro = iPro + 1
- ijn = numCells + iPro
+ ijn = iBndValueStart(ib) + i
neighbour_index(ijp) = neighbour_index(ijp) + 1
l = neighbour_index(ijp)
@@ -1403,13 +1394,13 @@ subroutine grad_lsq_dm(fi,dFidxi,istage,dmat)
integer, intent(in) :: istage
real(dp),dimension(numTotal), intent(in) :: fi
- real(dp),dimension(3,numCells), intent(inout) :: dFidxi
+ real(dp),dimension(3,numTotal), intent(inout) :: dFidxi
real(dp),dimension(9,numCells), intent(inout) :: dmat
!
! Locals
!
- integer :: i,ijp,ijn,ijnp,inp,ib,iface,ipro
+ integer :: i,ijp,ijn,inp,ib,iface
real(dp) :: w
real(dp) :: Dx,Dy,Dz
@@ -1462,8 +1453,6 @@ subroutine grad_lsq_dm(fi,dFidxi,istage,dmat)
! Boundary faces:
- iPro = 0
-
do ib=1,numBoundaries
@@ -1474,9 +1463,7 @@ subroutine grad_lsq_dm(fi,dFidxi,istage,dmat)
iface = startFace(ib) + i
ijp = owner(iface)
-
- iPro = iPro + 1
- ijn = numCells + iPro
+ ijn = iBndValueStart(ib) + i
w = 1./((xc(ijn)-xc(ijp))**2+(yc(ijn)-yc(ijp))**2+(zc(ijn)-zc(ijp))**2)
@@ -1591,8 +1578,6 @@ subroutine grad_lsq_dm(fi,dFidxi,istage,dmat)
! Boundary faces:
- iPro = 0
-
do ib=1,numBoundaries
@@ -1604,14 +1589,12 @@ subroutine grad_lsq_dm(fi,dFidxi,istage,dmat)
iface = startFace(ib) + i
ijp = owner(iface)
ijn = iBndValueStart(ib) + i
- iPro = iPro + 1
- ijnp = numCells + iPro
- w = 1./((xc(ijnp)-xc(ijp))**2+(yc(ijnp)-yc(ijp))**2+(zc(ijnp)-zc(ijp))**2)
+ w = 1./((xc(ijn)-xc(ijp))**2+(yc(ijn)-yc(ijp))**2+(zc(ijn)-zc(ijp))**2)
- Dx = w * ( xc(ijnp)-xc(ijp) ) * ( Fi(ijn)-Fi(ijp) )
- Dy = w * ( yc(ijnp)-yc(ijp) ) * ( Fi(ijn)-Fi(ijp) )
- Dz = w * ( zc(ijnp)-zc(ijp) ) * ( Fi(ijn)-Fi(ijp) )
+ Dx = w * ( xc(ijn)-xc(ijp) ) * ( Fi(ijn)-Fi(ijp) )
+ Dy = w * ( yc(ijn)-yc(ijp) ) * ( Fi(ijn)-Fi(ijp) )
+ Dz = w * ( zc(ijn)-zc(ijp) ) * ( Fi(ijn)-Fi(ijp) )
b1(ijp) = b1(ijp) + Dx
b2(ijp) = b2(ijp) + Dy
@@ -1693,12 +1676,12 @@ subroutine grad_gauss(u,dudx,dudy,dudz)
! Arguments
real(dp), dimension(numTotal), intent(in) :: u
- real(dp), dimension(numCells), intent(inout) :: dudx,dudy,dudz
+ real(dp), dimension(numTotal), intent(inout) :: dudx,dudy,dudz
! Local
- integer :: i,ijp,ijn,ijnp,ib,lc,iface,ipro
+ integer :: i,ijp,ijn,ib,lc,iface,ipro
real(dp) :: volr
- real(dp), dimension(numCells) :: dfxo,dfyo,dfzo
+ real(dp), dimension(numTotal) :: dfxo,dfyo,dfzo
! Initialize gradient
dfxo = 0.0_dp
@@ -1740,9 +1723,8 @@ subroutine grad_gauss(u,dudx,dudy,dudz)
ijp = owner(iface)
ijn = iBndValueStart(ib) + i
iPro = iPro + 1
- ijnp = numCells + iPro
- call gradcopar( ijp, ijn, ijnp, xf(iface), yf(iface), zf(iface), arx(iface), ary(iface), arz(iface), fpro(ipro), &
+ call gradco( ijp, ijn, xf(iface), yf(iface), zf(iface), arx(iface), ary(iface), arz(iface), fpro(ipro), &
u, dfxo, dfyo, dfzo, dudx, dudy, dudz )
enddo
@@ -1815,12 +1797,12 @@ subroutine grad_gauss_corrected(u,dudx,dudy,dudz)
! Arguments
real(dp), dimension(numTotal), intent(in) :: u
- real(dp), dimension(numCells), intent(inout) :: dudx,dudy,dudz
+ real(dp), dimension(numTotal), intent(inout) :: dudx,dudy,dudz
! Local
- integer :: i,ijp,ijn,ijnp,ib,iface,ipro
+ integer :: i,ijp,ijn,ib,if,ipro
real(dp) :: volr
- real(dp), dimension(numCells) :: dfxo,dfyo,dfzo
+ real(dp), dimension(numTotal) :: dfxo,dfyo,dfzo
! Initialize gradient with lsq gradient
dfxo = dudx
@@ -1854,13 +1836,12 @@ subroutine grad_gauss_corrected(u,dudx,dudy,dudz)
do i=1,nfaces(ib)
- iface = startFace(ib) + i
- ijp = owner(iface)
+ if = startFace(ib) + i
+ ijp = owner(if)
ijn = iBndValueStart(ib) + i
iPro = iPro + 1
- ijnp = numCells + iPro
- call gradcopar( ijp, ijn, ijnp, xf(iface), yf(iface), zf(iface), arx(iface), ary(iface), arz(iface), fpro(ipro), &
+ call gradco( ijp, ijn, xf(if), yf(if), zf(if), arx(if), ary(if), arz(if), fpro(ipro), &
u, dfxo, dfyo, dfzo, dudx, dudy, dudz )
enddo
@@ -1870,11 +1851,11 @@ subroutine grad_gauss_corrected(u,dudx,dudy,dudz)
do i=1,nfaces(ib)
- iface = startFace(ib) + i
- ijp = owner(iface)
+ if = startFace(ib) + i
+ ijp = owner(if)
ijn = iBndValueStart(ib) + i
- call gradbc(arx(iface), ary(iface), arz(iface), u(ijn), dudx(ijp), dudy(ijp), dudz(ijp))
+ call gradbc(arx(if), ary(if), arz(if), u(ijn), dudx(ijp), dudy(ijp), dudz(ijp))
enddo
@@ -1914,8 +1895,8 @@ subroutine gradco( ijp,ijn, &
real(dp), intent(in) :: sx,sy,sz
real(dp), intent(in) :: fif
real(dp), dimension(numTotal), intent(in) :: fi
- real(dp), dimension(numCells), intent(in) :: dfxo,dfyo,dfzo
- real(dp), dimension(numCells), intent(inout) :: dfx,dfy,dfz
+ real(dp), dimension(numTotal), intent(in) :: dfxo,dfyo,dfzo
+ real(dp), dimension(numTotal), intent(inout) :: dfx,dfy,dfz
real(dp) :: xi,yi,zi,dfxi,dfyi,dfzi
@@ -1959,71 +1940,6 @@ subroutine gradco( ijp,ijn, &
end subroutine
-subroutine gradcopar( ijp,ijn, ijnp, &
- xfc,yfc,zfc,sx,sy,sz,fif, &
- fi,dfxo,dfyo,dfzo,dfx,dfy,dfz )
-!=======================================================================
-! This routine calculates contribution to the gradient
-! vector of a scalar FI at the CV center, arising from
-! an inner cell face (cell-face value of FI times the
-! corresponding component of the surface vector).
-!=======================================================================
- use types
- use parameters
- use geometry
-
- implicit none
-
- integer, intent(in) :: ijp,ijn,ijnp
- real(dp), intent(in) :: xfc,yfc,zfc
- real(dp), intent(in) :: sx,sy,sz
- real(dp), intent(in) :: fif
- real(dp), dimension(numTotal), intent(in) :: fi
- real(dp), dimension(numCells), intent(in) :: dfxo,dfyo,dfzo
- real(dp), dimension(numCells), intent(inout) :: dfx,dfy,dfz
-
-
- real(dp) :: xi,yi,zi,dfxi,dfyi,dfzi
- real(dp) :: fie,dfxe,dfye,dfze
- real(dp) :: fxn,fxp
-
- !
- ! Coordinates of point on the line connecting center and neighbor,
- ! old gradient vector components interpolated for this location.
-
- fxn = fif
- fxp = 1.0d0-fxn
-
- xi = xc(ijp)*fxp+xc(ijnp)*fxn
- yi = yc(ijp)*fxp+yc(ijnp)*fxn
- zi = zc(ijp)*fxp+zc(ijnp)*fxn
-
- dfxi = dfxo(ijp)*fxp+dfxo(ijn)*fxn
- dfyi = dfyo(ijp)*fxp+dfyo(ijn)*fxn
- dfzi = dfzo(ijp)*fxp+dfzo(ijn)*fxn
-
- ! Value of the variable at cell-face center
- fie = fi(ijp)*fxp+fi(ijn)*fxn + dfxi*(xfc-xi)+dfyi*(yfc-yi)+dfzi*(zfc-zi)
-
-
- ! (interpolated mid-face value)x(area)
- dfxe = fie*sx
- dfye = fie*sy
- dfze = fie*sz
-
- ! Accumulate contribution at cell center and neighbour
- dfx(ijp) = dfx(ijp)+dfxe
- dfy(ijp) = dfy(ijp)+dfye
- dfz(ijp) = dfz(ijp)+dfze
-
- dfx(ijn) = dfx(ijn)-dfxe
- dfy(ijn) = dfy(ijn)-dfye
- dfz(ijn) = dfz(ijn)-dfze
-
-
-end subroutine
-
-
subroutine gradbc(sx,sy,sz,fi,dfx,dfy,dfz)
!=======================================================================
! This routine calculates the contribution of a
diff --git a/src-par/iccg.f90 b/src-par/iccg.f90
index 6050725..46089ef 100644
--- a/src-par/iccg.f90
+++ b/src-par/iccg.f90
@@ -97,29 +97,30 @@ subroutine iccg(fi,ifi)
end do
enddo
- call exchange(d)
- ! Contribution from cells at processor boundary.
- ipro = 0
- do ib=1,numBoundaries
+ ! ! Contribution from cells at processor boundary.
+ ! ipro = 0
+ ! call exchange(d)
+
+ ! do ib=1,numBoundaries
- if ( bctype(ib) == 'process' ) then
+ ! if ( bctype(ib) == 'process' ) then
- do i=1,nfaces(ib)
+ ! do i=1,nfaces(ib)
- iface = startFace(ib) + i
- k = owner(iface)
- ijn = iBndValueStart(ib) + i
- ipro = ipro + 1
+ ! iface = startFace(ib) + i
+ ! k = owner(iface)
+ ! ijn = iBndValueStart(ib) + i
+ ! ipro = ipro + 1
- d( k ) = d( k ) - apr( ipro )*d( ijn )*apr( ipro )
+ ! d( k ) = d( k ) - apr( ipro )*d( ijn )*apr( ipro )
- enddo
+ ! enddo
- endif
+ ! endif
- enddo
+ ! enddo
do i=1,numCells
d(i) = 1.0_dp / (d(i) + small)
@@ -174,7 +175,7 @@ subroutine iccg(fi,ifi)
!
pk(1:numCells) = zk + bet*pk(1:numCells)
- call exchange( pk )
+
!
! Calculate scalar product (pk.a pk) and alpha (overwrite zk)
@@ -188,26 +189,28 @@ subroutine iccg(fi,ifi)
enddo
enddo
- ! Processor boundaries
- ipro = 0
+ ! ! Processor boundaries
+ ! ipro = 0
- do ib=1,numBoundaries
+ ! call exchange( pk )
- if ( bctype(ib) == 'process' ) then
+ ! do ib=1,numBoundaries
- do i=1,nfaces(ib)
- iface = startFace(ib) + i
- k = owner(iface)
- ijn = iBndValueStart(ib) + i
- ipro = ipro + 1
+ ! if ( bctype(ib) == 'process' ) then
- zk( k ) = zk( k ) + apr( ipro ) * pk( ijn )
+ ! do i=1,nfaces(ib)
+ ! iface = startFace(ib) + i
+ ! k = owner(iface)
+ ! ijn = iBndValueStart(ib) + i
+ ! ipro = ipro + 1
- enddo
+ ! zk( k ) = zk( k ) + apr( ipro ) * pk( ijn )
- endif
+ ! enddo
- enddo
+ ! endif
+
+ ! enddo
! Inner product
pkapk=sum(pk*zk)
@@ -223,7 +226,7 @@ subroutine iccg(fi,ifi)
res = res - alf*zk
- ! L^1-norm of residual
+ ! L1-norm of residual
resl = sum(abs(res))
call global_sum(resl)
diff --git a/src-par/init.f90 b/src-par/init.f90
index 2425220..f896b20 100644
--- a/src-par/init.f90
+++ b/src-par/init.f90
@@ -30,7 +30,7 @@ subroutine init
!
! Local variables
!
- character( len = 5) :: nproc_char
+ ! character(len = 5) :: nproc_char
integer :: i, ijp, ijn, ijb, ib, iface, ipro
! integer :: output_unit
integer :: nsw_backup
@@ -42,7 +42,7 @@ subroutine init
!
! nproc_char <- myid zapisan levo u vidu stringa.
- call i4_to_s_left ( myid, nproc_char )
+ ! call i4_to_s_left ( myid, nproc_char )
!
! Various initialisations
@@ -108,35 +108,29 @@ subroutine init
call initialize_vector_field(u,v,w,dUdxi,'U')
- ! Initialize previous time step value to current value.
- uo = u
- vo = v
- wo = w
-
- uoo = u
- voo = v
- woo = w
-
- if (bdf3) then
- uooo = u
- vooo = v
- wooo = w
- endif
+ call exchange( u )
+ call exchange( v )
+ call exchange( w )
! Field initialisation scalars
!
! > TE Turbulent kinetic energy.
!
- call initialize_scalar_field(te,dTEdxi,'k')
-
+ if (lcal(ite)) then
+ call initialize_scalar_field(te,dTEdxi,'k')
+ call exchange( te )
+ endif
!
! > ED Specific turbulent kinetic energy dissipation rate, also turbulence frequency - omega
!
- if(solveOmega) then
- call initialize_scalar_field(ed,dEDdxi,'omega')
- else
- call initialize_scalar_field(ed,dEDdxi,'epsilon')
+ if (lcal(ied)) then
+ if(solveOmega) then
+ call initialize_scalar_field(ed,dEDdxi,'omega')
+ else
+ call initialize_scalar_field(ed,dEDdxi,'epsilon')
+ endif
+ call exchange( ed )
endif
@@ -157,31 +151,6 @@ subroutine init
! Concentration
if(lcal(icon)) con=conin
- ! ! Reynolds stress tensor components
- ! if (lturb) then
- ! uu = 0.0_dp
- ! vv = 0.0_dp
- ! ww = 0.0_dp
- ! uv = 0.0_dp
- ! uw = 0.0_dp
- ! vw = 0.0_dp
- ! endif
-
- ! ! Turbulent heat fluxes
- ! if(lcal(ien).and.lbuoy) then
- ! utt = 0.0_dp
- ! vtt = 0.0_dp
- ! wtt = 0.0_dp
- ! endif
-
- ! ! Reynolds stress anisotropy
- ! if(lturb.and.lasm) bij = 0.0_dp
-
- ! ! Pressure and pressure correction
- ! p = 0.0_dp
- ! pp = p
-
-
!
! > Initialize mass flow
!
@@ -202,14 +171,9 @@ subroutine init
enddo
-
!
! Mass flow at boundaries of inner domain and buffer cells
!
- call exchange( u )
- call exchange( v )
- call exchange( w )
-
! Initialize mass flux at faces on process boundary
@@ -239,7 +203,6 @@ subroutine init
endif
enddo
-
!
! Read Restart File And Set Field Values
!
@@ -253,9 +216,7 @@ subroutine init
call create_lsq_grad_matrix(U,dUdxi)
endif
- call grad(U,dUdxi)
- call grad(V,dVdxi)
- call grad(W,dWdxi)
+
!
! Distance to the nearest wall (needed for some turbulence models).
@@ -284,12 +245,12 @@ subroutine init
nsw_backup = nsw(ip)
sor(ip) = 1e-10
- nsw(ip) = 500
+ nsw(ip) = 1000
! Solve system
! call jacobi(p,ip)
- ! call dpcg(p,ip)
- call iccg(p,ip)
+ call dpcg(p,ip)
+ ! call iccg(p,ip)
! call bicgstab(p,ip)
! call solve_csr(numCells,nnz,ioffset,ja,a,su,p)
@@ -297,25 +258,17 @@ subroutine init
call exchange ( p )
- ipro = 0
-
do ib=1,numBoundaries
-
- if ( bctype(ib) /= 'wall' .and. bctype(ib) /= 'proces' ) then
- ! All other boundary faces besides wall which has to be zero, and process, which is set above
-
+ if ( bctype(ib) .ne. 'wall' .and. bctype(ib) .ne. 'process' ) then
+ ! All other boundary faces besides wall which has to be zero, and process, which is set trough exchange
do i=1,nfaces(ib)
-
iface = startFace(ib) + i
ijp = owner(iface)
ijb = iBndValueStart(ib) + i
-
p(ijb) = p(ijp)
-
enddo
-
endif
- enddo
+ enddo
sor(ip) = sor_backup
nsw(ip) = nsw_backup
@@ -327,17 +280,13 @@ subroutine init
wallDistance = -sqrt( dPdxi(1,1:numCells)**2+dPdxi(2,1:numCells)**2+dPdxi(3,1:numCells)**2 ) + &
sqrt( dPdxi(1,1:numCells)**2+dPdxi(2,1:numCells)**2+dPdxi(3,1:numCells)**2 + 2*p(1:numCells) )
- ! do i = 1,numCells
- ! write(*,*) wallDistance(i)
- ! enddo
! Clear arrays
su = 0.0_dp
sv = 0.0_dp
- p = 0.0_dp
+ p = pp
dPdxi = 0.0_dp
-
! ! Write wall distance field.
! !+-----------------------------------------------------------------------------+
! call get_unit( output_unit )
@@ -356,4 +305,5 @@ subroutine init
! !+-----------------------------------------------------------------------------+
+
end subroutine
diff --git a/src-par/interpolation.f90 b/src-par/interpolation.f90
index 92fe4a8..89438a5 100644
--- a/src-par/interpolation.f90
+++ b/src-par/interpolation.f90
@@ -163,38 +163,12 @@ function face_value_central(inp,inn, xf, yf, zf, fi, gradfi) result(face_value)
real(dp), dimension(3,numPCells) :: gradfi
! Locals
- real(dp) :: phi_p, phi_n
- real(dp) :: xcp,ycp,zcp
- real(dp) :: xcn,ycn,zcn
- real(dp) :: gradfi_p_x,gradfi_p_y,gradfi_p_z
- real(dp) :: gradfi_n_x,gradfi_n_y,gradfi_n_z
real(dp) :: gradfidr
-
- ! Values at cell center's of neighbouring cells:
- phi_p = fi(inp)
-
- phi_n = fi(inn)
-
- xcp = xc(inp)
- ycp = yc(inp)
- zcp = zc(inp)
-
- xcn = xc(inn)
- ycn = yc(inn)
- zcn = zc(inn)
-
- gradfi_p_x = gradfi(1,inp)
- gradfi_p_y = gradfi(2,inp)
- gradfi_p_z = gradfi(3,inp)
-
- gradfi_n_x = gradfi(1,inn)
- gradfi_n_y = gradfi(2,inn)
- gradfi_n_z = gradfi(3,inn)
- gradfidr=gradfi_p_x*(xf-xcp)+gradfi_p_y*(yf-ycp)+gradfi_p_z*(zf-zcp) &
- +gradfi_n_x*(xf-xcn)+gradfi_n_y*(yf-ycn)+gradfi_n_z*(zf-zcn)
+ gradfidr=gradfi(1,inp)*(xf-xc(inp))+gradfi(2,inp)*(yf-yc(inp))+gradfi(3,inp)*(zf-zc(inp)) &
+ +gradfi(1,inn)*(xf-xc(inn))+gradfi(2,inn)*(yf-yc(inn))+gradfi(3,inn)*(zf-zc(inn))
- face_value = 0.5_dp*( phi_p + phi_n + gradfidr)
+ face_value = 0.5_dp*( fi(inp) + fi(inn) + gradfidr)
end function
diff --git a/src-par/k_epsilon_rng.f90 b/src-par/k_epsilon_rng.f90
index 2e6e30a..b6e2831 100644
--- a/src-par/k_epsilon_rng.f90
+++ b/src-par/k_epsilon_rng.f90
@@ -193,7 +193,7 @@ subroutine calcsc(Fi,dFidxi,ifi)
!=====================================
! UNSTEADY TERM
!=====================================
- if( bdf ) then
+ if( bdf .or. cn ) then
apotime = den(inp)*vol(inp)/timestep
su(inp) = su(inp) + apotime*teo(inp)
sp(inp) = sp(inp) + apotime
@@ -271,7 +271,7 @@ subroutine calcsc(Fi,dFidxi,ifi)
!=====================================
! UNSTEADY TERM
!=====================================
- if( bdf ) then
+ if( bdf .or. cn ) then
apotime = den(inp)*vol(inp)/timestep
su(inp) = su(inp) + apotime*edo(inp)
sp(inp) = sp(inp) + apotime
diff --git a/src-par/k_epsilon_std.f90 b/src-par/k_epsilon_std.f90
index 8e24b88..73f3717 100644
--- a/src-par/k_epsilon_std.f90
+++ b/src-par/k_epsilon_std.f90
@@ -66,11 +66,35 @@ subroutine correct_turbulence_inlet_k_epsilon_std()
!
!***********************************************************************
!
+ use types
+ use parameters
+ use geometry, only:numBoundaries,nfaces,iBndValueStart
+ use variables
+
implicit none
!
!***********************************************************************
!
- call modify_mu_eff_inlet()
+ integer :: i,ib,ijb
+
+ !
+ ! Boundary faces
+ !
+ do ib=1,numBoundaries
+
+ if ( bctype(ib) == 'inlet' ) then
+
+ do i=1,nfaces(ib)
+
+ ijb = iBndValueStart(ib) + i
+
+ Vis(ijb) = viscos+den(ijb)*te(ijb)**2*cmu/(ed(ijb)+small)
+
+ end do
+
+ endif
+
+ enddo
end subroutine
@@ -216,7 +240,7 @@ subroutine calcsc(Fi,dFidxi,ifi)
!=====================================
! UNSTEADY TERM
!=====================================
- if( bdf ) then
+ if( bdf .or. cn ) then
apotime = den(inp)*vol(inp)/timestep
su(inp) = su(inp) + apotime*teo(inp)
sp(inp) = sp(inp) + apotime
@@ -285,7 +309,7 @@ subroutine calcsc(Fi,dFidxi,ifi)
!=====================================
!.....UNSTEADY TERM
!=====================================
- if( bdf ) then
+ if( bdf .or. cn ) then
apotime = den(inp)*vol(inp)/timestep
su(inp) = su(inp) + apotime*edo(inp)
sp(inp) = sp(inp) + apotime
@@ -834,46 +858,4 @@ subroutine modify_mu_eff()
end subroutine modify_mu_eff
-
-!***********************************************************************
-!
-subroutine modify_mu_eff_inlet()
-!
-! Update turbulent and effective viscosity at inlet.
-!
-!***********************************************************************
-!
- use types
- use parameters
- use geometry, only:numBoundaries,nfaces,iBndValueStart
- use variables
-
- implicit none
-!
-!***********************************************************************
-!
- integer :: i,ib,ijb
-
- !
- ! Boundary faces
- !
- do ib=1,numBoundaries
-
- if ( bctype(ib) == 'inlet' ) then
-
- do i=1,nfaces(ib)
-
- ijb = iBndValueStart(ib) + i
-
- Vis(ijb) = viscos+den(ijb)*te(ijb)**2*cmu/(ed(ijb)+small)
-
- end do
-
- endif
-
- enddo
-
-end subroutine modify_mu_eff_inlet
-
-
end module k_epsilon_std
\ No newline at end of file
diff --git a/src-par/k_epsilon_zeta_f.f90 b/src-par/k_epsilon_zeta_f.f90
index e13765d..ad85d9b 100644
--- a/src-par/k_epsilon_zeta_f.f90
+++ b/src-par/k_epsilon_zeta_f.f90
@@ -281,7 +281,7 @@ subroutine calcsc(Fi,dFidxi,ifi)
!=====================================
! UNSTEADY TERM
!=====================================
- if( bdf ) then
+ if( bdf .or. cn ) then
apotime = den(inp)*vol(inp)/timestep
su(inp) = su(inp) + apotime*teo(inp)
sp(inp) = sp(inp) + apotime
@@ -350,7 +350,7 @@ subroutine calcsc(Fi,dFidxi,ifi)
!=====================================
! UNSTEADY TERM
!=====================================
- if( bdf ) then
+ if( bdf .or. cn ) then
apotime = den(inp)*vol(inp)/timestep
su(inp) = su(inp) + apotime*edo(inp)
sp(inp) = sp(inp) + apotime
diff --git a/src-par/k_eqn_eddy.f90 b/src-par/k_eqn_eddy.f90
index 1e2a107..65fc07d 100644
--- a/src-par/k_eqn_eddy.f90
+++ b/src-par/k_eqn_eddy.f90
@@ -51,11 +51,43 @@ subroutine correct_turbulence_k_eqn_eddy()
subroutine correct_turbulence_inlet_k_eqn_eddy()
!
-! Update effective viscosity at inlet
+! Update turbulent and effective viscosity at inlet.
!
+ use types
+ use parameters
+ use geometry, only:numBoundaries,nfaces,startFace,iBndValueStart,arx,ary,arz
+ use variables
+
implicit none
- call modify_mu_eff_inlet()
+ integer :: i,ib,ijb,iface
+ real(dp) :: are, Delta
+
+ !
+ ! Boundary faces
+ !
+ do ib=1,numBoundaries
+
+ if ( bctype(ib) == 'inlet' ) then
+
+ do i=1,nfaces(ib)
+
+ iface = startFace(ib) + i
+ ijb = iBndValueStart(ib) + i
+
+ are = sqrt( arx(iface)**2 + ary(iface)**2 + arz(iface)**2 )
+ Delta = sqrt(are)
+
+ ! Update effective viscosity:
+ ! \mu_{eff}=\mu+\mu_t; \mu_t = C_k * k^{0.5} * Delta
+
+ vis(ijb) = viscos + den(ijb)*ck*sqrt(te(ijb))*delta
+
+ end do
+
+ endif
+
+ enddo
end subroutine
@@ -200,14 +232,16 @@ subroutine calcsc(Fi,dFidxi,ifi)
!=====================================
! UNSTEADY TERM
!=====================================
- if( bdf ) then
- apotime = den(inp)*vol(inp)/timestep
- su(inp) = su(inp) + apotime*teo(inp)
- sp(inp) = sp(inp) + apotime
- elseif( bdf2 ) then
- apotime=den(inp)*vol(inp)/timestep
- su(inp) = su(inp) + apotime*( 2*teo(inp) - 0.5_dp*teoo(inp) )
- sp(inp) = sp(inp) + 1.5_dp*apotime
+ if (ltransient) then
+ if( bdf .or. cn ) then
+ apotime = den(inp)*vol(inp)/timestep
+ su(inp) = su(inp) + apotime*teo(inp)
+ sp(inp) = sp(inp) + apotime
+ elseif( bdf2 ) then
+ apotime=den(inp)*vol(inp)/timestep
+ su(inp) = su(inp) + apotime*( 2*teo(inp) - 0.5_dp*teoo(inp) )
+ sp(inp) = sp(inp) + 1.5_dp*apotime
+ endif
endif
@@ -348,8 +382,9 @@ subroutine calcsc(Fi,dFidxi,ifi)
! > Wall boundary conditions for turbulence kinetic energy eq.
!
- viss=viscos
- if(ypl(iWall).gt.ctrans) viss=visw(iWall)
+ ! viss=viscos
+ ! if(ypl(iWall).gt.ctrans) viss=visw(iWall)
+ viss = max(viscos,visw(iWall))
! Face area
are = sqrt(arx(iface)**2+ary(iface)**2+arz(iface)**2)
@@ -536,19 +571,15 @@ subroutine modify_mu_eff()
third = 1./3.0_dp
- !
- ! Loop trough cells
- !
-
do inp=1,numCells
- ! Store old value
- visold=vis(inp)
- delta = vol(inp)**third
- ! Update effective viscosity:
- ! \mu_{eff}=\mu+\mu_t; \mu_t = C_k * k^{0.5} * Delta
- vis(inp)=viscos + den(inp)*ck*sqrt(te(inp))*delta
- ! Underelaxation
- vis(inp)=urf(ivis)*vis(inp)+(1.0_dp-urf(ivis))*visold
+ ! Store old value
+ visold=vis(inp)
+ delta = vol(inp)**third
+ ! Update effective viscosity:
+ ! \mu_{eff}=\mu+\mu_t; \mu_t = C_k * k^{0.5} * Delta
+ vis(inp)=viscos + den(inp)*ck*sqrt(te(inp))*delta
+ ! Underelaxation
+ vis(inp)=urf(ivis)*vis(inp)+(1.0_dp-urf(ivis))*visold
enddo
!
@@ -664,47 +695,6 @@ subroutine modify_mu_eff()
end subroutine
-subroutine modify_mu_eff_inlet()
-!
-! Update turbulent and effective viscosity at inlet.
-!
- use types
- use parameters
- use geometry, only:numBoundaries,nfaces,startFace,iBndValueStart,arx,ary,arz
- use variables
-
- implicit none
-
- integer :: i,ib,ijb,iface
- real(dp) :: are, Delta
-
- !
- ! Boundary faces
- !
- do ib=1,numBoundaries
-
- if ( bctype(ib) == 'inlet' ) then
-
- do i=1,nfaces(ib)
-
- iface = startFace(ib) + i
- ijb = iBndValueStart(ib) + i
-
- are = sqrt( arx(iface)**2 + ary(iface)**2 + arz(iface)**2 )
- Delta = sqrt(are)
-
- ! Update effective viscosity:
- ! \mu_{eff}=\mu+\mu_t; \mu_t = C_k * k^{0.5} * Delta
-
- vis(ijb) = viscos + den(ijb)*ck*sqrt(te(ijb))*delta
-
- end do
-
- endif
-
- enddo
-
-end subroutine
end module k_eqn_eddy
\ No newline at end of file
diff --git a/src-par/k_omega_sst.f90 b/src-par/k_omega_sst.f90
index 0cb8b79..076f4d7 100644
--- a/src-par/k_omega_sst.f90
+++ b/src-par/k_omega_sst.f90
@@ -81,11 +81,22 @@ subroutine correct_turbulence_k_omega_sst()
subroutine correct_turbulence_inlet_k_omega_sst()
!
-! Update effective viscosity at inlet
+! Update turbulent and effective viscosity at inlet.
!
+
implicit none
- call modify_mu_eff_inlet()
+ integer :: i,ib,ijb
+
+ ! Set values at inlet faces
+ do ib=1,numBoundaries
+ if ( bctype(ib) == 'inlet' ) then
+ do i=1,nfaces(ib)
+ ijb = iBndValueStart(ib) + i
+ Vis(ijb) = viscos+den(ijb)*te(ijb)/(ed(ijb)+small)
+ end do
+ endif
+ enddo
end subroutine
@@ -113,15 +124,15 @@ subroutine calcsc(Fi,dFidxi,ifi)
! Local variables
!
integer :: i, k, inp, ijp, ijn, ijb, ib, iface, iwall, ipro
- real(dp) :: gam, prtr, prtr_ijp, prtr_ijn, apotime, const, urfrs, urfms
+ real(dp) :: gam, prtr, prtr_ijp, apotime, const, urfrs, urfms
real(dp) :: utp, vtp, wtp, utn, vtn, wtn
real(dp) :: genp, genn
real(dp) :: uttbuoy, vttbuoy, wttbuoy
real(dp) :: cap, can, suadd
- ! real(dp) :: magStrainSq
+ real(dp) :: magStrainSq
real(dp) :: off_diagonal_terms
real(dp) :: are,nxf,nyf,nzf,vnp,xtp,ytp,ztp,ut2
- real(dp) :: dudx,dudy,dudz,dvdx,dvdy,dvdz,dwdx,dwdy,dwdz
+ ! real(dp) :: dudx,dudy,dudz,dvdx,dvdy,dvdz,dwdx,dwdy,dwdz
real(dp) :: viss
real(dp) :: fimax,fimin
real(dp) :: wldist,domegapl,ksi,tmp
@@ -158,26 +169,26 @@ subroutine calcsc(Fi,dFidxi,ifi)
do inp=1,numCells
- dudx = dudxi(1,inp)
- dudy = dudxi(2,inp)
- dudz = dudxi(3,inp)
+ ! dudx = dudxi(1,inp)
+ ! dudy = dudxi(2,inp)
+ ! dudz = dudxi(3,inp)
- dvdx = dvdxi(1,inp)
- dvdy = dvdxi(2,inp)
- dvdz = dvdxi(3,inp)
+ ! dvdx = dvdxi(1,inp)
+ ! dvdy = dvdxi(2,inp)
+ ! dvdz = dvdxi(3,inp)
- dwdx = dwdxi(1,inp)
- dwdy = dwdxi(2,inp)
- dwdz = dwdxi(3,inp)
+ ! dwdx = dwdxi(1,inp)
+ ! dwdy = dwdxi(2,inp)
+ ! dwdz = dwdxi(3,inp)
- ! Minus here in fron because UU,UV,... calculated in calcstress hold -tau_ij
- ! So the exact production is calculated as tau_ij*dui/dxj
- gen(inp) = -den(inp)*( uu(inp)*dudx+uv(inp)*(dudy+dvdx)+ &
- uw(inp)*(dudz+dwdx)+vv(inp)*dvdy+ &
- vw(inp)*(dvdz+dwdy)+ww(inp)*dwdz )
+ ! ! Minus here in fron because UU,UV,... calculated in calcstress hold -tau_ij
+ ! ! So the exact production is calculated as tau_ij*dui/dxj
+ ! gen(inp) = -den(inp)*( uu(inp)*dudx+uv(inp)*(dudy+dvdx)+ &
+ ! uw(inp)*(dudz+dwdx)+vv(inp)*dvdy+ &
+ ! vw(inp)*(dvdz+dwdy)+ww(inp)*dwdz )
- ! magStrainSq=magStrain(inp)*magStrain(inp)
- ! gen(inp)=abs(vis(inp)-viscos)*magStrainSq
+ magStrainSq=magStrain(inp)*magStrain(inp)
+ gen(inp)=abs(vis(inp)-viscos)*magStrainSq
! PRODUCTION LIMITER FOR SST AND SAS MODELS:
! 10*bettainf=10*0.09=0.9 -> see below TODO BETTAST for Low-Re
@@ -271,7 +282,7 @@ subroutine calcsc(Fi,dFidxi,ifi)
!=====================================
! UNSTEADY TERM
!=====================================
- if( bdf ) then
+ if( bdf .or. cn ) then
apotime = den(inp)*vol(inp)/timestep
su(inp) = su(inp) + apotime*teo(inp)
sp(inp) = sp(inp) + apotime
@@ -309,9 +320,13 @@ subroutine calcsc(Fi,dFidxi,ifi)
domegapl=max(2*den(inp)/(SIGMOM2*ed(inp)) * (dtedx*deddx+dtedy*deddy+dtedz*deddz),1e-10)
! Find ksi
- ksi=min(max(sqrt(te(inp))/(BETTAST*wldist*ed(inp)), &
- (500.0_dp*viscos/den(inp))/(wldist**2*ed(inp))), &
- 4.0_dp*den(inp)*te(inp)/(SIGMOM2*domegapl*wldist**2))
+ ksi=min( max( &
+ sqrt(te(inp))/(BETTAST*wldist*ed(inp)+small), &
+ 500.0_dp*viscos/den(inp)/(wldist**2*ed(inp)+small) &
+ ), &
+ 4.0_dp*den(inp)*te(inp)/(SIGMOM2*domegapl*wldist**2) &
+ )
+
! Find the SST model blending function f_sst:
fsst(inp) = tanh(ksi**4)
@@ -368,7 +383,6 @@ subroutine calcsc(Fi,dFidxi,ifi)
su(inp)=su(inp)+domega*vol(inp)
-
! Destruction of dissipation.
! Destruction coefficient beta_sst
@@ -416,14 +430,16 @@ subroutine calcsc(Fi,dFidxi,ifi)
!=====================================
! UNSTEADY TERM
!=====================================
- if( bdf ) then
- apotime = den(inp)*vol(inp)/timestep
- su(inp) = su(inp) + apotime*edo(inp)
- sp(inp) = sp(inp) + apotime
- elseif( bdf2 ) then
- apotime=den(inp)*vol(inp)/timestep
- su(inp) = su(inp) + apotime*( 2*edo(inp) - 0.5_dp*edoo(inp) )
- sp(inp) = sp(inp) + 1.5_dp*apotime
+ if (ltransient) then
+ if( bdf ) then
+ apotime = den(inp)*vol(inp)/timestep
+ su(inp) = su(inp) + apotime*edo(inp)
+ sp(inp) = sp(inp) + apotime
+ elseif( bdf2 ) then
+ apotime=den(inp)*vol(inp)/timestep
+ su(inp) = su(inp) + apotime*( 2*edo(inp) - 0.5_dp*edoo(inp) )
+ sp(inp) = sp(inp) + 1.5_dp*apotime
+ endif
endif
! End of Epsilon volume source terms
@@ -443,16 +459,16 @@ subroutine calcsc(Fi,dFidxi,ifi)
! In SST model the Effective diffusivity is a field variable:
if(ifi.eq.ite) then
prtr_ijp = fsst(ijp)*(1./sigmk1) + (1.0_dp-fsst(ijp))*(1./sigmk2)
- prtr_ijn = fsst(ijn)*(1./sigmk1) + (1.0_dp-fsst(ijn))*(1./sigmk2)
+ ! prtr_ijn = fsst(ijn)*(1./sigmk1) + (1.0_dp-fsst(ijn))*(1./sigmk2)
else
prtr_ijp = fsst(ijp)*(1./sigmom1) + (1.0_dp-fsst(ijp))*(1./sigmom2)
- prtr_ijn = fsst(ijn)*(1./sigmom1) + (1.0_dp-fsst(ijn))*(1./sigmom2)
+ ! prtr_ijn = fsst(ijn)*(1./sigmom1) + (1.0_dp-fsst(ijn))*(1./sigmom2)
endif
call facefluxsc( ijp, ijn, &
xf(i), yf(i), zf(i), arx(i), ary(i), arz(i), &
flmass(i), facint(i), gam, &
- fi, dFidxi, prtr_ijp, prtr_ijn, cap, can, suadd )
+ fi, dFidxi, prtr_ijp, cap, can, suadd )
! > Off-diagonal elements:
@@ -591,9 +607,10 @@ subroutine calcsc(Fi,dFidxi,ifi)
! > Wall boundary conditions for turbulence kinetic energy eq.
!
- viss=viscos
- if(ypl(iWall).gt.ctrans) viss=visw(iWall)
-
+ ! viss=viscos
+ ! if(ypl(iWall).gt.ctrans) viss=visw(iWall)
+ viss = max(viscos,visw(iWall))
+
! Face area
are = sqrt(arx(iface)**2+ary(iface)**2+arz(iface)**2)
@@ -626,8 +643,10 @@ subroutine calcsc(Fi,dFidxi,ifi)
! Production of TKE in wall adjecent cell
! First substract the standard production from source term
su(ijp)=su(ijp)-gen(ijp)*vol(ijp)
+
! Calculate production for wall adjecent cell
gen(ijp)=abs(tau(iWall))*cmu25*sqrt(te(ijp))/(dnw(iWall)*cappa)
+
! Add this production to source vector
su(ijp)=su(ijp)+gen(ijp)*vol(ijp)
@@ -847,8 +866,11 @@ subroutine modify_mu_eff()
real(dp) :: visold
real(dp) :: nxf,nyf,nzf,are
real(dp) :: Vnp,Vtp,xtp,ytp,ztp
- real(dp) :: Ut2,Utau,viscw
+ ! real(dp) :: Ut2
+ real(dp) :: Utau,viscw
real(dp) :: wldist,etha,f2_sst,alphast
+ ! real(dp) :: Utauvis,Utaulog,Upl
+ real(dp) :: Uplblend
!
! Loop trough cells
@@ -856,36 +878,36 @@ subroutine modify_mu_eff()
do inp=1,numCells
- ! Store old value
- visold=vis(inp)
+ ! Store old value
+ visold=vis(inp)
- ! Update effective viscosity:
+ ! Update effective viscosity:
- ! Wall distance
- wldist = walldistance(inp)
+ ! Wall distance
+ wldist = walldistance(inp)
- ! find etha:
- etha=max(2*sqrt(te(inp))/(bettast*wldist*ed(inp)), &
- (500*viscos/den(inp))/(wldist**2*ed(inp)))
+ ! find etha:
+ etha=max(2*sqrt(te(inp))/(bettast*wldist*ed(inp)), &
+ (500*viscos/den(inp))/(wldist**2*ed(inp)))
- ! find f2:
- f2_sst = tanh(etha*etha)
+ ! find f2:
+ f2_sst = tanh(etha*etha)
- vis(inp)=viscos+den(inp)*a1*te(inp)/(max(a1*ed(inp), magStrain(inp)*f2_sst))
+ vis(inp)=viscos+den(inp)*a1*te(inp)/(max(a1*ed(inp), magStrain(inp)*f2_sst))
- ! Low-re version..........................................................
- if (LowRe) then !
- ! Let's find alpha* !
- alphast=(0.024_dp+(densit*te(inp))/(6*viscos*ed(inp))) & !
- /(1.0_dp+(densit*te(inp))/(6*viscos*ed(inp))) !
- vis(inp)=viscos+den(inp)*te(inp)/(ed(inp)+small) & !
- *1.0_dp/max(1.0_dp/alphast, magStrain(inp)*f2_sst/(a1*ed(inp))) !
- ! End of low-re version..................................................!
- end if
+ ! Low-re version..........................................................
+ if (LowRe) then !
+ ! Let's find alpha* !
+ alphast=(0.024_dp+(densit*te(inp))/(6*viscos*ed(inp))) & !
+ /(1.0_dp+(densit*te(inp))/(6*viscos*ed(inp))) !
+ vis(inp)=viscos+den(inp)*te(inp)/(ed(inp)+small) & !
+ *1.0_dp/max(1.0_dp/alphast, magStrain(inp)*f2_sst/(a1*ed(inp))) !
+ ! End of low-re version..................................................!
+ end if
- ! Underelaxation
- vis(inp)=urf(ivis)*vis(inp)+(1.0_dp-urf(ivis))*visold
+ ! Underelaxation
+ vis(inp)=urf(ivis)*vis(inp)+(1.0_dp-urf(ivis))*visold
enddo
@@ -966,27 +988,50 @@ subroutine modify_mu_eff()
! Its magnitude
Vtp = sqrt(xtp*xtp+ytp*ytp+ztp*ztp)
- ! Tangent direction
- xtp = xtp/vtp
- ytp = ytp/vtp
- ztp = ztp/vtp
+ ! ! Tangent direction
+ ! xtp = xtp/vtp
+ ! ytp = ytp/vtp
+ ! ztp = ztp/vtp
- ! projektovanje razlike brzina na pravac tangencijalne brzine u cell centru ijp
- Ut2 = abs( (U(ijb)-U(ijp))*xtp + (V(ijb)-V(ijp))*ytp + (W(ijb)-W(ijp))*ztp )
+ ! ! projektovanje razlike brzina na pravac tangencijalne brzine u cell centru ijp
+ ! Ut2 = abs( (U(ijb)-U(ijp))*xtp + (V(ijb)-V(ijp))*ytp + (W(ijb)-W(ijp))*ztp )
- Tau(iWall) = viscos*Ut2/dnw(iWall)
- Utau = sqrt( Tau(iWall) / den(ijb) )
- ypl(iWall) = den(ijb)*Utau*dnw(iWall)/viscos
+ ! Tau(iWall) = viscos*Ut2/dnw(iWall)
+ ! Utau = sqrt( Tau(iWall) / den(ijb) )
+ ! ypl(iWall) = den(ijb)*Utau*dnw(iWall)/viscos
! ! Ima i ova varijanta u cisto turb. granicni sloj varijanti sa prvom celijom u log sloju
! ypl(i) = den(ijb)*cmu25*sqrt(te(ijp))*dnw(i)/viscos
! ! ...ovo je tehnicki receno ystar iliti y* a ne y+
- viscw = zero
+ ! viscw = zero
+ ! if(ypl(iWall) > ctrans) then
+ ! viscw = ypl(iWall)*viscos*cappa/log(Elog*ypl(iWall))
+ ! endif
- if(ypl(iWall) > ctrans) then
- viscw = ypl(iWall)*viscos*cappa/log(Elog*ypl(iWall))
- endif
+ ! *** Enhanced wall treatment - Reichardt blending ***
+
+ ! Below is a variant where we use Reichardt blending
+ ! for whole span of y+ values.
+ ! Some authors say that Reichardt function for u+ approximates
+ ! the composite u+(y+) curve, better that Kader blending function.
+
+ utau = sqrt( viscos*Vtp/(densit*dnw(iWall)) + cmu25*te(ijp) ) ! It's actually u* in original reference...
+
+ ypl(iWall) = den(ijp)*Utau*dnw(iWall)/viscos
+
+ Uplblend = one/cappa*log(one+cappa*ypl(iWall)) + &
+ 7.8_dp*(1.-exp(-ypl(iWall)/11.0_dp)-(ypl(iWall)/11.0_dp)*exp(-ypl(iWall)/3.0_dp))
+
+ viscw = den(ijp)*utau*dnw(iWall)/Uplblend
+
+ ! Blended version of shear stress - probati ovo(!?)
+ ! tau(iWall) = den(ijp) * (Vtp/Uplblend)**2
+
+ ! Varijanta 2, u originalnoj referenci...
+ tau(iWall) = den(ijp) * Vtp*Utau/Uplblend
+
+ !*** END: Enhanced wall treatment - Reichardt blending ***
visw(iWall) = max(viscos,viscw)
vis(ijb) = visw(iWall)
@@ -1005,39 +1050,4 @@ subroutine modify_mu_eff()
end subroutine modify_mu_eff
-subroutine modify_mu_eff_inlet()
-!
-! Update turbulent and effective viscosity at inlet.
-!
- use types
- use parameters
- use geometry, only:numBoundaries,nfaces,iBndValueStart
- use variables
-
- implicit none
-
- integer :: i,ib,ijb
-
- !
- ! Boundary faces
- !
- do ib=1,numBoundaries
-
- if ( bctype(ib) == 'inlet' ) then
-
- do i=1,nfaces(ib)
-
- ijb = iBndValueStart(ib) + i
-
- Vis(ijb) = viscos+den(ijb)*te(ijb)/(ed(ijb)+small)
-
- end do
-
- endif
-
- enddo
-
-end subroutine modify_mu_eff_inlet
-
-
end module k_omega_sst
\ No newline at end of file
diff --git a/src-par/main.f90 b/src-par/main.f90
index 78d5f4b..9b21ec2 100644
--- a/src-par/main.f90
+++ b/src-par/main.f90
@@ -15,20 +15,18 @@ program cappuccino
use geometry
use variables
use title_mod
- use fieldManipulation
- use sparse_matrix
use temperature
use concentration
- use utils, only: show_logo
+ use fieldManipulation
+ use sparse_matrix
+ use utils
use mpi
implicit none
- integer :: iter, i, ijp, ijn, inp, ib, iface
+ integer :: iter
integer :: itimes, itimee
- real(dp):: magUbarStar, rUAw, gragPplus, flowDirection
real(dp):: source
- real(dp):: suma,dt
real :: start, finish
!
!******************************************************************************
@@ -48,7 +46,6 @@ program cappuccino
this = 0
endif
- ! write(*,'(2(a,i2))') ' np = ', nproc, ' myid = ', myid
!----------------------------------------------------------------------
@@ -56,7 +53,6 @@ program cappuccino
call get_command_argument(1,input_file)
call get_command_argument(2,monitor_file)
call get_command_argument(3,restart_file)
- call get_command_argument(4,out_folder_path)
!-----------------------------------------------
! Initialization, grid definition
@@ -72,7 +68,7 @@ program cappuccino
call show_logo
write(*,'(a)') ' '
- write(*,'(a,i2)') ' Parallel run. Number of processes, np = ', nproc
+ write(*,'(a,i2)') ' Parallel run. Number of processes, np = ', nproc
write(*,'(a)') ' '
endif
@@ -85,13 +81,14 @@ program cappuccino
! Create sparse matrix data structure (CSR format)
call create_CSR_matrix
-
+
! Allocate working arrays
call allocate_arrays
! Initialisation of fields
call init
-
+
+ call add_random_noise_to_field(U,20)
!
!===============================================
! T i m e l o o p :
@@ -103,7 +100,6 @@ program cappuccino
write(6,'(a)') ' '
endif
-
itimes = itime+1
itimee = itime+numstep
@@ -116,7 +112,9 @@ program cappuccino
if(itime.eq.itimes) call bcin
! Courant number report:
- include 'CourantNo.h'
+ call CourantNo
+
+ ! if ( mod(itime,10).eq.0 ) call add_random_noise_to_field( U, 20 )
!
!===============================================
@@ -133,8 +131,8 @@ program cappuccino
call calcuvw
! Pressure-velocity coupling. Two options: SIMPLE and PISO
- if(SIMPLE) call CALCP
- if(PISO) call PISO_multiple_correction
+ if(SIMPLE) call calcp_simple
+ if(PISO) call calcp_piso
! Turbulence
if(lturb) call correct_turbulence()
@@ -150,7 +148,7 @@ program cappuccino
if (myid .eq. 0) then
call cpu_time(finish)
write(timechar,'(f9.3)') finish-start
- write(6,'(3a)') ' ExecutionTime = ',adjustl(timechar),' s'
+ write(6,'(3a)') ' ExecutionTime = ',trim(timechar),' s'
write(6,*)
endif
@@ -167,7 +165,7 @@ program cappuccino
endif
! If residuals fall to level below tolerance level - simulation is finished.
- if(.not.ltransient .and. source.lt.sormax ) then
+ if( .not.ltransient .and. source.lt.sormax ) then
call write_restart_files
call writefiles
exit time_loop
@@ -178,21 +176,22 @@ program cappuccino
! Has converged within timestep or has reached maximum no. of SIMPLE iterations per timetstep:
if(source.lt.sormax.or.iter.ge.maxit) then
+ ! Correct driving force for a constant mass flow rate simulation:
if(const_mflux) then
- ! Correct driving force for a constant mass flow rate.
- include 'constant_mass_flow_forcing.f90'
+ call constant_mass_flow_forcing
+ call recirculate_flow
endif
+ ! Write values at monitoring points and recalculate time-average values for statistics:
+ call writehistory
+ call calc_statistics
+
! Write field values after nzapis iterations or at the end of time-dependent simulation:
- if( mod(itime,nzapis).eq.0 .and. itime.ne.numstep ) then
+ if( mod(itime,nzapis).eq.0 .or. itime.eq.numstep ) then
call write_restart_files
call writefiles
endif
- ! Write values at monitoring points and recalculate time-average values for statistics:
- call writehistory
- call calc_statistics
-
cycle time_loop
endif
diff --git a/src-par/mgmres.f90 b/src-par/mgmres.f90
new file mode 100644
index 0000000..6e1658d
--- /dev/null
+++ b/src-par/mgmres.f90
@@ -0,0 +1,1047 @@
+subroutine pmgmres_ilu ( n, nz_num, ia, ja, a, ua, x, iu, rhs, itr_max, mr, &
+ tol_abs, tol_rel )
+
+!*****************************************************************************80
+!
+!! PMGMRES_ILU applies the preconditioned restarted GMRES algorithm.
+!
+! Discussion:
+!
+! The matrix A is assumed to be stored in compressed row format. Only
+! the nonzero entries of A are stored. The vector JA stores the
+! column index of the nonzero value. The nonzero values are sorted
+! by row, and the compressed row vector IA then has the property that
+! the entries in A and JA that correspond to row I occur in indices
+! IA(I) through IA(I+1)-1.
+!
+! This routine uses the incomplete LU decomposition for the
+! preconditioning. This preconditioner requires that the sparse
+! matrix data structure supplies a storage position for each diagonal
+! element of the matrix A, and that each diagonal element of the
+! matrix A is not zero.
+!
+! Thanks to Jesus Pueblas Sanchez-Guerra for supplying two
+! corrections to the code on 31 May 2007.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 29 September 2017
+!
+! Author:
+!
+! Original C version by Lili Ju.
+! FORTRAN90 version by John Burkardt.
+! Modification for usage in Cappuccino CFD code by Nikola Mirkov
+!
+! Reference:
+!
+! Richard Barrett, Michael Berry, Tony Chan, James Demmel,
+! June Donato, Jack Dongarra, Victor Eijkhout, Roidan Pozo,
+! Charles Romine, Henk van der Vorst,
+! Templates for the Solution of Linear Systems:
+! Building Blocks for Iterative Methods,
+! SIAM, 1994.
+! ISBN: 0898714710,
+! LC: QA297.8.T45.
+!
+! Tim Kelley,
+! Iterative Methods for Linear and Nonlinear Equations,
+! SIAM, 2004,
+! ISBN: 0898713528,
+! LC: QA297.8.K45.
+!
+! Yousef Saad,
+! Iterative Methods for Sparse Linear Systems,
+! Second Edition,
+! SIAM, 2003,
+! ISBN: 0898715342,
+! LC: QA188.S17.
+!
+! Parameters:
+!
+! Input, integer ( kind = 4 ) N, the order of the linear system.
+!
+! Input, integer ( kind = 4 ) NZ_NUM, the number of nonzero matrix values.
+!
+! Input, integer ( kind = 4 ) IA(N+1), JA(NZ_NUM), the row and column indices
+! of the matrix values. The row vector has been compressed.
+!
+! Input, real ( kind = 8 ) A(NZ_NUM), the matrix values.
+!
+! Input, integer ( kind = 4 ) AU(N), integer pointer to the matrix values at diagonal.
+!
+! Input/output, real ( kind = 8 ) X(N); on input, an approximation to
+! the solution. On output, an improved approximation.
+!
+! Input, real ( kind = 8 ) RHS(N), the right hand side of the linear system.
+!
+! Input, integer ( kind = 4 ) ITR_MAX, the maximum number of (outer)
+! iterations to take.
+!
+! Input, integer ( kind = 4 ) MR, the maximum number of (inner) iterations
+! to take. MR must be less than N.
+!
+! Input, real ( kind = 8 ) TOL_ABS, an absolute tolerance applied to the
+! current residual.
+!
+! Input, real ( kind = 8 ) TOL_REL, a relative tolerance comparing the
+! current residual to the initial residual.
+!
+ use parameters, only: ltest,myid
+ use title_mod, only: chvarSolver
+ use geometry, only: numBoundaries,bctype,nfaces,startFace,owner,iBndValueStart
+ use sparse_matrix, only: apr
+
+ implicit none
+
+ integer ( kind = 4 ) mr
+ integer ( kind = 4 ) n
+ integer ( kind = 4 ) nz_num
+
+ real ( kind = 8 ) a(nz_num)
+ real ( kind = 8 ) av
+ real ( kind = 8 ) c(mr+1)
+ real ( kind = 8 ), parameter :: delta = 1.0D-03
+ real ( kind = 8 ) g(mr+1)
+ real ( kind = 8 ) h(mr+1,mr)
+ real ( kind = 8 ) htmp
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) iu
+ integer ( kind = 4 ) ia(n+1)
+ integer ( kind = 4 ) itr
+ integer ( kind = 4 ) itr_max
+ integer ( kind = 4 ) itr_used
+ integer ( kind = 4 ) j
+ integer ( kind = 4 ) ja(nz_num)
+ integer ( kind = 4 ) k
+ integer ( kind = 4 ) k_copy
+ real ( kind = 8 ) l(ia(n+1)+1)
+ real ( kind = 8 ) mu
+ real ( kind = 8 ) r(n)
+ real ( kind = 8 ) rho
+ real ( kind = 8 ) res0
+ real ( kind = 8 ) rho_tol
+ real ( kind = 8 ) rhs(n)
+ real ( kind = 8 ) s(mr+1)
+ real ( kind = 8 ) tol_abs
+ real ( kind = 8 ) tol_rel
+ integer ( kind = 4 ) ua(n)
+ real ( kind = 8 ) v(n,mr+1);
+ logical verbose
+ real ( kind = 8 ) x(n)
+ real ( kind = 8 ) y(mr+1)
+
+ integer ib,ipro,ijn,if
+
+ if(ltest) then
+ verbose = .true.
+ else
+ verbose = .false.
+ endif
+
+ itr_used = 0
+ rho_tol = 0. ! To eliminate 'uninitialized' warning.
+ k_copy = 0 ! To eliminate 'uninitialized' warning.
+
+ ! NOTE: In our case the elements are already aranged
+ ! call rearrange_cr ( n, nz_num, ia, ja, a )
+
+ ! NOTE: We provide diagonal as input argument
+ ! call diagonal_pointer_cr ( n, nz_num, ia, ja, ua )
+
+ call ilu_cr ( n, nz_num, ia, ja, a, ua, l )
+
+
+ do itr = 1, itr_max
+
+ call ax_cr ( n, nz_num, ia, ja, a, x, r )
+
+ r(1:n) = rhs(1:n) - r(1:n)
+
+ ! Residual contribution for cells at processor boundary.
+ ipro = 0
+ do ib=1,numBoundaries
+ if ( bctype(ib) == 'process' ) then
+ do i=1,nfaces(ib)
+ if = startFace(ib) + i
+ k = owner(if)
+ ijn = iBndValueStart(ib) + i
+ ipro = ipro + 1
+ r( k ) = r( k ) - apr( ipro )*x( ijn )
+ enddo
+ endif
+ enddo
+
+ call lus_cr ( n, nz_num, ia, ja, l, ua, r, r )
+
+ rho = sqrt ( dot_product ( r, r ) )
+
+ call global_sum(rho)
+
+ if ( itr == 1 ) then
+ res0 = rho
+ endif
+
+ if ( myid.eq.0 .and. verbose ) then
+ write ( *, '(a,i4,a,g14.6)' ) ' ITR = ', itr, ' Residual = ', rho
+ end if
+
+ if ( itr == 1 ) then
+ rho_tol = rho * tol_rel
+ end if
+
+ v(1:n,1) = r(1:n) / rho
+
+ g(1) = rho
+ g(2:mr+1) = 0.0D+00
+
+ h(1:mr+1,1:mr) = 0.0D+00
+
+ do k = 1, mr
+
+ k_copy = k
+
+ call ax_cr ( n, nz_num, ia, ja, a, v(1:n,k), v(1:n,k+1) )
+
+ call lus_cr ( n, nz_num, ia, ja, l, ua, v(1:n,k+1), v(1:n,k+1) )
+
+ av = sqrt ( dot_product ( v(1:n,k+1), v(1:n,k+1) ) )
+
+ do j = 1, k
+ h(j,k) = dot_product ( v(1:n,k+1), v(1:n,j) )
+ v(1:n,k+1) = v(1:n,k+1) - v(1:n,j) * h(j,k)
+ end do
+
+ h(k+1,k) = sqrt ( dot_product ( v(1:n,k+1), v(1:n,k+1) ) )
+
+ if ( ( av + delta * h(k+1,k)) == av ) then
+ do j = 1, k
+ htmp = dot_product ( v(1:n,k+1), v(1:n,j) )
+ h(j,k) = h(j,k) + htmp
+ v(1:n,k+1) = v(1:n,k+1) - htmp * v(1:n,j)
+ end do
+ h(k+1,k) = sqrt ( dot_product ( v(1:n,k+1), v(1:n,k+1) ) )
+ end if
+
+ if ( h(k+1,k) /= 0.0D+00 ) then
+ v(1:n,k+1) = v(1:n,k+1) / h(k+1,k)
+ end if
+
+ if ( 1 < k ) then
+ y(1:k+1) = h(1:k+1,k)
+ do j = 1, k - 1
+ call mult_givens ( c(j), s(j), j, y )
+ end do
+ h(1:k+1,k) = y(1:k+1)
+ end if
+
+ mu = sqrt ( h(k,k)**2 + h(k+1,k)**2 )
+
+ c(k) = h(k,k) / mu
+ s(k) = -h(k+1,k) / mu
+ h(k,k) = c(k) * h(k,k) - s(k) * h(k+1,k)
+ h(k+1,k) = 0.0D+00
+ call mult_givens ( c(k), s(k), k, g )
+
+ rho = abs ( g(k+1) )
+
+ call global_sum(rho)
+
+ itr_used = itr_used + 1
+
+ if ( myid.eq.0 .and. verbose ) then
+ write ( *, '(a,i4,a,g14.6)' ) ' K = ', k, ' Residual = ', rho
+ end if
+
+ if ( rho <= rho_tol .and. rho <= tol_abs ) then
+ exit
+ end if
+
+ end do
+
+ k = k_copy - 1
+
+ y(k+1) = g(k+1) / h(k+1,k+1)
+
+ do i = k, 1, -1
+ y(i) = ( g(i) - dot_product ( h(i,i+1:k+1), y(i+1:k+1) ) ) / h(i,i)
+ end do
+
+ do i = 1, n
+ x(i) = x(i) + dot_product ( v(i,1:k+1), y(1:k+1) )
+ end do
+
+ if ( rho <= rho_tol .and. rho <= tol_abs ) then
+ exit
+ end if
+
+ end do
+
+ if ( myid.eq.0 .and. verbose ) then
+ write ( *, '(a)' ) ' '
+ write ( *, '(a)' ) 'PMGMRES_ILU_CR:'
+ write ( *, '(a,i6)' ) ' Iterations = ', itr_used
+ write ( *, '(a,g14.6)' ) ' Final residual = ', rho
+ end if
+
+ ! Write linear solver report:
+ if (myid.eq.0) write(*,'(a,i2,3a,1PE10.3,a,1PE10.3,a,I0)') ' PMGMRES_ILU(',mr,'): Solving for ',trim(chvarSolver(iu)), &
+ ', Initial residual = ',res0,', Final residual = ',rho,', No Iterations ',itr_used
+
+
+ return
+end
+
+subroutine atx_cr ( n, nz_num, ia, ja, a, x, w )
+
+!*****************************************************************************80
+!
+!! ATX_CR computes A'*x for a matrix stored in sparse compressed row form.
+!
+! Discussion:
+!
+! The Sparse Compressed Row storage format is used.
+!
+! The matrix A is assumed to be sparse. To save on storage, only
+! the nonzero entries of A are stored. The vector JA stores the
+! column index of the nonzero value. The nonzero values are sorted
+! by row, and the compressed row vector IA then has the property that
+! the entries in A and JA that correspond to row I occur in indices
+! IA[I] through IA[I+1]-1.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 17 July 2007
+!
+! Author:
+!
+! Original C version by Lili Ju.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Richard Barrett, Michael Berry, Tony Chan, James Demmel,
+! June Donato, Jack Dongarra, Victor Eijkhout, Roidan Pozo,
+! Charles Romine, Henk van der Vorst,
+! Templates for the Solution of Linear Systems:
+! Building Blocks for Iterative Methods,
+! SIAM, 1994.
+! ISBN: 0898714710,
+! LC: QA297.8.T45.
+!
+! Tim Kelley,
+! Iterative Methods for Linear and Nonlinear Equations,
+! SIAM, 2004,
+! ISBN: 0898713528,
+! LC: QA297.8.K45.
+!
+! Yousef Saad,
+! Iterative Methods for Sparse Linear Systems,
+! Second Edition,
+! SIAM, 2003,
+! ISBN: 0898715342,
+! LC: QA188.S17.
+!
+! Parameters:
+!
+! Input, integer ( kind = 4 ) N, the order of the system.
+!
+! Input, integer ( kind = 4 ) NZ_NUM, the number of nonzeros.
+!
+! Input, integer ( kind = 4 ) IA(N+1), JA(NZ_NUM), the row and column
+! indices of the matrix values. The row vector has been compressed.
+!
+! Input, real ( kind = 8 ) A(NZ_NUM), the matrix values.
+!
+! Input, real ( kind = 8 ) X(N), the vector to be multiplied by A'.
+!
+! Output, real ( kind = 8 ) W(N), the value of A'*X.
+!
+ implicit none
+
+ integer ( kind = 4 ) n
+ integer ( kind = 4 ) nz_num
+
+ real ( kind = 8 ) a(nz_num)
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) ia(n+1)
+ integer ( kind = 4 ) ja(nz_num)
+ integer ( kind = 4 ) k1
+ integer ( kind = 4 ) k2
+ real ( kind = 8 ) w(n)
+ real ( kind = 8 ) x(n)
+
+ w(1:n) = 0.0D+00
+
+ do i = 1, n
+ k1 = ia(i)
+ k2 = ia(i+1) - 1
+ w(ja(k1:k2)) = w(ja(k1:k2)) + a(k1:k2) * x(i)
+ end do
+
+ return
+end
+
+subroutine ax_cr ( n, nz_num, ia, ja, a, x, w )
+
+!*****************************************************************************80
+!
+!! AX_CR computes A*x for a matrix stored in sparse compressed row form.
+!
+! Discussion:
+!
+! The Sparse Compressed Row storage format is used.
+!
+! The matrix A is assumed to be sparse. To save on storage, only
+! the nonzero entries of A are stored. The vector JA stores the
+! column index of the nonzero value. The nonzero values are sorted
+! by row, and the compressed row vector IA then has the property that
+! the entries in A and JA that correspond to row I occur in indices
+! IA[I] through IA[I+1]-1.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 17 July 2007
+!
+! Author:
+!
+! Original C version by Lili Ju.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Richard Barrett, Michael Berry, Tony Chan, James Demmel,
+! June Donato, Jack Dongarra, Victor Eijkhout, Roidan Pozo,
+! Charles Romine, Henk van der Vorst,
+! Templates for the Solution of Linear Systems:
+! Building Blocks for Iterative Methods,
+! SIAM, 1994.
+! ISBN: 0898714710,
+! LC: QA297.8.T45.
+!
+! Tim Kelley,
+! Iterative Methods for Linear and Nonlinear Equations,
+! SIAM, 2004,
+! ISBN: 0898713528,
+! LC: QA297.8.K45.
+!
+! Yousef Saad,
+! Iterative Methods for Sparse Linear Systems,
+! Second Edition,
+! SIAM, 2003,
+! ISBN: 0898715342,
+! LC: QA188.S17.
+!
+! Parameters:
+!
+! Input, integer ( kind = 4 ) N, the order of the system.
+!
+! Input, integer ( kind = 4 ) NZ_NUM, the number of nonzeros.
+!
+! Input, integer ( kind = 4 ) IA(N+1), JA(NZ_NUM), the row and column
+! indices of the matrix values. The row vector has been compressed.
+!
+! Input, real ( kind = 8 ) A(NZ_NUM), the matrix values.
+!
+! Input, real ( kind = 8 ) X(N), the vector to be multiplied by A.
+!
+! Output, real ( kind = 8 ) W(N), the value of A*X.
+!
+ implicit none
+
+ integer ( kind = 4 ) n
+ integer ( kind = 4 ) nz_num
+
+ real ( kind = 8 ) a(nz_num)
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) ia(n+1)
+ integer ( kind = 4 ) ja(nz_num)
+ integer ( kind = 4 ) k1
+ integer ( kind = 4 ) k2
+ real ( kind = 8 ) w(n)
+ real ( kind = 8 ) x(n)
+
+ w(1:n) = 0.0D+00
+
+ do i = 1, n
+ k1 = ia(i)
+ k2 = ia(i+1) - 1
+ w(i) = w(i) + dot_product ( a(k1:k2), x(ja(k1:k2)) )
+ end do
+
+ return
+end
+
+subroutine diagonal_pointer_cr ( n, nz_num, ia, ja, ua )
+
+!*****************************************************************************80
+!
+!! DIAGONAL_POINTER_CR finds diagonal entries in a sparse compressed row matrix.
+!
+! Discussion:
+!
+! The matrix A is assumed to be stored in compressed row format. Only
+! the nonzero entries of A are stored. The vector JA stores the
+! column index of the nonzero value. The nonzero values are sorted
+! by row, and the compressed row vector IA then has the property that
+! the entries in A and JA that correspond to row I occur in indices
+! IA[I] through IA[I+1]-1.
+!
+! The array UA can be used to locate the diagonal elements of the matrix.
+!
+! It is assumed that every row of the matrix includes a diagonal element,
+! and that the elements of each row have been ascending sorted.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 18 July 2007
+!
+! Author:
+!
+! Original C version by Lili Ju.
+! FORTRAN90 version by John Burkardt.
+!
+! Parameters:
+!
+! Input, integer ( kind = 4 ) N, the order of the system.
+!
+! Input, integer ( kind = 4 ) NZ_NUM, the number of nonzeros.
+!
+! Input, integer ( kind = 4 ) IA(N+1), JA(NZ_NUM), the row and column
+! indices of the matrix values. The row vector has been compressed.
+! On output, the order of the entries of JA may have changed because of
+! the sorting.
+!
+! Output, integer ( kind = 4 ) UA(N), the index of the diagonal element
+! of each row.
+!
+ implicit none
+
+ integer ( kind = 4 ) n
+ integer ( kind = 4 ) nz_num
+
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) ia(n+1)
+ integer ( kind = 4 ) k
+ integer ( kind = 4 ) ja(nz_num)
+ integer ( kind = 4 ) ua(n)
+
+ ua(1:n) = -1
+
+ do i = 1, n
+ do k = ia(i), ia(i+1) - 1
+ if ( ja(k) == i ) then
+ ua(i) = k
+ end if
+ end do
+ end do
+
+ return
+end
+subroutine ilu_cr ( n, nz_num, ia, ja, a, ua, l )
+
+!*****************************************************************************80
+!
+!! ILU_CR computes the incomplete LU factorization of a matrix.
+!
+! Discussion:
+!
+! The matrix A is assumed to be stored in compressed row format. Only
+! the nonzero entries of A are stored. The vector JA stores the
+! column index of the nonzero value. The nonzero values are sorted
+! by row, and the compressed row vector IA then has the property that
+! the entries in A and JA that correspond to row I occur in indices
+! IA(I) through IA(I+1)-1.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 27 July 2007
+!
+! Author:
+!
+! Original C version by Lili Ju.
+! FORTRAN90 version by John Burkardt.
+!
+! Parameters:
+!
+! Input, integer ( kind = 4 ) N, the order of the system.
+!
+! Input, integer ( kind = 4 ) NZ_NUM, the number of nonzeros.
+!
+! Input, integer ( kind = 4 ) IA(N+1), JA(NZ_NUM), the row and column
+! indices of the matrix values. The row vector has been compressed.
+!
+! Input, real ( kind = 8 ) A(NZ_NUM), the matrix values.
+!
+! Input, integer ( kind = 4 ) UA(N), the index of the diagonal element
+! of each row.
+!
+! Output, real ( kind = 8 ) L(NZ_NUM), the ILU factorization of A.
+!
+ implicit none
+
+ integer ( kind = 4 ) n
+ integer ( kind = 4 ) nz_num
+
+ real ( kind = 8 ) a(nz_num)
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) ia(n+1)
+ integer ( kind = 4 ) iw(n)
+ integer ( kind = 4 ) j
+ integer ( kind = 4 ) ja(nz_num)
+ integer ( kind = 4 ) jj
+ integer ( kind = 4 ) jrow
+ integer ( kind = 4 ) jw
+ integer ( kind = 4 ) k
+ real ( kind = 8 ) l(nz_num)
+ real ( kind = 8 ) tl
+ integer ( kind = 4 ) ua(n)
+!
+! Copy A.
+!
+ l(1:nz_num) = a(1:nz_num)
+
+ do i = 1, n
+!
+! IW points to the nonzero entries in row I.
+!
+ iw(1:n) = -1
+
+ do k = ia(i), ia(i+1) - 1
+ iw(ja(k)) = k
+ end do
+
+ do j = ia(i), ia(i+1) - 1
+ jrow = ja(j)
+ if ( i <= jrow ) then
+ exit
+ end if
+ tl = l(j) * l(ua(jrow))
+ l(j) = tl
+ do jj = ua(jrow) + 1, ia(jrow+1) - 1
+ jw = iw(ja(jj))
+ if ( jw /= -1 ) then
+ l(jw) = l(jw) - tl * l(jj)
+ end if
+ end do
+ end do
+
+ ua(i) = j
+
+ if ( jrow /= i ) then
+ write ( *, '(a)' ) ' '
+ write ( *, '(a)' ) 'ILU_CR - Fatal error!'
+ write ( *, '(a)' ) ' JROW ~= I'
+ write ( *, '(a,i8)' ) ' JROW = ', jrow
+ write ( *, '(a,i8)' ) ' I = ', i
+ stop
+ end if
+
+ if ( l(j) == 0.0D+00 ) then
+ write ( *, '(a)' ) ' '
+ write ( *, '(a)' ) 'ILU_CR - Fatal error!'
+ write ( *, '(a,i8)' ) ' Zero pivot on step I = ', i
+ write ( *, '(a,i8,a)' ) ' L(', j, ') = 0.0'
+ stop
+ end if
+
+ l(j) = 1.0D+00 / l(j)
+
+ end do
+
+ l(ua(1:n)) = 1.0D+00 / l(ua(1:n))
+
+ return
+end
+subroutine lus_cr ( n, nz_num, ia, ja, l, ua, r, z )
+
+!*****************************************************************************80
+!
+!! LUS_CR applies the incomplete LU preconditioner.
+!
+! Discussion:
+!
+! The linear system M * Z = R is solved for Z. M is the incomplete
+! LU preconditioner matrix, and R is a vector supplied by the user.
+! So essentially, we're solving L * U * Z = R.
+!
+! The matrix A is assumed to be stored in compressed row format. Only
+! the nonzero entries of A are stored. The vector JA stores the
+! column index of the nonzero value. The nonzero values are sorted
+! by row, and the compressed row vector IA then has the property that
+! the entries in A and JA that correspond to row I occur in indices
+! IA(I) through IA(I+1)-1.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 18 July 2007
+!
+! Author:
+!
+! Original C version by Lili Ju.
+! FORTRAN90 version by John Burkardt.
+!
+! Parameters:
+!
+! Input, integer ( kind = 4 ) N, the order of the system.
+!
+! Input, integer ( kind = 4 ) NZ_NUM, the number of nonzeros.
+!
+! Input, integer ( kind = 4 ) IA(N+1), JA(NZ_NUM), the row and column
+! indices of the matrix values. The row vector has been compressed.
+!
+! Input, real ( kind = 8 ) L(NZ_NUM), the matrix values.
+!
+! Input, integer ( kind = 4 ) UA(N), the index of the diagonal element
+! of each row.
+!
+! Input, real ( kind = 8 ) R(N), the right hand side.
+!
+! Output, real ( kind = 8 ) Z(N), the solution of the system M * Z = R.
+!
+ implicit none
+
+ integer ( kind = 4 ) n
+ integer ( kind = 4 ) nz_num
+
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) ia(n+1)
+ integer ( kind = 4 ) j
+ integer ( kind = 4 ) ja(nz_num)
+ real ( kind = 8 ) l(nz_num)
+ real ( kind = 8 ) r(n)
+ integer ( kind = 4 ) ua(n)
+ real ( kind = 8 ) w(n)
+ real ( kind = 8 ) z(n)
+!
+! Copy R in.
+!
+ w(1:n) = r(1:n)
+!
+! Solve L * w = w where L is unit lower triangular.
+!
+ do i = 2, n
+ do j = ia(i), ua(i) - 1
+ w(i) = w(i) - l(j) * w(ja(j))
+ end do
+ end do
+!
+! Solve U * w = w, where U is upper triangular.
+!
+ do i = n, 1, -1
+ do j = ua(i) + 1, ia(i+1) - 1
+ w(i) = w(i) - l(j) * w(ja(j))
+ end do
+ w(i) = w(i) / l(ua(i))
+ end do
+!
+! Copy Z out.
+!
+ z(1:n) = w(1:n)
+
+ return
+end
+
+subroutine mult_givens ( c, s, k, g )
+
+!*****************************************************************************80
+!
+!! MULT_GIVENS applies a Givens rotation to two successive entries of a vector.
+!
+! Discussion:
+!
+! In order to make it easier to compare this code with the Original C,
+! the vector indexing is 0-based.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 08 August 2006
+!
+! Author:
+!
+! Original C version by Lili Ju.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Richard Barrett, Michael Berry, Tony Chan, James Demmel,
+! June Donato, Jack Dongarra, Victor Eijkhout, Roidan Pozo,
+! Charles Romine, Henk van der Vorst,
+! Templates for the Solution of Linear Systems:
+! Building Blocks for Iterative Methods,
+! SIAM, 1994.
+! ISBN: 0898714710,
+! LC: QA297.8.T45.
+!
+! Tim Kelley,
+! Iterative Methods for Linear and Nonlinear Equations,
+! SIAM, 2004,
+! ISBN: 0898713528,
+! LC: QA297.8.K45.
+!
+! Yousef Saad,
+! Iterative Methods for Sparse Linear Systems,
+! Second Edition,
+! SIAM, 2003,
+! ISBN: 0898715342,
+! LC: QA188.S17.
+!
+! Parameters:
+!
+! Input, real ( kind = 8 ) C, S, the cosine and sine of a Givens
+! rotation.
+!
+! Input, integer ( kind = 4 ) K, indicates the location of the first
+! vector entry.
+!
+! Input/output, real ( kind = 8 ) G(1:K+1), the vector to be modified.
+! On output, the Givens rotation has been applied to entries G(K) and G(K+1).
+!
+ implicit none
+
+ integer ( kind = 4 ) k
+
+ real ( kind = 8 ) c
+ real ( kind = 8 ) g(1:k+1)
+ real ( kind = 8 ) g1
+ real ( kind = 8 ) g2
+ real ( kind = 8 ) s
+
+ g1 = c * g(k) - s * g(k+1)
+ g2 = s * g(k) + c * g(k+1)
+
+ g(k) = g1
+ g(k+1) = g2
+
+ return
+end
+
+subroutine r8vec_uniform_01 ( n, seed, r )
+
+!*****************************************************************************80
+!
+!! R8VEC_UNIFORM_01 returns a unit pseudorandom R8VEC.
+!
+! Discussion:
+!
+! An R8VEC is a vector of real ( kind = 8 ) values.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 05 July 2006
+!
+! Author:
+!
+! John Burkardt
+!
+! Reference:
+!
+! Paul Bratley, Bennett Fox, Linus Schrage,
+! A Guide to Simulation,
+! Second Edition,
+! Springer, 1987,
+! ISBN: 0387964673,
+! LC: QA76.9.C65.B73.
+!
+! Bennett Fox,
+! Algorithm 647:
+! Implementation and Relative Efficiency of Quasirandom
+! Sequence Generators,
+! ACM Transactions on Mathematical Software,
+! Volume 12, Number 4, December 1986, pages 362-376.
+!
+! Pierre L'Ecuyer,
+! Random Number Generation,
+! in Handbook of Simulation,
+! edited by Jerry Banks,
+! Wiley, 1998,
+! ISBN: 0471134031,
+! LC: T57.62.H37.
+!
+! Peter Lewis, Allen Goodman, James Miller,
+! A Pseudo-Random Number Generator for the System/360,
+! IBM Systems Journal,
+! Volume 8, Number 2, 1969, pages 136-143.
+!
+! Parameters:
+!
+! Input, integer ( kind = 4 ) N, the number of entries in the vector.
+!
+! Input/output, integer ( kind = 4 ) SEED, the "seed" value, which
+! should NOT be 0. On output, SEED has been updated.
+!
+! Output, real ( kind = 8 ) R(N), the vector of pseudorandom values.
+!
+ implicit none
+
+ integer ( kind = 4 ) n
+
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) k
+ integer ( kind = 4 ) seed
+ real ( kind = 8 ) r(n)
+
+ if ( seed == 0 ) then
+ write ( *, '(a)' ) ' '
+ write ( *, '(a)' ) 'R8VEC_UNIFORM_01 - Fatal error!'
+ write ( *, '(a)' ) ' Input value of SEED = 0.'
+ stop
+ end if
+
+ do i = 1, n
+
+ k = seed / 127773
+
+ seed = 16807 * ( seed - k * 127773 ) - k * 2836
+
+ if ( seed < 0 ) then
+ seed = seed + 2147483647
+ end if
+
+ r(i) = real ( seed, kind = 8 ) * 4.656612875D-10
+
+ end do
+
+ return
+end
+subroutine rearrange_cr ( n, nz_num, ia, ja, a )
+
+!*****************************************************************************80
+!
+!! REARRANGE_CR sorts a sparse compressed row matrix.
+!
+! Discussion:
+!
+! This routine guarantees that the entries in the CR matrix
+! are properly sorted.
+!
+! After the sorting, the entries of the matrix are rearranged in such
+! a way that the entries of each column are listed in ascending order
+! of their column values.
+!
+! The matrix A is assumed to be stored in compressed row format. Only
+! the nonzero entries of A are stored. The vector JA stores the
+! column index of the nonzero value. The nonzero values are sorted
+! by row, and the compressed row vector IA then has the property that
+! the entries in A and JA that correspond to row I occur in indices
+! IA(I) through IA(I+1)-1.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 17 July 2007
+!
+! Author:
+!
+! Original C version by Lili Ju.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Richard Barrett, Michael Berry, Tony Chan, James Demmel,
+! June Donato, Jack Dongarra, Victor Eijkhout, Roidan Pozo,
+! Charles Romine, Henk van der Vorst,
+! Templates for the Solution of Linear Systems:
+! Building Blocks for Iterative Methods,
+! SIAM, 1994.
+! ISBN: 0898714710,
+! LC: QA297.8.T45.
+!
+! Tim Kelley,
+! Iterative Methods for Linear and Nonlinear Equations,
+! SIAM, 2004,
+! ISBN: 0898713528,
+! LC: QA297.8.K45.
+!
+! Yousef Saad,
+! Iterative Methods for Sparse Linear Systems,
+! Second Edition,
+! SIAM, 2003,
+! ISBN: 0898715342,
+! LC: QA188.S17.
+!
+! Parameters:
+!
+! Input, integer ( kind = 4 ) N, the order of the system.
+!
+! Input, integer ( kind = 4 ) NZ_NUM, the number of nonzeros.
+!
+! Input, integer ( kind = 4 ) IA(N+1), the compressed row indices.
+!
+! Input/output, integer ( kind = 4 ) JA(NZ_NUM), the column indices.
+! On output, these may have been rearranged by the sorting.
+!
+! Input/output, real ( kind = 8 ) A(NZ_NUM), the matrix values. On output,
+! the matrix values may have been moved somewhat because of the sorting.
+!
+ implicit none
+
+ integer ( kind = 4 ) n
+ integer ( kind = 4 ) nz_num
+
+ real ( kind = 8 ) a(nz_num)
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) ia(n+1)
+ integer ( kind = 4 ) i4temp
+ integer ( kind = 4 ) ja(nz_num)
+ integer ( kind = 4 ) k
+ integer ( kind = 4 ) l
+ real ( kind = 8 ) r8temp
+
+ do i = 1, n
+
+ do k = ia(i), ia(i+1) - 2
+ do l = k + 1, ia(i+1) - 1
+
+ if ( ja(l) < ja(k) ) then
+ i4temp = ja(l)
+ ja(l) = ja(k)
+ ja(k) = i4temp
+
+ r8temp = a(l)
+ a(l) = a(k)
+ a(k) = r8temp
+ end if
+
+ end do
+ end do
+
+ end do
+
+ return
+end
\ No newline at end of file
diff --git a/src-par/modules_allocatable.f90 b/src-par/modules_allocatable.f90
index 9ebb31f..1179f5b 100644
--- a/src-par/modules_allocatable.f90
+++ b/src-par/modules_allocatable.f90
@@ -108,13 +108,13 @@ module parameters
logical :: flux_limiter = .false.
! Logicals, mostly read from simulation-input file:
- logical :: lturb,lread,lwrite,ltest ! turbulent simulation, read restart file, write restart file, print residual of the linear solver,.,..
+ logical :: lturb,lread,lwrite,ltest,lreadstat ! is it a turbulent case, do you read restart file, write restart file, print stuff, read statistics files
logical :: ltransient ! LTRANSIENT is TRUE for transient (non-stationary) simulations
logical :: levm,lasm,lles,ldes,lsgdh,lggdh,lafm ! eddy-viscosity, algebraic stress model or LES, DES, simple gradient or generalized gradient hypothesis, algerbaic flux model
- logical :: bdf,bdf2,bdf3,cn ! control for the time-stepping algorithm
- logical :: simple,piso,pimple ! control for the velocity-pressure coupling algorithm
+ logical :: bdf,bdf2,bdf3,cn ! control for the time-stepping algorithm
+ logical :: simple,piso ! control for the velocity-pressure coupling algorithm
logical :: const_mflux ! control for constant flow rate
- logical :: solveOmega, solveEpsilon, SolveTKE ! Selfexplanatory, used in 'init'
+ logical :: solveOmega, solveEpsilon, SolveTKE ! Self explanatory, used in 'init'
integer :: ncorr ! PISO control parameter: no. of Piso corrections.
@@ -175,7 +175,7 @@ module variables
real(dp), dimension(:), allocatable :: con ! Concentration
real(dp), dimension(:), allocatable :: uu,vv,ww,uv,uw,vw ! Reynolds stress tensor components
real(dp), dimension(:,:), allocatable :: bij ! Reynolds stress anisotropy tensor
- real(dp), dimension(:), allocatable :: fmi,fmo,fmoc,fmpro ! Mass fluxes trough boundary faces
+ ! real(dp), dimension(:), allocatable :: fmi,fmo,fmoc,fmpro ! Mass fluxes trough boundary faces
real(dp), dimension(:), allocatable :: visw,ypl,tau ! Effective visc. for boundary face, the y+ non-dimensional distance from wall, wll shear stress
! values from n-1 timestep
@@ -229,7 +229,7 @@ module title_mod
character(len=4), dimension(10) :: chvar = (/' U ', ' V ', ' W ', ' P ', ' TE ', ' ED ', ' T ', ' VIS', 'VART', ' CON' /)
character(len=7), dimension(10) :: chvarSolver = &
(/'U ', 'V ', 'W ', 'p ', 'k ', 'epsilon', 'Temp ', 'Visc ', 'VarTemp', 'Conc ' /)
- character(len=100):: input_file,inlet_file,grid_file,monitor_file,restart_file,out_folder_path
+ character(len=100):: input_file,inlet_file,grid_file,monitor_file,restart_file
end module title_mod
@@ -249,6 +249,8 @@ module statistics
real(dp), dimension(:), allocatable :: t_aver
real(dp), dimension(:), allocatable :: ut_aver,vt_aver,wt_aver
real(dp), dimension(:), allocatable :: tt_aver
+ real(dp), dimension(:), allocatable :: con_aver
+ real(dp), dimension(:), allocatable :: wss_aver
end module statistics
diff --git a/src-par/openfiles.f90 b/src-par/openfiles.f90
index 6c12b80..7be87f5 100644
--- a/src-par/openfiles.f90
+++ b/src-par/openfiles.f90
@@ -11,8 +11,8 @@ subroutine openfiles
! character(8) :: date
! character(10) :: time
- character( len = 5) :: nproc_char
- integer :: id
+ ! character( len = 5) :: nproc_char
+ ! integer :: id
!
!***********************************************************************
@@ -31,10 +31,10 @@ subroutine openfiles
! Create folders for process data
! do id=0,nproc-1
- ! ! nproc_char <- myid zapisan levo u vidu stringa.
- ! call i4_to_s_left ( id, nproc_char )
+ ! nproc_char <- myid zapisan levo u vidu stringa.
+ ! call i4_to_s_left ( id, myid )
- ! call execute_command_line('mkdir processor'//trim(nproc_char)//'/vtk')
+ ! call execute_command_line('mkdir processor'//trim(nproc_char)//'/vtk')
! enddo
diff --git a/src-par/output.f90 b/src-par/output.f90
index e9ecb7d..195037a 100644
--- a/src-par/output.f90
+++ b/src-par/output.f90
@@ -305,6 +305,36 @@ subroutine vtu_write_XML_scalar_field ( output_unit, scalar_name, scalar_field )
end subroutine vtu_write_XML_scalar_field
+
+subroutine vtu_write_XML_scalar_field_boundary ( output_unit, scalar_name, scalar_field, istart, iend )
+!
+! Writes scalar field data to Paraview XML, unstructured, ".vtu" file.
+!
+ implicit none
+
+ integer, intent(in) :: output_unit, istart, iend
+ character ( len = * ), intent(in) :: scalar_name
+ real(dp), dimension(numTotal), intent(in) :: scalar_field
+
+ integer :: icell
+
+!
+ write ( output_unit, '(8x,3a)' ) ''
+
+!
+! > Scalars in cell-centers and boundary faces > write scalar data
+!
+ do icell=istart,iend
+ write( output_unit, '(10x,e15.7)') scalar_field(icell)
+ enddo
+
+
+ write ( output_unit, '(8x,a)' ) ''
+!
+
+end subroutine vtu_write_XML_scalar_field_boundary
+
+
subroutine vtu_write_XML_vector_field ( output_unit, field_name, u, v, w )
!
! Writes vector field data to Paraview XML, unstructured, ".vtu" file.
@@ -333,6 +363,34 @@ subroutine vtu_write_XML_vector_field ( output_unit, field_name, u, v, w )
end subroutine vtu_write_XML_vector_field
+subroutine vtu_write_XML_vector_field_boundary ( output_unit, field_name, u, v, w, istart, iend )
+!
+! Writes vector field data to Paraview XML, unstructured, ".vtu" file.
+!
+ implicit none
+
+ integer, intent(in) :: output_unit, istart, iend
+ character ( len = * ), intent(in) :: field_name
+ real(dp), dimension(numTotal), intent(in) :: u, v, w
+
+ integer :: icell
+
+!
+ write ( output_unit, '(8x,3a)' ) ''
+
+!
+! > Scalars in cell-centers and boundary faces > write scalar data
+!
+ do icell=istart,iend
+ write( output_unit, '(10x,3(1x,e15.7))') u(icell), v(icell), w(icell)
+ enddo
+
+ write ( output_unit, '(8x,a)' ) ''
+!
+
+end subroutine vtu_write_XML_vector_field_boundary
+
+
subroutine vtu_write_scalar_field ( output_unit, scalar_name, scalar_field )
!
! Writes scalar field data to Paraview XML, unstructured, ".vtu" file.
@@ -457,8 +515,6 @@ subroutine vtu_write_scalar_field ( output_unit, scalar_name, scalar_field )
end subroutine vtu_write_scalar_field
-
-
subroutine vtu_write_vector_field ( output_unit, field_name, u, v, w )
!
! Writes scalar field data to Paraview XML, unstructured, ".vtu" file.
@@ -581,7 +637,6 @@ subroutine vtu_write_vector_field ( output_unit, field_name, u, v, w )
end subroutine vtu_write_vector_field
-
subroutine vtu_write_mesh ( output_unit )
!
! Writes scalar field data to Paraview XML, unstructured, ".vtu" file.
diff --git a/src-par/read_input.f90 b/src-par/read_input.f90
index 5ce655b..be52e3c 100644
--- a/src-par/read_input.f90
+++ b/src-par/read_input.f90
@@ -11,26 +11,27 @@ subroutine read_input_file
use parameters
use gradients, only: lstsq, lstsq_qr, lstsq_dm, gauss, limiter
use title_mod
+ use utils
+ use mpi
implicit none
- include 'mpif.h'
-
integer :: i,imon
character(len=2) :: trpn
character(len=25) :: convective_scheme
+ character(len=5) :: nproc_char
!
!***********************************************************************
!
- ! Root processor opens files
+! Root processor opens files
if (myid .eq. 0) then
open(unit=5,file=input_file)
rewind 5
read(5,'(a70)') title
- read(5,*) lread,lwrite,ltest
+ read(5,*) lread,lwrite,ltest,lreadstat
read(5,*) (lcal(i),i=1,nphi)
read(5,*) monCell,pRefCell,MPoints
read(5,*) slarge,sormax
@@ -39,7 +40,7 @@ subroutine read_input_file
read(5,*) lbuoy,gravx,gravy,gravz,boussinesq
read(5,*) roughWall,EROUGH,ZZERO
read(5,*) facnap,facflx
- read(5,*) ltransient,bdf,bdf2,cn
+ read(5,*) ltransient,bdf,bdf2,bdf3,cn
read(5,*) levm,lasm,lles,ldes
read(5,*) lsgdh,lggdh,lafm
read(5,*) TurbModel
@@ -53,17 +54,17 @@ subroutine read_input_file
read(5,*) numstep,timestep,nzapis,maxit
read(5,*) lstsq, lstsq_qr, lstsq_dm, gauss
read(5,*) npcor, nigrad
- read(5,*) simple,piso,pimple,ncorr
+ read(5,*) simple,piso,ncorr
read(5,*) const_mflux
read(5,*) CoNumFix, CoNumFixValue
close (5)
-!.Create an input file reading log:
+ ! Create an input file reading log:
write(6,'(a)') ' Input file log: '
write(6,'(a)') '---cut here-----------------------------------------------------------------------------'
write(6,'(a70)') title
- write(6,'(3(l1,1x),5x,a)') lread,lwrite,ltest,'read3,writ3,ltest'
+ write(6,'(4(l1,1x),5x,a)') lread,lwrite,ltest,lreadstat,'lread,lwrit,ltest,lreadstat'
write(6,'(10(l1,1x),5x,a)') (lcal(i),i=1,nphi),'(lcal(i),i=1,nphi),ip=4,ite=5,ied=6,ien=7,ivis=8,ivart=9,icon=10'
write(6,'(3(i3,1x),5x,a)') monCell,pRefCell,MPoints,'monCell,pRefCell,MPoints'
write(6,'(2(es11.4,1x),5x,a)') slarge,sormax,'slarge,sormax'
@@ -72,7 +73,7 @@ subroutine read_input_file
write(6,'(l1,1x,3f6.2,1x,l1,1x,a)') lbuoy,gravx,gravy,gravz,boussinesq,'lbuoy,gravx,gravy,gravz,boussinesq'
write(6,'(L1,1x,f5.2,1x,es11.4,1x,a)') roughWall,erough,zzero,'roughWall,erough,zzero'
write(6,'(2(f4.2,1x),a)') facnap,facflx,'facnap,facflx'
- write(6,'(l1,1x,l1,1x,f4.2,1x,l1,1x,a)') ltransient,bdf,btime,cn,'ltransient,bdf,btime,cn'
+ write(6,'(5(l1,1x),a)') ltransient,bdf,bdf2,bdf3,cn,'ltransient,bdf,bdf2,bdf3,cn'
write(6,'(4(l1,1x),a)') levm,lasm,lles,ldes,'levm,lasm,lles,ldes'
write(6,'(3(l1,1x),a)') lsgdh,lggdh,lafm,'lsgdh,lggdh,lafm'
write(6,'(i2,1x,a)') TurbModel, 'Turbulence Model'
@@ -86,13 +87,12 @@ subroutine read_input_file
write(6,'(i5,1x,es9.2,1x,i5,1x,i4,1x,a)') numstep,timestep,nzapis,maxit,'numstep,timestep,nzapis,maxit'
write(6,'(4(L1,1x),a)') lstsq, lstsq_qr, lstsq_dm, gauss,'lstsq, lstsq_qr, lstsq_dm, gauss'
write(6,'(i1,1x,i1,1x,a)') npcor, nigrad,'npcor, nigrad'
- write(6,'(3(l1,1x),i1,1x,a)') simple,piso,pimple,ncorr,'simple,piso,pimple,ncorr'
+ write(6,'(2(l1,1x),i1,1x,a)') simple,piso,ncorr,'simple,piso,ncorr'
write(6,'(1(L1,1x),5x,a)') const_mflux,'const_mflux'
write(6,'(L1,es11.4,5x,a)') CoNumFix, CoNumFixValue,'CoNumFix, CoNumFixValue'
write(6,'(a)') '---cut here-----------------------------------------------------------------------------'
- endif
-
+ endif ! if(myid==0): end
! Broadcast input data to other processes
call MPI_BCAST(title,70,MPI_CHARACTER,0,MPI_COMM_WORLD,IERR)
@@ -100,6 +100,7 @@ subroutine read_input_file
call MPI_BCAST(lread,1,MPI_LOGICAL,0,MPI_COMM_WORLD,IERR)
call MPI_BCAST(lwrite,1,MPI_LOGICAL,0,MPI_COMM_WORLD,IERR)
call MPI_BCAST(ltest,1,MPI_LOGICAL,0,MPI_COMM_WORLD,IERR)
+ call MPI_BCAST(lreadstat,1,MPI_LOGICAL,0,MPI_COMM_WORLD,IERR)
call MPI_BCAST(lcal,NPHI,MPI_LOGICAL,0,MPI_COMM_WORLD,IERR)
@@ -107,7 +108,7 @@ subroutine read_input_file
call MPI_BCAST(pRefCell,1,MPI_INTEGER,0,MPI_COMM_WORLD,IERR)
call MPI_BCAST(MPOINTS,1,MPI_INTEGER,0,MPI_COMM_WORLD,IERR)
- ! Treba naci kom procesu pripadaju monitoring tacke - pogledaj getpidlm.f kod Sase.
+ ! Treba naci kom procesu pripadaju monitoring tacke...
call MPI_BCAST(slarge,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,IERR)
call MPI_BCAST(sormax,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,IERR)
@@ -135,6 +136,7 @@ subroutine read_input_file
call MPI_BCAST(ltransient,1,MPI_LOGICAL,0,MPI_COMM_WORLD,IERR)
call MPI_BCAST(bdf,1,MPI_LOGICAL,0,MPI_COMM_WORLD,IERR)
call MPI_BCAST(bdf2,1,MPI_LOGICAL,0,MPI_COMM_WORLD,IERR)
+ call MPI_BCAST(bdf3,1,MPI_LOGICAL,0,MPI_COMM_WORLD,IERR)
call MPI_BCAST(cn,1,MPI_LOGICAL,0,MPI_COMM_WORLD,IERR)
call MPI_BCAST(levm,1,MPI_LOGICAL,0,MPI_COMM_WORLD,IERR)
@@ -157,7 +159,6 @@ subroutine read_input_file
call MPI_BCAST(vartin,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,IERR)
call MPI_BCAST(conin,1,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,IERR)
-
call MPI_BCAST(convective_scheme,1,MPI_INTEGER,0,MPI_COMM_WORLD,IERR)
call MPI_BCAST(limiter,20,MPI_CHARACTER,0,MPI_COMM_WORLD,IERR)
@@ -171,7 +172,6 @@ subroutine read_input_file
call MPI_BCAST(nzapis,1,MPI_INTEGER,0,MPI_COMM_WORLD,IERR)
call MPI_BCAST(maxit,1,MPI_INTEGER,0,MPI_COMM_WORLD,IERR)
-
call MPI_BCAST(lstsq,1,MPI_LOGICAL,0,MPI_COMM_WORLD,IERR)
call MPI_BCAST(lstsq_qr,1,MPI_LOGICAL,0,MPI_COMM_WORLD,IERR)
call MPI_BCAST(lstsq_dm,1,MPI_LOGICAL,0,MPI_COMM_WORLD,IERR)
@@ -182,7 +182,6 @@ subroutine read_input_file
call MPI_BCAST(simple,1,MPI_LOGICAL,0,MPI_COMM_WORLD,IERR)
call MPI_BCAST(piso,1,MPI_LOGICAL,0,MPI_COMM_WORLD,IERR)
- call MPI_BCAST(pimple,1,MPI_LOGICAL,0,MPI_COMM_WORLD,IERR)
call MPI_BCAST(ncorr,1,MPI_INTEGER,0,MPI_COMM_WORLD,IERR)
call MPI_BCAST(const_mflux,1,MPI_LOGICAL,0,MPI_COMM_WORLD,IERR)
@@ -192,12 +191,12 @@ subroutine read_input_file
! Izgubi mu se pojam koji je process rank pa moram ovo da pozovem:
call MPI_COMM_RANK( MPI_COMM_WORLD, myid, ierr )
-
-if (myid .eq. 0) then
- write(6,*)' '
- write(6,*)' Finished reading and broadcasting input data.'
- write(6,*)' '
-endif
+
+ if (myid .eq. 0) then
+ write(6,'(a)')' '
+ write(6,'(a)')' **Finished reading and broadcasting input data.**'
+ write(6,'(a)')' '
+ endif
!
@@ -208,39 +207,40 @@ subroutine read_input_file
!
! Convective scheme:
!
- if(adjustl(convective_scheme) == 'central') then
- lcds = .true.
- elseif(adjustl(convective_scheme) == 'cds-corrected') then
- lcdsc = .true.
- elseif(adjustl(convective_scheme) == 'linear') then
- lluds = .true.
- elseif(adjustl(convective_scheme) == 'smart') then
- lsmart = .true.
- elseif(adjustl(convective_scheme) == 'avl-smart') then
- lavl = .true.
- elseif(adjustl(convective_scheme) == 'muscl') then
- lmuscl = .true.
- elseif(adjustl(convective_scheme) == 'umist') then
- lumist = .true.
- elseif(adjustl(convective_scheme) == 'koren') then
- lkoren = .true.
- elseif(adjustl(convective_scheme) == 'charm') then
- lcharm = .true.
- elseif(adjustl(convective_scheme) == 'ospre') then
- lospre = .true.
- elseif(adjustl(convective_scheme) == 'central-f') then
- lcds_flnt = .true.
- elseif(adjustl(convective_scheme) == 'linear-f') then
- l2nd_flnt = .true.
- elseif(adjustl(convective_scheme) == 'muscl-f') then
- lmuscl_flnt = .true.
- else
- if (myid .eq. 0) then
- write(*,'(a)') ' Convective scheme not chosen, assigning default muscl scheme'
- endif
- convective_scheme = 'muscl'
- endif
-
+ select case(convective_scheme)
+
+ case ('central')
+ lcds = .true.
+ case ('cds-corrected')
+ lcdsc = .true.
+ case ('linear')
+ lluds = .true.
+ case ('smart')
+ lsmart = .true.
+ case ('avl-smart')
+ lavl = .true.
+ case ('muscl')
+ lmuscl = .true.
+ case ('umist')
+ lumist = .true.
+ case ('koren')
+ lkoren = .true.
+ case ('charm')
+ lcharm = .true.
+ case ('ospre')
+ lospre = .true.
+ case ('central-f')
+ lcds_flnt = .true.
+ case ('linear-f')
+ l2nd_flnt = .true.
+ case('muscl-f')
+ lmuscl_flnt = .true.
+ case default
+ if (myid .eq. 0) write(*,'(a)') ' Using default convective scheme - 2nd order upwind.'
+ l2nd_flnt = .true.
+
+ end select
+
! Set value for flux_limiter logical
if(lluds.or.lsmart.or.lavl.or.lmuscl.or.lumist.or.lkoren.or.lcharm.or.lospre) then
flux_limiter = .true.
@@ -253,47 +253,47 @@ subroutine read_input_file
write(*,'(2a)') ' Convective scheme: ', adjustl(convective_scheme)
write(*,'(a)') ' '
- !
- ! Gradient limiter:
- !
+ !
+ ! Gradient limiter:
+ !
if(adjustl(limiter) == 'Barth-Jespersen') then
- write(*,*) ' Gradient limiter: Barth-Jespersen'
+ write(*,'(a)') ' Gradient limiter: Barth-Jespersen'
elseif(adjustl(limiter) == 'Venkatakrishnan') then
- write(*,*) ' Gradient limiter: Venkatakrishnan'
+ write(*,'(a)') ' Gradient limiter: Venkatakrishnan'
elseif(adjustl(limiter) == 'mVenkatakrishnan') then
- write(*,*) ' Gradient limiter: Wang modified Venkatakrishnan'
+ write(*,'(a)') ' Gradient limiter: Wang modified Venkatakrishnan'
elseif(adjustl(limiter) == 'MDL') then
- write(*,*) ' Gradient limiter: Multidimensional'
+ write(*,'(a)') ' Gradient limiter: Multidimensional'
- else!if(adjustl(limiter) == 'no-limit') then
+ else !if(adjustl(limiter) == 'no-limit') then
- write(*,*) ' Gradient limiter: no-limit'
+ write(*,'(a)') ' Gradient limiter: no-limit'
endif
write(*,'(a)') ' '
- !
- ! Time stepping algorithm:
- !
+ !
+ ! Time stepping algorithm:
+ !
if( bdf ) then
-
- write(*,*) ' Time stepping method: Euler Implicit'
+ write(*,'(a)') ' Time stepping method: Euler Implicit'
elseif(bdf2) then
+ write(*,'(a)') ' Backward-Differentiation of 2nd order - BDF2'
- write(*,*) ' Time stepping method: Three Level Implicit Time Integration (BDF2)'
+ elseif(bdf2) then
+ write(*,'(a)') ' Backward-Differentiation of 3nd order - BDF3'
elseif( cn ) then
-
- write(*,*) ' Time stepping method: Crank-Nicolson'
+ write(*,'(a)') ' Time stepping method: Crank-Nicolson'
endif
@@ -303,21 +303,27 @@ subroutine read_input_file
!
! Open files for data at monitoring points
!
- if(ltransient) then
- open(unit=89,file=trim(out_folder_path)//'/transient_monitoring_points')
+
+ if( ltransient ) then
+
+ ! nproc_char <- myid zapisan levo u vidu stringa.
+ call i4_to_s_left ( myid, nproc_char )
+ open(unit=89,file='processor'//trim(nproc_char)//'/monitoring_points')
rewind 89
- do imon=1,mpoints
- write(trpn,'(i2)') imon
- open(91+imon,file=trim(out_folder_path)//"/transient_monitor_point_"//trpn, access='append')
- if(.not.lread) rewind(91+imon)
+
+ read(89,*) mpoints
+
+ do i=1,mpoints
+
+ read(89,*) imon
+
+ write(trpn,'(i0)') imon
+ open(91+imon,file="transient_monitor_point_"//adjustl(trim(trpn)), access='append')
+ if(.not.lreadstat) rewind(91+imon)
+
end do
+
end if
- !
- ! Pressure reference cell
- !
- iPrefProcess = 0
- pRefCell = 1
-
end subroutine
\ No newline at end of file
diff --git a/src-par/readfiles.f90 b/src-par/readfiles.f90
index 1aa69e4..7dff503 100644
--- a/src-par/readfiles.f90
+++ b/src-par/readfiles.f90
@@ -21,7 +21,10 @@ subroutine readfiles
!***********************************************************************
!
- if( myid.eq.0 ) write(6,*)'=*=*= Reading simulation restart files. =*=*='
+ if( myid.eq.0 ) then
+ write(6,'(a)') ' '
+ write(6,'(a)') ' **Reading simulation restart files.'
+ endif
! NOTE: nproc_char <- this (=myid + 1) written as left aligned string.
call i4_to_s_left ( myid, nproc_char )
@@ -43,12 +46,13 @@ subroutine readfiles
read(restart_unit) ed
read(restart_unit) t
read(restart_unit) vis
- read(restart_unit) uu
- read(restart_unit) vv
- read(restart_unit) ww
- read(restart_unit) uv
- read(restart_unit) uw
- read(restart_unit) vw
+ read(restart_unit) visw
+ ! read(restart_unit) uu
+ ! read(restart_unit) vv
+ ! read(restart_unit) ww
+ ! read(restart_unit) uv
+ ! read(restart_unit) uw
+ ! read(restart_unit) vw
read(restart_unit) uo
read(restart_unit) vo
read(restart_unit) wo
@@ -59,38 +63,19 @@ subroutine readfiles
rewind restart_unit
close (restart_unit)
- !
- ! > Exchange the values at process boundaries
- !
- call exchange(u)
- call exchange(v)
- call exchange(w)
- call exchange(p)
- call exchange(flmass)
- call exchange(te)
- call exchange(ed)
- call exchange(t)
- call exchange(vis)
-
! Initialize pressure correction with current pressure field.
pp = p
!------------------------------------------------
! [read statistics after first collection: ]
!------------------------------------------------
- if (ltransient) then
+ if (ltransient .and. lreadstat) then
call get_unit ( statistics_file )
- open(unit=statistics_file,file=trim(out_folder_path)//'/statistics') ! <- u_aver, v_aver,... are here, statistics restart file 2
-
+ open( unit=statistics_file, file='statistics'//'-'//trim(nproc_char), form='unformatted' )
rewind statistics_file
-
- read(statistics_file,*) n_sample
- read(statistics_file,*) u_aver,v_aver,w_aver, &
- uu_aver,vv_aver,ww_aver, &
- uv_aver,uw_aver,vw_aver, &
- te_aver
+ read(statistics_file) n_sample,u_aver,v_aver,w_aver,uu_aver,vv_aver,ww_aver,uv_aver,uw_aver,vw_aver,te_aver
close ( statistics_file )
endif
diff --git a/src-par/recirculate_flow.f90 b/src-par/recirculate_flow.f90
new file mode 100644
index 0000000..966ed54
--- /dev/null
+++ b/src-par/recirculate_flow.f90
@@ -0,0 +1,174 @@
+subroutine recirculate_flow
+
+ use types
+ use parameters
+ use geometry
+ use variables
+ use my_mpi_module
+ use mpi
+
+ implicit none
+
+ integer :: i,ib,ini,iface
+ integer :: IDInlet, IDOutlet,idtmp
+ integer :: asize
+ integer :: iDFriend
+ integer :: rectag,sendtag
+ integer :: length
+ integer :: status(mpi_status_size)
+ real(dp) :: buf(7*lenbuf)
+ logical :: IhaveInlet = .false.
+ logical :: IhaveOutlet = .false.
+
+ asize = 0
+ IDOutlet= -1
+ IDInlet = -1
+
+ ! syncronization before communication
+ call MPI_Barrier(MPI_COMM_WORLD,ierr)
+
+ ! Idi po granicama, ako imas OUTLET onda si ti taj koji treba da posalje
+ ! obavesti ostale ko si preko broadcasta.
+ do ib=1,numBoundaries
+ if ( bctype(ib) == 'outlet' ) then
+
+ IhaveOutlet = .true.
+ IDOutlet = myid
+
+ asize = nfaces(ib)
+ ! Javio si svoj identitet sad napuni buffer i pripremi se za komunikaciju
+ do i=1,nfaces(ib)
+ iface = startFace(ib) + i
+ ini = iBndValueStart(ib) + i
+ buf(i) = u(ini)
+ buf( asize+i) = v(ini)
+ buf(2*asize+i) = w(ini)
+ buf(3*asize+i) = te(ini)
+ buf(4*asize+i) = ed(ini)
+ buf(5*asize+i) = vis(ini)
+ buf(6*asize+i) = flmass(iface)
+ end do
+
+ endif
+ enddo
+
+ call mpi_allreduce &
+ (IDOutlet, & ! send buffer
+ idtmp, & ! recv buffer
+ 1, & ! length
+ mpi_integer, & ! datatype
+ mpi_max, & ! operation
+ mpi_comm_world, & ! communicator
+ ierr)
+
+ IDOutlet = idtmp
+
+! print*, 'We know who is outlet:', IDOutlet
+
+ ! Idi po granicama, ako imas INLET onda si ti taj koji treba da posalje
+ ! obavesti ostale ko si preko broadcasta.
+ do ib=1,numBoundaries
+ if ( bctype(ib) == 'inlet' ) then
+
+ IhaveInlet = .true.
+ IDInlet = myid
+
+ asize = nfaces(ib)
+ ! Javio si svoj identitet sad napuni buffer i pripremi se za komunikaciju
+ do i=1,nfaces(ib)
+ iface = startFace(ib) + i
+ ini = iBndValueStart(ib) + i
+ buf(i) = u(ini)
+ buf( asize+i) = v(ini)
+ buf(2*asize+i) = w(ini)
+ buf(3*asize+i) = te(ini)
+ buf(4*asize+i) = ed(ini)
+ buf(5*asize+i) = vis(ini)
+ buf(6*asize+i) = flmass(iface)
+ end do
+ endif
+ enddo
+
+ ! Communicate to others
+ call mpi_allreduce &
+ (IDInlet, & ! send buffer
+ idtmp, & ! recv buffer
+ 1, & ! length
+ mpi_integer, & ! datatype
+ mpi_max, & ! operation
+ mpi_comm_world, & ! communicator
+ ierr)
+
+ IDInlet = idtmp
+ ! print*, 'We know who is inlet:', IDInlet
+
+ ! Ucestvujes u exchange-u ako si bilo koji od ova dva
+ if (IhaveInlet .or. IhaveOutlet) then
+
+ if (IhaveInlet) iDFriend = IDOutlet
+ if (IhaveOutlet) iDFriend = IDInlet
+
+ sendtag = 123 + MYID + iDFriend ! tag for sending
+ rectag = sendtag ! tag for receiving
+
+ length = 7*asize
+ ! print*, 'packed now sending!'
+
+ call MPI_SENDRECV_REPLACE &
+ (buf, & ! buffer
+ length, & ! length
+ MPI_DOUBLE_PRECISION, & ! datatype
+ iDFriend, & ! dest,
+ sendtag, & ! sendtag,
+ iDFriend, & ! source,
+ rectag, & ! recvtag,
+ MPI_COMM_WORLD, & ! communicator
+ status, & ! status
+ ierr) ! error
+
+ endif
+
+ ! print*, 'Done exchange.'
+
+ if ( IhaveOutlet ) then
+ do ib=1,numBoundaries
+ if ( bctype(ib) == 'outlet' ) then
+ ! print*, 'Inside Outlet.'
+ do i=1,nfaces(ib)
+ iface = startFace(ib) + i
+ ini = iBndValueStart(ib) + i
+ u(ini) = buf(i)
+ v(ini) = buf( asize+i)
+ w(ini) = buf(2*asize+i)
+ te(ini) = buf(3*asize+i)
+ ed(ini) = buf(4*asize+i)
+ vis(ini) = buf(5*asize+i)
+ flmass(iface) = buf(6*asize+i)
+ end do
+ endif
+ enddo
+ endif
+
+ if ( IhaveInlet ) then
+ do ib=1,numBoundaries
+ if ( bctype(ib) == 'inlet' ) then
+ ! print*, 'Inside inlet.'
+ do i=1,nfaces(ib)
+ iface = startFace(ib) + i
+ ini = iBndValueStart(ib) + i
+ u(ini) = buf(i)
+ v(ini) = buf( asize+i)
+ w(ini) = buf(2*asize+i)
+ te(ini) = buf(3*asize+i)
+ ed(ini) = buf(4*asize+i)
+ vis(ini) = buf(5*asize+i)
+ ! flmass(iface) = buf(6*asize+i)
+ flmass(iface) = den(ini)*(arx(iface)*u(ini)+ary(iface)*v(ini)+arz(iface)*w(ini))
+ end do
+ endif
+ enddo
+ endif
+
+ if (myid == 0) write(*,'(a)') ' **Recycled flow on periodic boundaries.'
+
+end subroutine
\ No newline at end of file
diff --git a/src-par/recirculate_flow_periodichill.f90 b/src-par/recirculate_flow_periodichill.f90
new file mode 100644
index 0000000..04b172f
--- /dev/null
+++ b/src-par/recirculate_flow_periodichill.f90
@@ -0,0 +1,99 @@
+subroutine recirculate_flow
+
+ use types
+ use parameters
+ use geometry
+ use variables
+ use my_mpi_module
+ use mpi
+
+ implicit none
+
+ integer :: i,ib,ini,iface
+ integer :: asize
+ integer :: iDFriend
+ integer :: rectag,sendtag
+ integer :: length
+ integer :: status(mpi_status_size)
+ real(dp) :: buf(6*lenbuf)
+
+
+ asize = 4800
+
+ ! Exchange
+ if (myid.eq.0) iDFriend = 1
+ if (myid.eq.1) iDFriend = 0
+ if (myid.eq.2) iDFriend = 3
+ if (myid.eq.3) iDFriend = 2
+
+ sendtag = 123 + MYID + iDFriend ! tag for sending
+ rectag = sendtag ! tag for receiving
+
+ length = 6*asize
+
+ ! syncronization before communication
+ call MPI_Barrier(MPI_COMM_WORLD,ierr)
+
+
+ if ( myid.eq.1 .or. myid.eq.3 ) then
+ do ib=1,numBoundaries
+ if ( bctype(ib) == 'outlet' ) then
+ asize = nfaces(ib)
+ do i=1,nfaces(ib)
+ iface = startFace(ib) + i
+ ini = iBndValueStart(ib) + i
+ buf(i) = u(ini)
+ buf( asize+i) = v(ini)
+ buf(2*asize+i) = w(ini)
+ buf(3*asize+i) = te(ini)
+ buf(4*asize+i) = ed(ini)
+ buf(5*asize+i) = vis(ini)
+ end do
+ endif
+ enddo
+
+ call MPI_SEND( &
+ buf, &
+ length, &
+ MPI_DOUBLE_PRECISION, &
+ iDFriend, &
+ sendtag, &
+ MPI_COMM_WORLD, &
+ ierr)
+
+ endif
+
+
+ if ( myid.eq.0 .or. myid.eq.2 ) then
+
+ call MPI_RECV( &
+ buf, & ! buffer
+ length, & ! length
+ MPI_DOUBLE_PRECISION, & ! datatype
+ iDFriend, & ! source,
+ rectag, & ! recvtag,
+ MPI_COMM_WORLD, & ! communicator
+ status, & ! status
+ ierr) ! error
+
+ do ib=1,numBoundaries
+ if ( bctype(ib) == 'inlet' ) then
+ do i=1,nfaces(ib)
+ iface = startFace(ib) + i
+ ini = iBndValueStart(ib) + i
+ u(ini) = buf(i)
+ v(ini) = buf( asize+i)
+ w(ini) = buf(2*asize+i)
+ te(ini) = buf(3*asize+i)
+ ed(ini) = buf(4*asize+i)
+ vis(ini) = buf(5*asize+i)
+ flmass(iface) = den(ini)*(arx(iface)*u(ini)+ary(iface)*v(ini)+arz(iface)*w(ini))
+ end do
+ endif
+ enddo
+ endif
+
+ if (myid == 0) write(*,'(a)') ' **Recycled flow on periodic boundaries.'
+
+
+end subroutine
\ No newline at end of file
diff --git a/src-par/recirculate_flow_stenosis.f90 b/src-par/recirculate_flow_stenosis.f90
new file mode 100644
index 0000000..74aae3f
--- /dev/null
+++ b/src-par/recirculate_flow_stenosis.f90
@@ -0,0 +1,95 @@
+subroutine recirculate_flow
+
+ use types
+ use parameters
+ use geometry
+ use variables
+ use my_mpi_module
+ use mpi
+
+ implicit none
+
+ integer :: i,ib,ini,iface
+ integer :: asize
+ integer :: iDFriend
+ integer :: rectag,sendtag
+ integer :: length
+ integer :: status(mpi_status_size)
+ real(dp) :: buf(5*lenbuf)
+
+
+ asize = 4089
+
+ ! Exchange
+ if (myid.eq.0) iDFriend = 3
+ if (myid.eq.3) iDFriend = 0
+
+ sendtag = 123 + MYID + iDFriend ! tag for sending
+ rectag = sendtag ! tag for receiving
+
+ length = 5*asize
+
+ ! syncronization before communication
+ call MPI_Barrier(MPI_COMM_WORLD,ierr)
+
+
+ if ( myid.eq.3 ) then
+ do ib=1,numBoundaries
+ if ( bctype(ib) == 'outlet' ) then
+ asize = nfaces(ib)
+ do i=1,nfaces(ib)
+ iface = startFace(ib) + i
+ ini = iBndValueStart(ib) + i
+ buf(i) = u(ini)
+ buf( asize+i) = v(ini)
+ buf(2*asize+i) = w(ini)
+ buf(3*asize+i) = te(ini)
+ buf(4*asize+i) = vis(ini)
+ end do
+ endif
+ enddo
+
+ call MPI_SEND( &
+ buf, &
+ length, &
+ MPI_DOUBLE_PRECISION, &
+ iDFriend, &
+ sendtag, &
+ MPI_COMM_WORLD, &
+ ierr)
+
+ endif
+
+
+ if ( myid.eq.0 ) then
+
+ call MPI_RECV( &
+ buf, & ! buffer
+ length, & ! length
+ MPI_DOUBLE_PRECISION, & ! datatype
+ iDFriend, & ! source,
+ rectag, & ! recvtag,
+ MPI_COMM_WORLD, & ! communicator
+ status, & ! status
+ ierr) ! error
+
+ do ib=1,numBoundaries
+ if ( bctype(ib) == 'inlet' ) then
+ do i=1,nfaces(ib)
+ iface = startFace(ib) + i
+ ini = iBndValueStart(ib) + i
+ u(ini) = buf(i)
+ v(ini) = buf( asize+i)
+ w(ini) = buf(2*asize+i)
+ te(ini) = buf(3*asize+i)
+ vis(ini) = buf(4*asize+i)
+ flmass(iface) = den(ini)*(arx(iface)*u(ini)+ary(iface)*v(ini)+arz(iface)*w(ini))
+ end do
+ endif
+ enddo
+ endif
+
+ if (myid == 0) write(*,'(a)') ' **Recycled flow on periodic boundaries.'
+
+
+end subroutine
\ No newline at end of file
diff --git a/src-par/scalar_fluxes.f90 b/src-par/scalar_fluxes.f90
index e6cb881..9956bb9 100644
--- a/src-par/scalar_fluxes.f90
+++ b/src-par/scalar_fluxes.f90
@@ -100,7 +100,8 @@ subroutine facefluxsc(ijp, ijn, xf, yf, zf, arx, ary, arz, &
! Difusion coefficient for linear system
- de = game*are/dpn
+ ! de = game*are/dpn
+ de = game * (arx*arx+ary*ary+arz*arz)/(xpn*arx+ypn*ary+zpn*arz)
! Convection fluxes - uds
fm = flmass
@@ -246,7 +247,8 @@ subroutine facefluxsc_nonconst_prtr(ijp, ijn, xf, yf, zf, arx, ary, arz, &
! Difusion coefficient for linear system
- de = game*are/dpn
+ ! de = game*are/dpn
+ de = game * (arx*arx+ary*ary+arz*arz)/(xpn*arx+ypn*ary+zpn*arz)
! Convection fluxes - uds
fm = flmass
@@ -458,45 +460,9 @@ subroutine facefluxsc_boundary(ijp, ijn, xf, yf, zf, arx, ary, arz, &
cap = -de - max(fm,zero)
can = -de + min(fm,zero)
- ! if(lcds) then
- ! !---------------------------------------------
- ! ! CENTRAL DIFFERENCING SCHEME (CDS)
- ! !---------------------------------------------
- ! ! Interpolate variable FI defined at CV centers to face using corrected CDS:
- ! ! |________Ue'___________|_______________Ucorr_____________________|
- ! fii=fi(ijp)*fxp+fi(ijn)*fxn!+dfixi*(xf-xi)+dfiyi*(yf-yi)+dfizi*(zf-zi)
-
- ! ! Explicit second order convection
- ! fcfie=fm*fii
- ! else
- ! !---------------------------------------------
- ! ! Darwish-Moukalled TVD schemes for unstructured grids, IJHMT, 2003.
- ! !---------------------------------------------
- ! ! Find r's - the gradient ratio. This is universal for all schemes.
- ! ! If flow goes from P to E
- ! r1 = (2*dFidxi(1,ijp)*xpn + 2*dFidxi(2,ijp)*ypn + 2*dFidxi(3,ijp)*zpn)/(FI(ijn)-FI(ijp)) - 1.0_dp
- ! ! If flow goes from E to P
- ! r2 = (2*dFidxi(1,ijn)*xpn + 2*dFidxi(2,ijn)*ypn + 2*dFidxi(3,ijn)*zpn)/(FI(ijp)-FI(ijn)) - 1.0_dp
- ! ! Find Psi for [ MUSCL ] :
- ! psiw = max(0., min(2.*r1, 0.5*r1+0.5, 2.))
- ! psie = max(0., min(2.*r2, 0.5*r2+0.5, 2.))
- ! ! High order flux at cell face
- ! fcfie = ce*(fi(ijn) + fxn*psie*(fi(ijp)-fi(ijn)))+ &
- ! cp*(fi(ijp) + fxp*psiw*(fi(ijn)-fi(ijp)))
- ! endif
-
- ! ! Explicit first order convection
- ! fcfii = ce*fi(ijn)+cp*fi(ijp)
-
- ! Deffered correction for convection = gama_blending*(high-low)
- !ffic = gam*(fcfie-fcfii)
-
- !-------------------------------------------------------
! Explicit part of fluxes
- !-------------------------------------------------------
- ! suadd = -ffic+fdfie-fdfii
suadd = fdfie-fdfii
- !-------------------------------------------------------
+
end subroutine
diff --git a/src-par/spalart_allmaras.f90 b/src-par/spalart_allmaras.f90
index 2439c62..130dd5d 100644
--- a/src-par/spalart_allmaras.f90
+++ b/src-par/spalart_allmaras.f90
@@ -186,7 +186,7 @@ subroutine calcsc(Fi,dFidxi,ifi)
!=====================================
! UNSTEADY TERM
!=====================================
- if( bdf ) then
+ if( bdf .or. cn ) then
apotime = den(inp)*vol(inp)/timestep
su(inp) = su(inp) + apotime*teo(inp)
sp(inp) = sp(inp) + apotime
diff --git a/src-par/temperature.f90 b/src-par/temperature.f90
index 1ec96cd..510adae 100644
--- a/src-par/temperature.f90
+++ b/src-par/temperature.f90
@@ -91,7 +91,7 @@ subroutine calcsc(Fi,dFidxi,ifi)
do inp=1,numCells
! Unsteady Term
- if( bdf ) then
+ if( bdf .or. cn ) then
apotime = den(inp)*vol(inp)/timestep
su(inp) = su(inp) + apotime*to(inp)
sp(inp) = sp(inp) + apotime
diff --git a/src-par/time_shift.f90 b/src-par/time_shift.f90
index 16c26d9..e64536c 100644
--- a/src-par/time_shift.f90
+++ b/src-par/time_shift.f90
@@ -6,7 +6,7 @@ subroutine time_shift
implicit none
- if( bdf ) then
+ if( bdf .or. cn ) then
uo = u
vo = v
@@ -16,10 +16,10 @@ subroutine time_shift
if (lcal(ien)) to = t
if (lcal(ivart)) varto = vart
if (lcal(icon)) cono = con
- if (piso) then
- flmasso = flmass
- po = p
- endif
+ ! if (piso) then
+ ! flmasso = flmass
+ ! po = p
+ ! endif
elseif( bdf2 ) then
@@ -31,10 +31,10 @@ subroutine time_shift
if (lcal(ien)) too = to
if (lcal(ivart)) vartoo = varto
if (lcal(icon)) conoo = cono
- if (piso) then
- flmassoo = flmasso
- poo = po
- endif
+ ! if (piso) then
+ ! flmassoo = flmasso
+ ! poo = po
+ ! endif
uo = u
vo = v
@@ -44,10 +44,10 @@ subroutine time_shift
if (lcal(ien)) to = t
if (lcal(ivart)) varto = vart
if (lcal(icon)) cono = con
- if (piso) then
- flmasso = flmass
- po = p
- endif
+ ! if (piso) then
+ ! flmasso = flmass
+ ! po = p
+ ! endif
elseif( bdf3 ) then
diff --git a/src-par/updateVelocityAtBoundary.f90 b/src-par/updateVelocityAtBoundary.f90
index 3dd2b85..7252547 100644
--- a/src-par/updateVelocityAtBoundary.f90
+++ b/src-par/updateVelocityAtBoundary.f90
@@ -17,7 +17,8 @@ subroutine updateVelocityAtBoundary
! Local variables
!
integer :: i,ijp,ijb,ib,iface
- real(dp) :: Unmag,flowo,fac
+ real(dp) :: Unmag,flowo
+ real(dp) :: fac
! Update velocity components along outlet boundaries
! and correct mass flux to satisfy global mass conservation
diff --git a/src-par/utils.f90 b/src-par/utils.f90
index 234915b..4ca1069 100644
--- a/src-par/utils.f90
+++ b/src-par/utils.f90
@@ -18,6 +18,16 @@ subroutine show_logo
call timestamp ()
+write(6,'(a)')' '
+write(6,'(a)')' __ _____ _ '
+write(6,'(a)')' / _| / ____| (_) '
+write(6,'(a)')' | |_ _ __ ___ ___| | __ _ _ __ _ __ _ _ ___ ___ _ _ __ ___ '
+write(6,'(a)')" | _| '__/ _ \/ _ \ | / _` | '_ \| '_ \| | | |/ __/ __| | '_ \ / _ \ "
+write(6,'(a)')' | | | | | __/ __/ |___| (_| | |_) | |_) | |_| | (_| (__| | | | | (_) | '
+write(6,'(a)')' |_| |_| \___|\___|\_____\__,_| .__/| .__/ \__,_|\___\___|_|_| |_|\___/ '
+write(6,'(a)')' | | | | '
+write(6,'(a)')' |_| |_| '
+write(6,'(a)')' '
write(6,'(a)')' '
write(6,'(a)')' MM MMM'
write(6,'(a)')' NMN. MM'
diff --git a/src-par/vortexIdentification.f90 b/src-par/vortexIdentification.f90
new file mode 100644
index 0000000..1b12b96
--- /dev/null
+++ b/src-par/vortexIdentification.f90
@@ -0,0 +1,211 @@
+module vortexIdentification
+!
+! Purpose:
+! Module contains functions for extracting coherent vortex structures in the flow.
+! Description:
+! We include several well known methods such as identification using Q-critera,
+! $\lambda_2$ (Jeong&Hussain JFM 1995), and other.
+!
+! Author: Nikola Mirkov
+! Email: nikolamirkov@yahoo.com
+!
+! Modified:
+! Apr 10, 2020.
+!
+! This is a part of freeCappuccino.
+! The code is licenced under GPL licence.
+!
+use types
+use geometry
+use variables, only: dUdxi,dVdxi,dWdxi
+
+implicit none
+
+real(dp), dimension(:), allocatable :: Qvortex
+real(dp), dimension(:), allocatable :: lambda2
+
+public
+
+contains
+
+subroutine setQvortex
+!
+! Calculates so called Q criteria field, defined by Q = 1/2 * (S^2 - Omega^2).
+! If Q > 0, vortical motion exists.
+! Iso-surfaces of this field define coherent structures that approximate vortices in the flow field.
+!
+ implicit none
+
+ integer :: inp
+ real(dp) :: dudx,dudy,dudz,dvdx,dvdy,dvdz,dwdx,dwdy,dwdz
+ real(dp) :: s11,s12,s13,s22,s23,s33,w12,w13,w23
+ real(dp) :: magVorticitySq,magStrainSq
+
+ if( .not.allocated( Qvortex ) ) then
+ allocate( Qvortex(numCells) )
+ endif
+
+ do inp=1,numCells
+
+ dudx = dudxi(1,inp)
+ dudy = dudxi(2,inp)
+ dudz = dudxi(3,inp)
+
+ dvdx = dvdxi(1,inp)
+ dvdy = dvdxi(2,inp)
+ dvdz = dvdxi(3,inp)
+
+ dwdx = dwdxi(1,inp)
+ dwdy = dwdxi(2,inp)
+ dwdz = dwdxi(3,inp)
+
+ ! Find strain rate tensor
+ ! [s_ij]: |s_ij|=sqrt[2s_ij s_ij]
+ s11=dudx
+ s12=0.5*(dudy+dvdx)
+ s13=0.5*(dudz+dwdx)
+ s22=dvdy
+ s23=0.5*(dvdz+dwdy)
+ s33=dwdz
+
+ ! Find antisymmetric part of velocity gradient tensor
+ ! [om_ij]: |om_ij|=sqrt[2 om_ij om_ij]
+ w12=(dudy - dvdx)
+ w13=(dudz - dwdx)
+ w23=(dvdz - dwdy)
+
+
+ ! Find strain rate squared s^2 = 2*sij*sij
+ magStrainSq = 2*(s11**2+s22**2+s33**2 + 2*(s12**2+s13**2+s23**2))
+
+ ! Find Vorticity mag squared Om^2 = 2*wij*wij
+ magVorticitySq = (w12**2 + w23**2 + w13**2)
+
+ Qvortex(inp) = 0.5_dp*( magVorticitySq - magStrainSq )
+
+ enddo
+
+end subroutine
+
+
+subroutine setLambda2
+!
+! Compute second largest eigenvalue of (Sik*Skj + Wik*Wkj) tensor.
+! Return the array of -$\lambda_2$ values.
+! Iso-surfaces of this field define coherent structures that approximate vortices in the flow field.
+!
+! See Jeong and Hussain "On the identification of a vortex", JFM, 1995.
+!
+! This subroutine is based on Fluent UDF found on CFD-online forum:
+! https://www.cfd-online.com/Forums/main/99674-lambda-2-criterion.html
+!
+
+ implicit none
+
+ integer :: inp
+ real(dp) :: dudx,dudy,dudz,dvdx,dvdy,dvdz,dwdx,dwdy,dwdz
+ real(dp) :: s11,s12,s13,s22,s23,s33,w12,w13,w23
+ real(dp) :: a,b,c,d,i,j,k,m,n,p
+ real(dp) :: x,y,z,tmp
+ real(dp) :: P11,P12,P13,P22,P23,P33
+ real(dp) :: lambda(3)
+
+ if( .not.allocated( lambda2 ) ) then
+ allocate( lambda2(numCells) )
+ endif
+
+
+ do inp=1,numCells
+
+ dudx = dudxi(1,inp)
+ dudy = dudxi(2,inp)
+ dudz = dudxi(3,inp)
+
+ dvdx = dvdxi(1,inp)
+ dvdy = dvdxi(2,inp)
+ dvdz = dvdxi(3,inp)
+
+ dwdx = dwdxi(1,inp)
+ dwdy = dwdxi(2,inp)
+ dwdz = dwdxi(3,inp)
+
+ ! Find strain rate tensor
+ ! [s_ij]: |s_ij|=sqrt[2s_ij s_ij]
+ s11=dudx
+ s12=0.5*(dudy+dvdx)
+ s13=0.5*(dudz+dwdx)
+ s22=dvdy
+ s23=0.5*(dvdz+dwdy)
+ s33=dwdz
+
+ ! Find antisymmetric part of velocity gradient tensor
+ ! [om_ij]: |om_ij|=sqrt[2 om_ij om_ij]
+ w12=0.5*(dudy - dvdx)
+ w13=0.5*(dudz - dwdx)
+ w23=0.5*(dvdz - dwdy)
+
+
+ P11=S11*S11+S12*S12+S13*S13-W12*W12-W13*W13
+ P12=S12*(S11+S22)+S13*S23-W13*W23
+ P13=S13*(S11+S33)+S12*S23+W12*W23
+ P22=S12*S12+S22*S22+S23*S23-W12*W12-W23*W23
+ P23=S23*(S22+S33)+S12*S13-W12*W13
+ P33=S13*S13+S23*S23+S33*S33-W13*W13-W23*W23
+
+ ! Coefficients of the characteristic polynomial
+
+ ! a*lambda^3 + b*lambda^2 + c*lambda + d = 0
+
+ a=-1.0
+ b=P11+P22+P33
+ c=P12*P12+P13*P13+P23*P23-P11*P22-P11*P33-P22*P33
+ d=P11*P22*P33+2.0*P12*P13*P23-P12*P12*P33-P13*P13*P22-P23*P23*P11
+
+ ! Resolution of the cubic equation, eigenvalues assumed to be real
+
+ x=((3.0*c/a)-b*b/(a*a))/3.0
+ y=(2.0*b*b*b/(a*a*a)-9.0*b*c/(a*a)+27.0*d/a)/27.0
+ z=y*y/4.0+x*x*x/27.0
+
+ i=sqrt(y*y/4.0-z)
+ j=-i**(1.0/3.0)
+ k=acos(-(y/(2.0*i)))
+ m=cos(k/3.0)
+ n=sqrt(3.0)*sin(k/3.0)
+ p=b/(3.0*a)
+
+ lambda(1)=2.0*j*m+p
+ lambda(2)=-j*(m+n)+p
+ lambda(3)=-j*(m-n)+p
+
+ ! Ordering of the eigenvalues
+
+ if(lambda(2)>lambda(1)) then
+ tmp=lambda(2)
+ lambda(2)=lambda(1)
+ lambda(1)=tmp
+ endif
+
+ if(lambda(3)>lambda(2)) then
+
+ tmp=lambda(3)
+ lambda(3)=lambda(2)
+ lambda(2)=tmp
+
+ if(lambda(2)>lambda(1)) then
+ tmp=lambda(2)
+ lambda(2)=lambda(1)
+ lambda(1)=tmp
+ endif
+
+ endif
+
+ ! Retrieval of the second eigenvalue
+
+ lambda2(inp) = lambda(2)
+
+ enddo
+
+end subroutine
+
+end module
\ No newline at end of file
diff --git a/src-par/write_restart_files.f90 b/src-par/write_restart_files.f90
index 8458589..f5e7a03 100644
--- a/src-par/write_restart_files.f90
+++ b/src-par/write_restart_files.f90
@@ -40,12 +40,13 @@ subroutine write_restart_files
write(restart_unit) ed
write(restart_unit) t
write(restart_unit) vis
- write(restart_unit) uu
- write(restart_unit) vv
- write(restart_unit) ww
- write(restart_unit) uv
- write(restart_unit) uw
- write(restart_unit) vw
+ write(restart_unit) visw
+ ! write(restart_unit) uu
+ ! write(restart_unit) vv
+ ! write(restart_unit) ww
+ ! write(restart_unit) uv
+ ! write(restart_unit) uw
+ ! write(restart_unit) vw
write(restart_unit) uo
write(restart_unit) vo
write(restart_unit) wo
@@ -63,18 +64,13 @@ subroutine write_restart_files
call get_unit ( statistics_file )
- open(unit=statistics_file,file=trim(out_folder_path)//'/statistics') ! <- u_aver, v_aver,... are here, statistics restart file 2
+ open( unit=statistics_file, file='statistics'//'-'//trim(nproc_char), form='unformatted' )
rewind statistics_file
-
- write(statistics_file,*) n_sample
- write(statistics_file,*) u_aver,v_aver,w_aver, &
- uu_aver,vv_aver,ww_aver, &
- uv_aver,uw_aver,vw_aver,te_aver, &
- te_aver
+ write(statistics_file) n_sample,u_aver,v_aver,w_aver,uu_aver,vv_aver,ww_aver,uv_aver,uw_aver,vw_aver,te_aver
close (statistics_file)
endif
- if( myid.eq.0 ) write(6,*)'=*=*= Simulation restart files have been written. =*=*='
+ if( myid.eq.0 ) write(6,*)' **Created simulation restart files.'
end subroutine
diff --git a/src-par/writefiles.f90 b/src-par/writefiles.f90
index 7dbd738..fdd9f05 100644
--- a/src-par/writefiles.f90
+++ b/src-par/writefiles.f90
@@ -2,7 +2,7 @@
!
subroutine writefiles
!
-! Write output files in Paraview .vtu format
+! Write output files in Paraview .vtm format
!
!***********************************************************************
!
@@ -15,82 +15,300 @@ subroutine writefiles
use sparse_matrix
use output
use utils, only: i4_to_s_left
+ use vortexIdentification
+ ! use mhd
implicit none
!
!***********************************************************************
!
- integer :: output_unit
- character( len = 5) :: nproc_char
-
- ! Write in a char variable current timestep number
- call i4_to_s_left ( itime, timechar )
-
+ character( len = 200 ) :: line
+ character( len = 4 ) :: nproc_char
+ character( len = 2 ) :: ch2
+
+ integer :: i,ib
+ integer :: istart, iend
+ integer :: stat
+ integer :: iWall
+ integer :: output_unit, mesh_file
+
+ ! Write in a char variable current timestep number and create a folder with this name
+ call i4_to_s_left ( itime, timechar )
! nproc_char <- myid zapisan levo u vidu stringa.
call i4_to_s_left ( myid, nproc_char )
- !+-----------------------------------------------------------------------------+
+ !+-----------------------------------------------------------------------------+
+
+ ! Open folder with data for postprocessing in Paraview
+ call execute_command_line('mkdir '//trim( timechar ) )
+ call execute_command_line('mkdir '//trim( timechar )//'/processor'//trim(nproc_char) )
+ call execute_command_line('mkdir '//trim( timechar )//'/processor'//trim(nproc_char)//'/boundary')
+
+!
+! > Open and write a .vtm file for multi-block datasets for interior + boundary regions data.
+!
+ call get_unit( output_unit )
+
+ open(unit=output_unit,file=trim( timechar )//'/solution_fields_proc'//trim( nproc_char )//'.vtm')
+
+ write ( output_unit, '(a)' ) ''
+ write ( output_unit, '(2x,a)' ) ''
+ write ( output_unit, '(4x,a)' ) ''
+ write ( output_unit, '(6x,a)' ) ''
+ write ( output_unit, '(8x,a)' ) ''
+ write ( output_unit, '(8x,a)' ) ''
+ write ( output_unit, '(6x,a)' ) ''
+ write ( output_unit, '(6x,a)' ) ''
+
+ do i=1,numBoundaries
+
+ call i4_to_s_left ( i-1, ch2 )
+
+ write ( output_unit, '(8x,a)' ) ''
+
+ write ( output_unit, '(8x,a)' ) ''
+
+ enddo ! Boundary loop
+
+ write ( output_unit, '(6x,a)' ) ''
+ write ( output_unit, '(4x,a)' ) ''
+ write ( output_unit, '(2x,a)' ) ''
+
+ close(output_unit)
+
+!
+! > Open and write a unstructuctured .vtu file for the interior cells
+!
+ call get_unit( output_unit )
+
+ open(unit=output_unit,file=trim(timechar)//'/processor'//trim(nproc_char)//'/interior.vtu')
+
+!
+! > Header
+!
+ call get_unit( mesh_file )
+ open( unit = mesh_file, file='processor'//trim(nproc_char)//'/vtk/mesh/mesh_0_0.vtu' )
+ rewind mesh_file
+
+ do i=1,6
+ read( mesh_file, '(a)' ) line! A line where numCells is.
+ write ( output_unit, '(a)' ) adjustl( line )
+ enddo
+
+!
+! > Vectors in cell-centers
+!
+
+ call vtu_write_XML_vector_field( output_unit, 'U', u, v, w )
+
+ ! if( lcal(iep) ) call vtu_write_XML_vector_field( output_unit, 'uxB', curix, curiy, curiz )
+
+
+!
+! > Scalars in cell-centers
+!
+
+ call vtu_write_XML_scalar_field ( output_unit, 'p', p )
+
+ if( lturb ) call vtu_write_XML_scalar_field ( output_unit, 'mueff', vis )
+
+ if(solveTKE) call vtu_write_XML_scalar_field ( output_unit, 'k', te )
+
+ if( solveEpsilon ) call vtu_write_XML_scalar_field ( output_unit, 'epsilon', ed )
+
+ if( solveOmega ) call vtu_write_XML_scalar_field ( output_unit, 'omega', ed )
+
+ if( lcal(ien) ) call vtu_write_XML_scalar_field ( output_unit, 'T', t )
+
+ ! if( lcal(iep) ) call vtu_write_XML_scalar_field ( output_unit, 'Epot', Epot )
+
+ !
+ ! > Time averaged fields in the interior
+ !
+ if(ltransient) then
+
+ call vtu_write_XML_vector_field( output_unit, 'Uavg', u_aver,v_aver,w_aver )
+ if(solveTKE) call vtu_write_XML_scalar_field ( output_unit, 'tkeAvg', te_aver )
+
+ if(lcal(ien) ) call vtu_write_XML_scalar_field ( output_unit, 'Tavg', t_aver )
+
+ endif
+
+
+ !
+ ! > Identification of vortices
+ !
+ if( lturb ) then
+ call setQvortex
+ call vtu_write_XML_scalar_field ( output_unit, 'Qcrit', Qvortex )
+ endif
+
+
+!
+! > Mesh data
+!
+ mesh_data_loop: do
+
+ read(mesh_file, '(a)', IOSTAT=stat) line
+
+ if ( stat < 0 ) then
+ exit mesh_data_loop
+ else
+ write ( output_unit, '(a)' ) adjustl( line )
+ cycle mesh_data_loop
+ endif
+
+ enddo mesh_data_loop
+
+ close( mesh_file )
+ close( output_unit )
+
+
+!
+! > Open and write a .vtm file for multi-block datasets ONLY for boundary regions data.
+!
call get_unit( output_unit )
- open(unit=output_unit,file='vtk/solution_fields_'//'proc_'//trim(nproc_char)//'_'//trim(timechar),form='unformatted')
+ open(unit=output_unit,file=trim(timechar)//'/boundary_proc'//trim(nproc_char)//'.vtm')
+
+ write ( output_unit, '(a)' ) ''
+ write ( output_unit, '(2x,a)' ) ''
+ write ( output_unit, '(4x,a)' ) ''
+ write ( output_unit, '(6x,a)' ) ''
+
+ do i=1,numBoundaries
+
+ call i4_to_s_left ( i-1, ch2 )
+
+ write ( output_unit, '(8x,a)' )''
+
+ write ( output_unit, '(8x,a)' ) ''
+
+ enddo ! Boundary loop
+
+ write ( output_unit, '(6x,a)' ) ''
+ write ( output_unit, '(4x,a)' ) ''
+ write ( output_unit, '(2x,a)' ) ''
+
+ close(output_unit)
+
+!
+! > Open and write a unstructuctured .vtp file for EACH boundary region.
+!
+ iWall = 1
+
+ do ib=1,numBoundaries
+
+ call get_unit( output_unit )
+
+ open(unit=output_unit,file=trim(timechar)//'/processor'//trim(nproc_char)//'/boundary/'//trim( bcname(ib) )//'.vtp')
+
+ !
+ ! > Header
+ !
+
+ ! Serial number of the specific boundary region - with it's own file
+ call i4_to_s_left ( ib, ch2 )
+
+ call get_unit( mesh_file )
+ open( unit = mesh_file, file='processor'//trim(nproc_char)//'/vtk/mesh/mesh_'//trim(ch2)//'_0.vtp' )
+ rewind mesh_file
+
+ do i=1,6
+ read(mesh_file, '(a)' ) line
+ write ( output_unit, '(a)' ) adjustl( line )
+ enddo
+
+
+ istart = iBndValueStart(ib) + 1
+ iend = iBndValueStart(ib) + nFaces(ib)
+
+ !
+ ! > Vectors in face-centers
+ !
+
+ call vtu_write_XML_vector_field_boundary( output_unit, 'U', u, v, w, istart, iend )
+
+ ! if( lcal(iep) ) call vtu_write_XML_vector_field_boundary( output_unit, 'uxB', curix, curiy, curiz, istart, iend )
+
+ !
+ ! > Scalars in face-centers
+ !
+
+ call vtu_write_XML_scalar_field_boundary ( output_unit, 'p', p, istart, iend )
+
+ if( lturb ) call vtu_write_XML_scalar_field_boundary ( output_unit, 'mueff', vis, istart, iend )
+
+ if(solveTKE) call vtu_write_XML_scalar_field_boundary ( output_unit, 'k', te, istart, iend )
+
+ if( solveEpsilon ) call vtu_write_XML_scalar_field_boundary ( output_unit, 'epsilon', ed, istart, iend )
+
+ if( solveOmega ) call vtu_write_XML_scalar_field_boundary ( output_unit, 'omega', ed, istart, iend )
- write(output_unit) numCells
- write(output_unit) numTotal
- write(output_unit) u
- write(output_unit) v
- write(output_unit) w
- write(output_unit) p
- write(output_unit) te
- write(output_unit) ed
- write(output_unit) vis
+ if( lcal(ien) ) call vtu_write_XML_scalar_field_boundary ( output_unit, 'T', t, istart, iend )
- ! Header
- ! call vtu_write_XML_header ( output_unit )
+ ! if( lcal(iep) ) call vtu_write_XML_scalar_field_boundary ( output_unit, 'Epot', Epot, istart, iend )
- ! !+-----------------------------------------------------------------------------+
- ! ! Write fields to VTU file
+ !
+ ! > Time averaged fields in the boundary
+ !
+ if(ltransient) then
- ! call vtu_write_XML_vector_field( output_unit, 'U', u, v, w )
+ call vtu_write_XML_vector_field_boundary ( output_unit, 'Uavg', u_aver,v_aver,w_aver, istart, iend )
+ if(solveTKE) call vtu_write_XML_scalar_field_boundary ( output_unit, 'tkeAvg', te_aver, istart, iend )
- ! call vtu_write_XML_scalar_field ( output_unit, 'p', p )
+ if(lcal(ien) ) call vtu_write_XML_scalar_field_boundary ( output_unit, 'Tavg', t_aver, istart, iend )
+ endif
- ! if( lturb ) then
- ! call vtu_write_XML_scalar_field ( output_unit, 'mueff', vis )
+ ! Write y+ and shear force at wall boundary regions
+ if ( bctype(ib) == 'wall' ) then
- ! endif
+ istart = iWall
+ iend = iWall + nFaces(ib)
+ call vtu_write_XML_scalar_field_boundary ( output_unit, 'ypl', ypl, iWall, iend )
- ! if(solveTKE) then
+ call vtu_write_XML_scalar_field_boundary ( output_unit, 'tau', tau, iWall, iend )
- ! call vtu_write_XML_scalar_field ( output_unit, 'k', te )
+ if(ltransient) call vtu_write_XML_scalar_field_boundary ( output_unit, 'tauAvg', wss_aver, iWall, iend )
- ! endif
+ iWall = iWall + nFaces(ib)
+ endif
- ! if( solveEpsilon ) then
- ! call vtu_write_XML_scalar_field ( output_unit, 'epsilon', ed )
+ !
+ ! > Mesh data
+ !
+ mesh_data_loop2: do
- ! endif
+ read(mesh_file, '(a)', IOSTAT=stat) line
+ if ( stat < 0 ) then
+ exit mesh_data_loop2
+ else
+ write ( output_unit, '(a)' ) adjustl( line )
+ cycle mesh_data_loop2
+ endif
+
+ enddo mesh_data_loop2
- ! if( solveOmega ) then
+ close( mesh_file )
+ close( output_unit )
- ! call vtu_write_XML_scalar_field ( output_unit, 'omega', ed )
+ enddo ! Boundary loop
- ! endif
- ! !+-----------------------------------------------------------------------------+
- ! Mesh data
- ! call vtu_write_XML_meshdata ( output_unit )
- ! close( output_unit )
+end subroutine
-end subroutine
\ No newline at end of file
diff --git a/src-par/writehistory.f90 b/src-par/writehistory.f90
index 1d07e18..c662234 100644
--- a/src-par/writehistory.f90
+++ b/src-par/writehistory.f90
@@ -15,16 +15,22 @@ subroutine writehistory
!
!***********************************************************************
!
- integer :: inp,imon
+ integer :: i,inp,imon
+
+ if(ltransient ) then
+
+ read(89,*) mpoints
+
+ do i=1,mpoints
+
+ read(89,*) imon,inp
+
+ write(91+imon,'(2x,1p7e14.5,2x)') time,u(inp),v(inp),w(inp),p(inp),te(inp),vis(inp)
- if(ltransient) then
- if( myid .eq. 0 ) then
- do imon=1,mpoints
- read(89,*) inp
- write(91+imon,'(2x,1p7e14.5,2x)') time,u(inp),v(inp),w(inp),te(inp),ed(inp)
end do
+
rewind 89
- endif
+
end if
end subroutine
diff --git a/src/cappuccino/constant_mass_flow_forcing.f90 b/src/cappuccino/constant_mass_flow_forcing.f90
index 10c9b59..79da0d1 100644
--- a/src/cappuccino/constant_mass_flow_forcing.f90
+++ b/src/cappuccino/constant_mass_flow_forcing.f90
@@ -7,30 +7,29 @@ subroutine constant_mass_flow_forcing
use parameters, only: magUbar, gradPcmf
use variables, only: U
use sparse_matrix, only: apu
+ use geometry, only: numCells,Vol
use fieldManipulation, only: volumeWeightedAverage
implicit none
- real(dp):: magUbarStar, rUAw, gragPplus, flowDirection
+ ! integer :: inp
+ real(dp):: magUbarStar, rUAw, gragPplus
- ! # Extract the velocity in the flow direction
- ! magUbarStar = ( flowDirection & U ).weightedAverage( mesh.V() )
+ ! Extract the velocity in the flow direction
magUbarStar = volumeWeightedAverage(U)
- ! # Calculate the pressure gradient increment needed to
- ! # adjust the average flow-rate to the correct value
+ ! Calculate the pressure gradient increment needed to
+ ! adjust the average flow-rate to the correct value
! gragPplus = ( magUbar - magUbarStar ) / rUA.weightedAverage( mesh.V() )
rUAw = volumeWeightedAverage(APU)
gragPplus = ( magUbar - magUbarStar ) / rUAw
- ! # Correction
- ! U.ext_assign( U + flowDirection * rUA * gragPplus )
- flowDirection = 1.0_dp
- U = U + flowDirection * APU * gragPplus
+ ! Correction of velocity to satisfy mass flow
+ U(1:numCells) = U(1:numCells) + APU(1:numCells) * gragPplus * Vol(1:numCells)
- ! # Pressure gradient force that will drive the flow - we use it in calcuvw.
+ ! Pressure gradient force that will drive the flow - we use it in calcuvw.
gradPcmf = gradPcmf + gragPplus
- write(6,'(2(a,es13.6))') "Uncorrected Ubar = ",magUbarStar," pressure gradient = ",gradPcmf
+ write(6,'(2(a,es13.6))') " Uncorrected Ubar = ",magUbarStar," pressure gradient = ",gradPcmf
end subroutine
\ No newline at end of file
diff --git a/src/cappuccino/create_fields.f90 b/src/cappuccino/create_fields.f90
index ab10c34..be01d0a 100644
--- a/src/cappuccino/create_fields.f90
+++ b/src/cappuccino/create_fields.f90
@@ -11,6 +11,7 @@ subroutine create_fields
use hcoef
use title_mod
use statistics
+ use mhd
implicit none
!
@@ -91,7 +92,9 @@ subroutine create_fields
allocate(pp(numTotal),stat=ierr)
if(ierr /= 0)write(*,*)"allocation error: pp"
-
+ allocate(dPdxi(3,numTotal),stat=ierr)
+ if(ierr /= 0)write(*,*)"allocation error: dPdxi"
+
if ( piso ) then
allocate(po(numTotal),stat=ierr)
@@ -109,9 +112,6 @@ subroutine create_fields
endif
- allocate(dPdxi(3,numTotal),stat=ierr)
- if(ierr /= 0)write(*,*)"allocation error: dPdxi"
-
! Turbulent K.E. and dissipation or any other turbulent scalar taking its place
allocate(te(numTotal),stat=ierr)
@@ -156,17 +156,17 @@ subroutine create_fields
allocate(t(numTotal),stat=ierr)
if(ierr /= 0)write(*,*)"allocation error: t"
+ allocate(dTdxi(3,numTotal),stat=ierr)
+ if(ierr /= 0)write(*,*)"allocation error: dTdxi"
+
allocate(to(numTotal),stat=ierr)
if(ierr /= 0)write(*,*)"allocation error: to"
- if( bdf ) then
+ if( bdf2 ) then
allocate(too(numTotal),stat=ierr)
if(ierr /= 0)write(*,*)"allocation error: too"
endif
- allocate(dTdxi(3,numTotal),stat=ierr)
- if(ierr /= 0)write(*,*)"allocation error: dTdxi"
-
if (ltransient) then
allocate(t_aver(numTotal),stat=ierr)
if(ierr /= 0)write(*,*)"allocation error: t_aver"
@@ -366,6 +366,36 @@ subroutine create_fields
endif
+ if (lcal(iep)) then
+
+ allocate(BMAGX(numTotal),stat=ierr)
+ if(ierr /= 0)write(*,*)"allocation error: bmagx"
+ allocate(BMAGY(numTotal),stat=ierr)
+ if(ierr /= 0)write(*,*)"allocation error: bmagy"
+ allocate(BMAGZ(numTotal),stat=ierr)
+ if(ierr /= 0)write(*,*)"allocation error: bmagz"
+
+ allocate(CURIX(numTotal),stat=ierr)
+ if(ierr /= 0)write(*,*)"allocation error: curix"
+ allocate(CURIY(numTotal),stat=ierr)
+ if(ierr /= 0)write(*,*)"allocation error: curiy"
+ allocate(CURIZ(numTotal),stat=ierr)
+ if(ierr /= 0)write(*,*)"allocation error: curiz"
+
+ allocate(FLORX(numTotal),stat=ierr)
+ if(ierr /= 0)write(*,*)"allocation error: florx"
+ allocate(FLORY(numTotal),stat=ierr)
+ if(ierr /= 0)write(*,*)"allocation error: flory"
+ allocate(FLORZ(numTotal),stat=ierr)
+ if(ierr /= 0)write(*,*)"allocation error: florz"
+
+ allocate(EPOT(numTotal),stat=ierr)
+ if(ierr /= 0)write(*,*)"allocation error: epot"
+ allocate(dEpotdxi(3,numTotal),stat=ierr)
+ if(ierr /= 0)write(*,*)"allocation error: dEpotdxi"
+
+ endif
+
! allocate( phimax( numCells ), stat=ierr)
! if(ierr /= 0)write(*,*)"allocation error: phimax"
diff --git a/src/cappuccino/directories b/src/cappuccino/directories
index 9ec7f5e..80a745c 100644
--- a/src/cappuccino/directories
+++ b/src/cappuccino/directories
@@ -4,10 +4,11 @@ src/finiteVolume/fvEqnDiscretization/Velocity
src/finiteVolume/fvEqnDiscretization/Pressure
src/finiteVolume/fvEqnDiscretization/ScalarEqns
src/finiteVolume/fvEqnDiscretization/TurbulenceModels
+src/finiteVolume/fvEqnDiscretization/MHD
+src/finiteVolume/interpolation
src/finiteVolume/fvExplicit
src/finiteVolume/fvImplicit
src/finiteVolume/initialization
-src/finiteVolume/interpolation
src/finiteVolume/tensorFields
src/sparseMatrix
src/linearSolvers
diff --git a/src/cappuccino/files b/src/cappuccino/files
index cba437b..3bd5bfe 100644
--- a/src/cappuccino/files
+++ b/src/cappuccino/files
@@ -2,12 +2,12 @@ modules_allocatable.f90
utils.f90
matrix.f90
geometry.f90
-tensor_fields.f90
+output.f90
field_initialization.f90
sparse_matrix.f90
gradients.f90
-output.f90
interpolation.f90
+fieldManipulation.f90
scalar_fluxes.f90
iccg.f90
bicgstab.f90
@@ -25,13 +25,12 @@ k_epsilon_rlzb.f90
k_epsilon_rlzb_2lewt.f90
spalart_allmaras.f90
k_eqn_eddy.f90
-create_fields.f90
+mhd.f90
asm_stress_terms.f90
asm_heatflux_terms.f90
adjustMassFlow.f90
bcin.f90
bpres.f90
-fieldManipulation.f90
faceflux_velocity.f90
faceflux_mass.f90
calcheatflux.f90
@@ -44,10 +43,11 @@ calcuvw.f90
calc_statistics.f90
CourantNo.f90
constant_mass_flow_forcing.f90
+create_fields.f90
updateVelocityAtBoundary.f90
correct_turbulence.f90
correct_turbulence_inlet.f90
-fvm_laplacian.f90
+laplacian.f90
init.f90
readfiles.f90
read_input.f90
diff --git a/src/cappuccino/init.f90 b/src/cappuccino/init.f90
index d6074c0..245747b 100644
--- a/src/cappuccino/init.f90
+++ b/src/cappuccino/init.f90
@@ -24,6 +24,7 @@ subroutine init
! use LIS_linear_solver_library
use field_initialization
use output
+ use mhd
implicit none
@@ -113,22 +114,7 @@ subroutine init
! 1.2) Field Initialisation
call initialize_vector_field(u,v,w,dUdxi,'U')
- ! ! Initialize previous time step value to current value.
- ! uo = u
- ! vo = v
- ! wo = w
-
- ! uoo = u
- ! voo = v
- ! woo = w
-
- ! if (bdf3) then
- ! uooo = u
- ! vooo = v
- ! wooo = w
- ! endif
-
- ! Field initialisation scalars
+ if (levm) then
!
! > TE Turbulent kinetic energy.
!
@@ -143,19 +129,24 @@ subroutine init
call initialize_scalar_field(ed,dEDdxi,'epsilon')
endif
- !-------------------------------------------------------
- ! Field initialisation over inner cells + boundary faces
- !-------------------------------------------------------
+ endif
+
+ !
+ ! > Temperature
+ !
+ if( lcal(ien) ) call initialize_scalar_field(t,dTdxi,'T')
+
+ !
+ ! Magnetic field
+ !
+ if ( lcal(iep) ) call initialize_vector_field(bmagx,bmagy,bmagz,dEpotdxi,'B')
! Density
den = densit
! Effective viscosity
vis = viscos
- visw = viscos
-
- ! Temperature
- if(lcal(ien)) t = tin
+ visw = viscos
! Temperature variance
if(lcal(ivart)) vart = vartin
@@ -163,31 +154,6 @@ subroutine init
! Concentration
if(lcal(icon)) con = conin
- ! ! Reynolds stress tensor components
- ! if (lturb) then
- ! uu = 0.0_dp
- ! vv = 0.0_dp
- ! ww = 0.0_dp
- ! uv = 0.0_dp
- ! uw = 0.0_dp
- ! vw = 0.0_dp
- ! endif
-
- ! ! Turbulent heat fluxes
- ! if(lcal(ien).and.lbuoy) then
- ! utt = 0.0_dp
- ! vtt = 0.0_dp
- ! wtt = 0.0_dp
- ! endif
-
- ! ! Reynolds stress anisotropy
- ! if(lturb.and.lasm) bij = 0.0_dp
-
- ! Pressure and pressure correction
- ! p = 0.0_dp
- ! if ( simple ) pp = p
- ! if ( piso .and. (bdf2.or.bdf3) ) po = p
- ! if ( piso .and. bdf3 ) poo = p
! Initialize mass flow
do i=1,numInnerFaces
@@ -205,11 +171,6 @@ subroutine init
enddo
- if (piso) then
- flmasso = flmass
- if (bdf3) flmassoo = flmass
- endif
-
!
! Read Restart File And Set Field Values
!
@@ -230,21 +191,7 @@ subroutine init
call grad(V,dVdxi)
call grad(W,dWdxi)
-!
-! Initialization of residual for all variables
-!
- ! do i=1,nphi
- ! rnor(i) = 1.0_dp
- ! resor(i)= 0.0_dp
- ! enddo
-
- ! rnor(iu) = 1.0_dp/(flomom+small)
- ! rnor(iv) = rnor(iu)
- ! rnor(iw) = rnor(iu)
- ! rnor(ip) = 1.0_dp/(flomas+small)
- ! rnor(ite) = 1.0_dp/(flowte+small)
- ! rnor(ied) = 1.0_dp/(flowed+small)
!
! Distance to the nearest wall (needed for some turbulence models) for all cells via Poisson equation.
@@ -317,11 +264,7 @@ subroutine init
su = 0.0_dp
sv = 0.0_dp
dPdxi = 0.0_dp
+ pp = p
- if (piso) then
- deallocate( pp )
- else ! simple
- pp = p
- endif
end subroutine
diff --git a/src/cappuccino/main.f90 b/src/cappuccino/main.f90
index 009b59c..5845f8c 100644
--- a/src/cappuccino/main.f90
+++ b/src/cappuccino/main.f90
@@ -19,6 +19,7 @@ program cappuccino
use sparse_matrix
use temperature
use concentration
+ use mhd
use utils, only: show_logo
implicit none
@@ -38,7 +39,6 @@ program cappuccino
call get_command_argument(1,input_file)
call get_command_argument(2,monitor_file)
call get_command_argument(3,restart_file)
- call get_command_argument(4,out_folder_path)
! Open simulation log file
open(unit=6,file=monitor_file)
@@ -104,11 +104,13 @@ program cappuccino
if(lturb) call correct_turbulence()
!Scalars: Temperature , temperature variance, and concentration eqs.
- if(lcal(ien)) call calculate_temperature_field()
+ if(lcal(ien)) call calculate_temperature_field
- ! if(lcal(ivart)) call calculate_temperature_variance_field()
+ ! if(lcal(ivart)) call calculate_temperature_variance_field
- if(lcal(icon)) call calculate_concentration_field()
+ if(lcal(icon)) call calculate_concentration_field
+
+ if(lcal(iep)) call calculate_electric_potential
call cpu_time(finish)
@@ -141,7 +143,13 @@ program cappuccino
if( source.lt.sormax .or. iter.ge.maxit ) then
! Correct driving force for a constant mass flow rate simulation:
- if(const_mflux) call constant_mass_flow_forcing
+ if(const_mflux) then
+ call constant_mass_flow_forcing
+ endif
+
+ ! Write values at monitoring points and recalculate time-average values for statistics:
+ call writehistory
+ call calc_statistics
! Write field values after nzapis iterations or at the end of time-dependent simulation:
if( mod(itime,nzapis).eq.0 .or. itime.eq.numstep ) then
@@ -149,10 +157,6 @@ program cappuccino
call writefiles
endif
- ! Write values at monitoring points and recalculate time-average values for statistics:
- call writehistory
- call calc_statistics
-
cycle time_loop
endif
diff --git a/src/cappuccino/modules_allocatable.f90 b/src/cappuccino/modules_allocatable.f90
index 6975937..079c5b9 100644
--- a/src/cappuccino/modules_allocatable.f90
+++ b/src/cappuccino/modules_allocatable.f90
@@ -10,7 +10,7 @@ end module types
module parameters
use types
- integer, parameter :: nphi=10 ! Max. no. of variables to solve
+ integer, parameter :: nphi=11 ! Max. no. of variables to solve
integer, parameter :: iu=1 ! Variable identifiers
integer, parameter :: iv=2
integer, parameter :: iw=3
@@ -21,9 +21,10 @@ module parameters
integer, parameter :: ivis=8
integer, parameter :: ivart=9
integer, parameter :: icon=10
+ integer, parameter :: iep=11
- real(dp), parameter :: one = 1.0d0
- real(dp), parameter :: zero = 0.0d0
+ real(dp), parameter :: one = 1.0_dp
+ real(dp), parameter :: zero = 0.0_dp
real(dp), parameter :: small = 1e-20
real(dp), parameter :: great = 1e+20
real(dp), parameter :: pi = 3.1415926535897932384626433832795_dp
@@ -81,30 +82,13 @@ module parameters
real(dp) :: CoNum,meanCoNum ! Courant number.
! character(len=9) :: timechar! A char string to write current timestep
- ! Choosing discretization scheme cds, luds, smart,muscl, gamma, etc.
- ! logical :: lcds,lluds,lsmart,lavl,lmuscl,lumist...,lcds_flnt,l2nd_flnt,l2ndlim_flnt,lmuscl_flnt
- logical :: lcds = .false.
- logical :: lcdsc = .false.
- logical :: lluds = .false.
- logical :: lsmart = .false.
- logical :: lavl = .false.
- logical :: lmuscl = .false.
- logical :: lumist = .false.
- logical :: lkoren = .false.
- logical :: lcharm = .false.
- logical :: lospre = .false.
- logical :: lcds_flnt = .false.
- logical :: l2nd_flnt = .false.
- logical :: lmuscl_flnt = .false.
-
- logical :: flux_limiter = .false.
! Logicals, mostly read from simulation-input file:
logical :: lturb,lread,lwrite,ltest ! turbulent simulation, read restart file, write restart file, print residual of the linear solver,.,..
logical :: ltransient ! LTRANSIENT is TRUE for transient (non-stationary) simulations
logical :: levm,lasm,lles,lsgdh,lggdh,lafm ! eddy-viscosity, algebraic stress model or LES, simple gradient or generalized gradient hypothesis, algerbaic flux model
logical :: bdf,bdf2,bdf3,cn ! control for the time-stepping algorithm
- logical :: simple,piso,pimple ! control for the velocity-pressure coupling algorithm
+ logical :: simple,piso ! control for the velocity-pressure coupling algorithm
logical :: const_mflux ! control for constant flow rate
logical :: solveOmega, solveEpsilon, SolveTKE ! Selfexplanatory, used in 'init'
@@ -123,31 +107,11 @@ module parameters
real(dp) :: sumLocalContErr, globalContErr, cumulativeContErr ! Continuity errors
-! -varijabla za polje velicine numTotal + za vremenski korak iza phio i jos jedan iza phioo ako je time stepping shema bdf2
-! -Niz koji ce drzate usrednjeno polje ovog polja za nestacionarne simulacije, samo ukoliko je turbulentno strujanje.
-! -chvarSolver ili pojednostavi na chvar - to je string koji identifikuje sta ispisuje linearni solver u reportu i jos vaznije, koji fajl u 0/ folderu uzima da cita za init
-! -ako se racuna jednacinom, normalizovani residual rnor ili obicni ne normalizovani resor
-! -podrelaskacioni faktor urf
-
-! -max broj iteracija za linearni solver - nsw
-! -min rez za linearni solver sor
-! -parametar koji definise koji linearni solver
-! -koja sema za konvekciju
-! -koja sema za difuziju
-! -gds velicina za deferred correction
-! Funkcije:
-! -funkcija za alokaciju ili to moze u mainu...
-! -func za init gde se inicijalnizuje polje i gde se podesava tip BC i inicijalne vrednosti boundary fejsova
-! -func sa diskretizovanom jedn. koja se zove calc pa nesto, recimo calcScalar
-! -func za flukseve koju poziva calcScalar
-! -fun za eksplicitnu korekciju granicnih uslova posle solve, ali to mozda moze globalno?
-
! Those with nphi are related to each field that we calculate U,V,W,P,T,TKE,ED...
logical, dimension(nphi) :: lcal ! Logical do we calculate that particular field
integer, dimension(nphi) :: nsw ! Number of allowed iterations in linear solver for each variable
real(dp), dimension(nphi) :: sor ! Tolerance level for residual in linear solver for each variable
real(dp), dimension(nphi) :: resor ! Residual
- real(dp), dimension(nphi) :: rnor ! Residual normalisation factor
real(dp), dimension(nphi) :: prtinv ! Inverse Prandtl numbers, (see diffusion term discretisation)
real(dp), dimension(nphi) :: urf ! Underrelaxation factor
real(dp), dimension(nphi) :: urfr ! Recipr. value of urf: 1/urf
@@ -156,16 +120,6 @@ module parameters
end module parameters
-
-module hcoef
-!%%%%%%%%%%%%%
- use types
- ! Arrays used in piso algorithm
- real(dp), dimension(:), allocatable :: h,rU,rV,rW
-end module hcoef
-
-
-
module variables
!%%%%%%%%%%%%%%
use types
@@ -186,7 +140,7 @@ module variables
real(dp), dimension(:), allocatable :: con ! Concentration
real(dp), dimension(:), allocatable :: uu,vv,ww,uv,uw,vw ! Reynolds stress tensor components
real(dp), dimension(:,:), allocatable :: bij ! Reynolds stress anisotropy tensor
- real(dp), dimension(:), allocatable :: fmi, fmo ! Mass fluxes trough boundary faces
+ ! real(dp), dimension(:), allocatable :: fmi, fmo ! Mass fluxes trough boundary faces
real(dp), dimension(:), allocatable :: visw,ypl,tau ! Effective visc. for boundary face, the y+ non-dimensional distance from wall, tau - wall shear stress
! values from n-1 timestep
@@ -228,19 +182,23 @@ module variables
end module variables
+
module title_mod
!%%%%%%%%%%%%
+!
+! Used for output to monitor file.
+!
+use parameters, only: nphi
character(len=70) :: title
- ! character(19) :: datetime ! A date-time character to identify unique postprocessing folder
- character(len=4), dimension(10) :: chvar = (/' U ', ' V ', ' W ', ' P ', ' TE ', ' ED ', ' T ', ' VIS', 'VART', ' CON' /)
- character(len=7), dimension(10) :: chvarSolver = &
- (/'U ', 'V ', 'W ', 'p ', 'k ', 'epsilon', 'Temp ', 'Visc ', 'VarTemp', 'Conc ' /)
- character(len=100):: input_file,inlet_file,grid_file,monitor_file,restart_file,out_folder_path
+ character(len=4), dimension(nphi) :: chvar = &
+ (/' U ', ' V ', ' W ', ' P ',' TE ', ' ED ', ' T ', ' VIS', 'VART', ' CON', 'EPOT' /)
+ character(len=7), dimension(nphi) :: chvarSolver = &
+ (/'U ','V ','W ','p ','k ','epsilon','Temp ','Visc ','VarTemp','Conc ','Epot ' /)
+ character(len=100):: input_file,inlet_file,grid_file,monitor_file,restart_file
end module title_mod
-
module statistics
! Variables for collecting statistics
! these are ensamble averaged values over time steps
@@ -257,4 +215,12 @@ module statistics
real(dp), dimension(:), allocatable :: ut_aver,vt_aver,wt_aver
real(dp), dimension(:), allocatable :: tt_aver
-end module statistics
\ No newline at end of file
+end module statistics
+
+
+module hcoef
+!%%%%%%%%%%%%%
+ use types
+ ! Arrays used in piso algorithm
+ real(dp), dimension(:), allocatable :: h,rU,rV,rW
+end module hcoef
\ No newline at end of file
diff --git a/src/cappuccino/time_shift.f90 b/src/cappuccino/time_shift.f90
index 16c26d9..731fb48 100644
--- a/src/cappuccino/time_shift.f90
+++ b/src/cappuccino/time_shift.f90
@@ -6,7 +6,7 @@ subroutine time_shift
implicit none
- if( bdf ) then
+ if( bdf .or. cn ) then
uo = u
vo = v
@@ -16,10 +16,10 @@ subroutine time_shift
if (lcal(ien)) to = t
if (lcal(ivart)) varto = vart
if (lcal(icon)) cono = con
- if (piso) then
- flmasso = flmass
- po = p
- endif
+ ! if (piso) then
+ ! flmasso = flmass
+ ! po = p
+ ! endif
elseif( bdf2 ) then
@@ -31,10 +31,10 @@ subroutine time_shift
if (lcal(ien)) too = to
if (lcal(ivart)) vartoo = varto
if (lcal(icon)) conoo = cono
- if (piso) then
- flmassoo = flmasso
- poo = po
- endif
+ ! if (piso) then
+ ! flmassoo = flmasso
+ ! poo = po
+ ! endif
uo = u
vo = v
@@ -44,10 +44,10 @@ subroutine time_shift
if (lcal(ien)) to = t
if (lcal(ivart)) varto = vart
if (lcal(icon)) cono = con
- if (piso) then
- flmasso = flmass
- po = p
- endif
+ ! if (piso) then
+ ! flmasso = flmass
+ ! po = p
+ ! endif
elseif( bdf3 ) then
@@ -65,10 +65,10 @@ subroutine time_shift
if (lcal(ien)) too = to
if (lcal(ivart)) vartoo = varto
if (lcal(icon)) conoo = cono
- if (piso) then
- flmassoo = flmasso
- poo = po
- endif
+ ! if (piso) then
+ ! flmassoo = flmasso
+ ! poo = po
+ ! endif
uo = u
vo = v
@@ -78,10 +78,10 @@ subroutine time_shift
if (lcal(ien)) to = t
if (lcal(ivart)) varto = vart
if (lcal(icon)) cono = con
- if (piso) then
- flmasso = flmass
- po = p
- endif
+ ! if (piso) then
+ ! flmasso = flmass
+ ! po = p
+ ! endif
endif
diff --git a/src/finiteVolume/boundary/bcin.f90 b/src/finiteVolume/boundary/bcin.f90
index 4264b95..c1129b2 100644
--- a/src/finiteVolume/boundary/bcin.f90
+++ b/src/finiteVolume/boundary/bcin.f90
@@ -55,7 +55,7 @@ subroutine bcin
! so minus signs here is to turn net mass influx - flomas, into positive value.
flomas = flomas - flmass(iface)
flomom = flomom + abs(flmass(iface))*sqrt(u(ini)**2+v(ini)**2+w(ini)**2)
- flowen = flowen + abs(flmass(iface)*t(ini))
+ ! flowen = flowen + abs(flmass(iface)*t(ini))
flowte = flowte + abs(flmass(iface)*te(ini))
flowed = flowed + abs(flmass(iface)*ed(ini))
@@ -120,6 +120,9 @@ subroutine bcin
write ( *, '(a)' ) ' Inlet boundary condition information:'
write ( *, '(a,e12.6)' ) ' Mass inflow: ', flomas
write ( *, '(a,e12.6)' ) ' Momentum inflow: ', flomom
+ ! write ( *, '(a,e12.6)' ) ' Temperature inflow: ', flowen
+ write ( *, '(a,e12.6)' ) ' TKE inflow: ', flowte
+ write ( *, '(a,e12.6)' ) ' Dissipation inflow: ', flowed
write ( *, '(a)' ) ' '
else
diff --git a/src/finiteVolume/boundary/bpres.f90 b/src/finiteVolume/boundary/bpres.f90
index bc21263..c5fa79d 100644
--- a/src/finiteVolume/boundary/bpres.f90
+++ b/src/finiteVolume/boundary/bpres.f90
@@ -49,7 +49,6 @@ subroutine bpres(p,istage)
enddo
-
else ! istage==2 and higher
! ! Loop Boundary faces:
diff --git a/src/finiteVolume/boundary/updateScalar.f90 b/src/finiteVolume/boundary/updateScalar.f90
new file mode 100644
index 0000000..d4b8a12
--- /dev/null
+++ b/src/finiteVolume/boundary/updateScalar.f90
@@ -0,0 +1,59 @@
+subroutine updateScalar(phi)
+!
+!******************************************************************************
+!
+! Updates values of a scalar field at boundaries
+!
+!******************************************************************************
+!
+ use types
+ use parameters
+ use geometry
+
+ implicit none
+
+ real(dp), dimension(numTotal), intent(inout) :: phi
+
+!
+! Local variables
+!
+ integer :: i,ijp,ijb,ib,iface
+ real(dp) :: Unmag,flowo
+
+ ! Update velocity components along outlet boundaries
+ ! and correct mass flux to satisfy global mass conservation
+
+ flowo=0.0_dp
+
+ do ib=1,numBoundaries
+
+ if ( bctype(ib) == 'outlet' ) then
+
+ ! do i=1,nfaces(ib)
+
+ ! iface = startFace(ib) + i
+ ! ijp = owner(iface)
+ ! ijb = iBndValueStart(ib) + i
+
+ ! U(ijb) = U(ijp)
+
+ ! enddo
+
+ elseif ( bctype(ib) == 'symmetry') then
+
+ ! Symmetry
+ do i=1,nfaces(ib)
+
+ ! iface = startFace(ib) + i
+ ! ijp = owner(iface)
+ ! ijb = iBndValueStart(ib) + i
+
+
+ end do
+
+ endif
+
+ enddo
+
+
+end subroutine
\ No newline at end of file
diff --git a/src/finiteVolume/boundary/updateVelocityAtBoundary.f90 b/src/finiteVolume/boundary/updateVelocityAtBoundary.f90
index 31908f1..373b00c 100644
--- a/src/finiteVolume/boundary/updateVelocityAtBoundary.f90
+++ b/src/finiteVolume/boundary/updateVelocityAtBoundary.f90
@@ -17,7 +17,7 @@ subroutine updateVelocityAtBoundary
! Local variables
!
integer :: i,ijp,ijb,ib,iface
- real(dp) :: Unmag,flowo,fac
+ real(dp) :: Unmag,flowo
! Update velocity components along outlet boundaries
! and correct mass flux to satisfy global mass conservation
@@ -38,9 +38,9 @@ subroutine updateVelocityAtBoundary
! V(ijb) = V(ijp)
! W(ijb) = W(ijp)
- ! flmass(iface) = den(ijp)*( u(ijb)*arx(iface)+v(ijb)*ary(iface)+w(ijb)*arz(iface) )
+ ! flmass(iface) = den(ijp)*( u(ijb)*arx(iface)+v(ijb)*ary(iface)+w(ijb)*arz(iface) )
- ! flowo = flowo + flmass(iface)
+ ! flowo = flowo + flmass(iface)
! enddo
diff --git a/src/finiteVolume/fluxes/faceflux_mass.f90 b/src/finiteVolume/fluxes/faceflux_mass.f90
index c6051c4..164900b 100644
--- a/src/finiteVolume/fluxes/faceflux_mass.f90
+++ b/src/finiteVolume/fluxes/faceflux_mass.f90
@@ -287,7 +287,7 @@ subroutine facefluxmass2(ijp, ijn, xf, yf, zf, arx, ary, arz, lambda, cap, can,
!***********************************************************************
!
-subroutine facefluxmass_piso(ijp, ijn, xf, yf, zf, arx, ary, arz, lambda, cap, can, flmass, fmo, fmoo,fmooo)
+subroutine facefluxmass_piso(ijp, ijn, xf, yf, zf, arx, ary, arz, lambda, cap, can, flmass)!, fmo, fmoo,fmooo)
!
!***********************************************************************
!
@@ -307,7 +307,7 @@ subroutine facefluxmass_piso(ijp, ijn, xf, yf, zf, arx, ary, arz, lambda, cap, c
real(dp), intent(in) :: lambda
real(dp), intent(inout) :: cap, can
real(dp), intent(inout) :: flmass
- real(dp), intent(in) :: fmo,fmoo,fmooo
+ ! real(dp), intent(in) :: fmo,fmoo,fmooo
! Local variables
real(dp) :: fxn, fxp
@@ -315,7 +315,7 @@ subroutine facefluxmass_piso(ijp, ijn, xf, yf, zf, arx, ary, arz, lambda, cap, c
real(dp) :: nx,ny,nz
real(dp) :: xpn,ypn,zpn,dene
real(dp) :: ui,vi,wi
- real(dp) :: ufo, vfo, wfo
+ ! real(dp) :: ufo, vfo, wfo
real(dp) :: Kj
@@ -385,70 +385,70 @@ subroutine facefluxmass_piso(ijp, ijn, xf, yf, zf, arx, ary, arz, lambda, cap, c
! endif
- if (bdf2) then
+ ! if (bdf2) then
- ! From timestep n-1
- ufo = face_value_cds( ijp, ijn, lambda, uo )
- vfo = face_value_cds( ijp, ijn, lambda, vo )
- wfo = face_value_cds( ijp, ijn, lambda, wo )
+ ! ! From timestep n-1
+ ! ufo = face_value_cds( ijp, ijn, lambda, uo )
+ ! vfo = face_value_cds( ijp, ijn, lambda, vo )
+ ! wfo = face_value_cds( ijp, ijn, lambda, wo )
- ui = 2*Kj * ( ( fmo / (dene*are) - (ufo*nx+vfo*ny+wfo*nz) ) * nx )
- vi = 2*Kj * ( ( fmo / (dene*are) - (ufo*nx+vfo*ny+wfo*nz) ) * ny )
- wi = 2*Kj * ( ( fmo / (dene*are) - (ufo*nx+vfo*ny+wfo*nz) ) * nz )
+ ! ui = 2*Kj * ( ( fmo / (dene*are) - (ufo*nx+vfo*ny+wfo*nz) ) * nx )
+ ! vi = 2*Kj * ( ( fmo / (dene*are) - (ufo*nx+vfo*ny+wfo*nz) ) * ny )
+ ! wi = 2*Kj * ( ( fmo / (dene*are) - (ufo*nx+vfo*ny+wfo*nz) ) * nz )
- flmass = flmass + (ui*arx+vi*ary+wi*arz)
+ ! flmass = flmass + (ui*arx+vi*ary+wi*arz)
- ! From timestep n-2
- ufo = face_value_cds( ijp, ijn, lambda, uoo )
- vfo = face_value_cds( ijp, ijn, lambda, voo )
- wfo = face_value_cds( ijp, ijn, lambda, woo )
+ ! ! From timestep n-2
+ ! ufo = face_value_cds( ijp, ijn, lambda, uoo )
+ ! vfo = face_value_cds( ijp, ijn, lambda, voo )
+ ! wfo = face_value_cds( ijp, ijn, lambda, woo )
- ui = -0.5_dp * Kj * ( ( fmoo / (dene*are) - (ufo*nx+vfo*ny+wfo*nz) ) * nx )
- vi = -0.5_dp * Kj * ( ( fmoo / (dene*are) - (ufo*nx+vfo*ny+wfo*nz) ) * ny )
- wi = -0.5_dp * Kj * ( ( fmoo / (dene*are) - (ufo*nx+vfo*ny+wfo*nz) ) * nz )
+ ! ui = -0.5_dp * Kj * ( ( fmoo / (dene*are) - (ufo*nx+vfo*ny+wfo*nz) ) * nx )
+ ! vi = -0.5_dp * Kj * ( ( fmoo / (dene*are) - (ufo*nx+vfo*ny+wfo*nz) ) * ny )
+ ! wi = -0.5_dp * Kj * ( ( fmoo / (dene*are) - (ufo*nx+vfo*ny+wfo*nz) ) * nz )
- flmass = flmass + (ui*arx+vi*ary+wi*arz)
+ ! flmass = flmass + (ui*arx+vi*ary+wi*arz)
- endif
+ ! endif
- if (bdf3) then
+ ! if (bdf3) then
- ! From timestep n-1
- ufo = face_value_cds( ijp, ijn, lambda, uo )
- vfo = face_value_cds( ijp, ijn, lambda, vo )
- wfo = face_value_cds( ijp, ijn, lambda, wo )
+ ! ! From timestep n-1
+ ! ufo = face_value_cds( ijp, ijn, lambda, uo )
+ ! vfo = face_value_cds( ijp, ijn, lambda, vo )
+ ! wfo = face_value_cds( ijp, ijn, lambda, wo )
- ui = 3*Kj * ( ( fmo / (dene*are) - (ufo*nx+vfo*ny+wfo*nz) ) * nx )
- vi = 3*Kj * ( ( fmo / (dene*are) - (ufo*nx+vfo*ny+wfo*nz) ) * ny )
- wi = 3*Kj * ( ( fmo / (dene*are) - (ufo*nx+vfo*ny+wfo*nz) ) * nz )
+ ! ui = 3*Kj * ( ( fmo / (dene*are) - (ufo*nx+vfo*ny+wfo*nz) ) * nx )
+ ! vi = 3*Kj * ( ( fmo / (dene*are) - (ufo*nx+vfo*ny+wfo*nz) ) * ny )
+ ! wi = 3*Kj * ( ( fmo / (dene*are) - (ufo*nx+vfo*ny+wfo*nz) ) * nz )
- flmass = flmass + (ui*arx+vi*ary+wi*arz)
+ ! flmass = flmass + (ui*arx+vi*ary+wi*arz)
- ! From timestep n-2
- ufo = face_value_cds( ijp, ijn, lambda, uoo )
- vfo = face_value_cds( ijp, ijn, lambda, voo )
- wfo = face_value_cds( ijp, ijn, lambda, woo )
+ ! ! From timestep n-2
+ ! ufo = face_value_cds( ijp, ijn, lambda, uoo )
+ ! vfo = face_value_cds( ijp, ijn, lambda, voo )
+ ! wfo = face_value_cds( ijp, ijn, lambda, woo )
- ui = -1.5_dp * Kj * ( ( fmoo / (dene*are) - (ufo*nx+vfo*ny+wfo*nz) ) * nx )
- vi = -1.5_dp * Kj * ( ( fmoo / (dene*are) - (ufo*nx+vfo*ny+wfo*nz) ) * ny )
- wi = -1.5_dp * Kj * ( ( fmoo / (dene*are) - (ufo*nx+vfo*ny+wfo*nz) ) * nz )
+ ! ui = -1.5_dp * Kj * ( ( fmoo / (dene*are) - (ufo*nx+vfo*ny+wfo*nz) ) * nx )
+ ! vi = -1.5_dp * Kj * ( ( fmoo / (dene*are) - (ufo*nx+vfo*ny+wfo*nz) ) * ny )
+ ! wi = -1.5_dp * Kj * ( ( fmoo / (dene*are) - (ufo*nx+vfo*ny+wfo*nz) ) * nz )
- flmass = flmass + (ui*arx+vi*ary+wi*arz)
+ ! flmass = flmass + (ui*arx+vi*ary+wi*arz)
- ! From timestep n-3
- ufo = face_value_cds( ijp, ijn, lambda, uooo )
- vfo = face_value_cds( ijp, ijn, lambda, vooo )
- wfo = face_value_cds( ijp, ijn, lambda, wooo )
+ ! ! From timestep n-3
+ ! ufo = face_value_cds( ijp, ijn, lambda, uooo )
+ ! vfo = face_value_cds( ijp, ijn, lambda, vooo )
+ ! wfo = face_value_cds( ijp, ijn, lambda, wooo )
- ui = 1./3.0_dp * Kj * ( ( fmooo / (dene*are) - (ufo*nx+vfo*ny+wfo*nz) ) * nx )
- vi = 1./3.0_dp * Kj * ( ( fmooo / (dene*are) - (ufo*nx+vfo*ny+wfo*nz) ) * ny )
- wi = 1./3.0_dp * Kj * ( ( fmooo / (dene*are) - (ufo*nx+vfo*ny+wfo*nz) ) * nz )
+ ! ui = 1./3.0_dp * Kj * ( ( fmooo / (dene*are) - (ufo*nx+vfo*ny+wfo*nz) ) * nx )
+ ! vi = 1./3.0_dp * Kj * ( ( fmooo / (dene*are) - (ufo*nx+vfo*ny+wfo*nz) ) * ny )
+ ! wi = 1./3.0_dp * Kj * ( ( fmooo / (dene*are) - (ufo*nx+vfo*ny+wfo*nz) ) * nz )
- flmass = flmass + (ui*arx+vi*ary+wi*arz)
+ ! flmass = flmass + (ui*arx+vi*ary+wi*arz)
- endif
+ ! endif
end subroutine
diff --git a/src/finiteVolume/fluxes/faceflux_velocity.f90 b/src/finiteVolume/fluxes/faceflux_velocity.f90
index 51f1696..8a40b15 100644
--- a/src/finiteVolume/fluxes/faceflux_velocity.f90
+++ b/src/finiteVolume/fluxes/faceflux_velocity.f90
@@ -103,8 +103,8 @@ subroutine facefluxuvw(ijp, ijn, xf, yf, zf, arx, ary, arz, flomass, lambda, gam
ce = min(flomass,zero)
cp = max(flomass,zero)
- can = -de + min(flomass,zero)
- cap = -de - max(flomass,zero)
+ can = -de + ce
+ cap = -de - cp
@@ -148,9 +148,13 @@ subroutine facefluxuvw(ijp, ijn, xf, yf, zf, arx, ary, arz, flomass, lambda, gam
! > Explicit convection:
! Explicit convective fluxes for UDS
- fuuds = max(flomass,zero)*u(ijp)+min(flomass,zero)*u(ijn)
- fvuds = max(flomass,zero)*v(ijp)+min(flomass,zero)*v(ijn)
- fwuds = max(flomass,zero)*w(ijp)+min(flomass,zero)*w(ijn)
+ fuuds = cp*u(ijp)+ce*u(ijn)
+ fvuds = cp*v(ijp)+ce*v(ijn)
+ fwuds = cp*w(ijp)+ce*w(ijn)
+
+ ! fuuds = max(flomass,zero)*u(ijp)+min(flomass,zero)*u(ijn)
+ ! fvuds = max(flomass,zero)*v(ijp)+min(flomass,zero)*v(ijn)
+ ! fwuds = max(flomass,zero)*w(ijp)+min(flomass,zero)*w(ijn)
! EXPLICIT CONVECTIVE FLUXES FOR HIGH ORDER BOUNDED SCHEMES
@@ -213,12 +217,12 @@ subroutine facefluxuvw_boundary(ijp, ijb, xf, yf, zf, arx, ary, arz, flomass, ca
real(dp) :: xi,yi,zi
real(dp) :: duxi,duyi,duzi, &
- dvxi,dvyi,dvzi, &
- dwxi,dwyi,dwzi
+ dvxi,dvyi,dvzi, &
+ dwxi,dwyi,dwzi
real(dp) :: duxii,dvxii,dwxii, &
- duyii,dvyii,dwyii, &
- duzii,dvzii,dwzii
+ duyii,dvyii,dwyii, &
+ duzii,dvzii,dwzii
real(dp) :: d2x,d2y,d2z,d1x,d1y,d1z
@@ -227,16 +231,18 @@ subroutine facefluxuvw_boundary(ijp, ijb, xf, yf, zf, arx, ary, arz, flomass, ca
real(dp) :: fdue,fdve,fdwe,fdui,fdvi,fdwi
!----------------------------------------------------------------------
+ ! [NOTE]: Leaving things commented out so people can see the difference
+ ! between this and the version for iner faces.
! > Geometry:
- ! Face interpolation factor
+ ! Face interpolation factor:
! fxn=lambda
! fxp=1.0_dp-lambda
fxn=1.0_dp
fxp=0.0_dp
- ! Distance vector between cell centers
+ ! Distance vector between cell centers:
! xpn=xc(ijb)-xc(ijp)
! ypn=yc(ijb)-yc(ijp)
! zpn=zc(ijb)-zc(ijp)
@@ -310,6 +316,14 @@ subroutine facefluxuvw_boundary(ijp, ijb, xf, yf, zf, arx, ary, arz, flomass, ca
!.....interpolate gradients defined at cv centers to faces
+
+ ![NOTE]: Commented out version is for inner faces..
+ ! fxn = 1.0, so we should take values of gradient from
+ ! face center (ijb index, b as 'boundary'),
+ ! but since we have constant gradient for
+ ! inlet and outlet, for which this routine is called,
+ ! we take adjecent cell center value of gradient instead.
+
! duxi = dUdxi(1,ijp)*fxp+dUdxi(1,ijb)*fxn
! duyi = dUdxi(2,ijp)*fxp+dUdxi(2,ijb)*fxn
! duzi = dUdxi(3,ijp)*fxp+dUdxi(3,ijb)*fxn
@@ -368,16 +382,19 @@ subroutine facefluxuvw_boundary(ijp, ijb, xf, yf, zf, arx, ary, arz, flomass, ca
! > Explicit convection:
! - None -
+ ! [NOTE]: No need to have explicit convection.
-! Explicit part of diffusion fluxes and sources due to deffered correction,
-! for all schemes!
+! Explicit part of diffusion fluxes and sources due to deffered correction.
+ ![NOTE]: Deferred correction blending coefficient (gam) is taken to be zero
+ ! so we have only explicit diffusion below.
+
! sup = -gam*(fuhigh-fuuds)+fdue-fdui
! svp = -gam*(fvhigh-fvuds)+fdve-fdvi
! swp = -gam*(fwhigh-fwuds)+fdwe-fdwi
sup = fdue-fdui
svp = fdve-fdvi
- swp = fdwe-fdwi !...because gam=0
+ swp = fdwe-fdwi
end subroutine
diff --git a/src/finiteVolume/fvEqnDiscretization/MHD/mhd.f90 b/src/finiteVolume/fvEqnDiscretization/MHD/mhd.f90
new file mode 100644
index 0000000..d97de87
--- /dev/null
+++ b/src/finiteVolume/fvEqnDiscretization/MHD/mhd.f90
@@ -0,0 +1,260 @@
+module mhd
+!
+! Module for discretisation of equations for Magneto-Hydrodynamic flows.
+!
+! CURIX,CURIY,CURIZ : Induced current components.
+! CURCX,CURCY,CURCZ : Conductive current components.
+! CURX,CURY,CURZ : Total current components.
+! FLORX,FLORY,FLORZ : Lorentz force components.
+!
+use types
+use parameters
+use geometry
+use variables
+
+implicit none
+
+
+real(dp), dimension(:), allocatable :: BMAGX,BMAGY,BMAGZ ! Magnetic inductions vector field components.
+real(dp), dimension(:), allocatable :: EPOT ! Electric potential.
+real(dp), dimension(:), allocatable :: CURIX,CURIY,CURIZ ! Induced current vector field components.
+real(dp), dimension(:), allocatable :: FLORX,FLORY,FLORZ ! Lorentz force vector field components.
+
+real(dp), dimension(:,:), allocatable :: dEpotdxi
+
+! Parameters defined in input file.
+real(dp), parameter :: SIGMA = 1.0_dp
+real(dp) :: BNULA
+real(dp) :: AMHD,BMHD,DMHD
+real(dp) :: LBX,LBY,LBZ
+
+public
+
+contains
+
+!***********************************************************************
+!
+subroutine calculate_Lorentz_force
+!
+!***********************************************************************
+!
+! Calculate Lorentz force used as a body force for the momentum equation.
+!
+! CURIX,CURIY,CURIZ : Induced current components.
+! CURCX,CURCY,CURCZ : Conductive current components.
+! CURX,CURY,CURZ : Total current components.
+! FLORX,FLORY,FLORZ : Lorentz force components.
+!
+!***********************************************************************
+ use types
+ use geometry
+ use variables
+
+ implicit none
+!
+!***********************************************************************
+
+!
+! Local variables
+!
+ integer :: inp,i,ib,ijb
+ real(dp) :: curx,cury,curz
+ real(dp) :: curcx,curcy,curcz
+
+ ! Cells loop
+ do inp=1,numCells
+
+ ! _ _
+ ! > Calculate induced current uxB
+ curix(inp)=v(inp)*bmagz(inp)-w(inp)*bmagy(inp)
+ curiy(inp)=w(inp)*bmagx(inp)-u(inp)*bmagz(inp)
+ curiz(inp)=u(inp)*bmagy(inp)-v(inp)*bmagx(inp)
+
+ ! > Calculate conductive current
+ ! Set the conductive current equal to minus the gradient of the electric potential.
+ curcx=-dEpotdxi(1,inp)
+ curcy=-dEpotdxi(2,inp)
+ curcz=-dEpotdxi(3,inp)
+
+ ! > Calculate total current
+ curx=curix(inp)+curcx
+ cury=curiy(inp)+curcy
+ curz=curiz(inp)+curcz
+
+ ! _ _
+ ! > Calculate Lorentz force JxB
+ florx(inp)=cury*bmagz(inp)-curz*bmagy(inp)
+ flory(inp)=curz*bmagx(inp)-curx*bmagz(inp)
+ florz(inp)=curx*bmagy(inp)-cury*bmagx(inp)
+
+ enddo
+
+ ! Update induced current at boundaries (useful in fvxDiv( u x B ) calculation.)
+ do ib=1,numBoundaries
+ do i=1,nfaces(ib)
+ ijb = iBndValueStart(ib) + i
+ curix(ijb)=v(ijb)*bmagz(ijb)-w(ijb)*bmagy(ijb)
+ curiy(ijb)=w(ijb)*bmagx(ijb)-u(ijb)*bmagz(ijb)
+ curiz(ijb)=u(ijb)*bmagy(ijb)-v(ijb)*bmagx(ijb)
+ end do
+ enddo
+
+ ! write(6,*) " Induced current: ", sum(curix), sum(curiy), sum(curiz)
+ ! write(6,*) " Force Lorentz: ", sum(florx)/numcells
+
+end subroutine
+
+
+!***********************************************************************
+!
+subroutine calculate_electric_potential
+!
+!***********************************************************************
+!
+! Assemble and solve Poisson equation for Electric potential field.
+!
+!***********************************************************************
+ use types
+ use parameters
+ use geometry
+ use variables
+ use sparse_matrix
+ use gradients
+ use title_mod
+ use fieldManipulation, only: explDiv
+
+ implicit none
+
+!
+! Local variables
+!
+ ! integer :: istage
+ real(dp) :: ppref
+ ! real(dp) :: fimax,fimin
+ ! real(dp) :: epavg
+
+ ! Initialize matrix and source arrays
+ a = 0.0_dp
+ su = 0.0_dp
+ sp = 0.0_dp
+
+ ! Nadji eksplicitnu divergenciju (u x B)
+ su( 1:numCells ) = explDiv( curix, curiy, curiz )
+
+ ! Coefficient array for Laplacian
+ sv = 1.0_dp
+
+ ! Negative Laplacian operator
+ call updateEpotAtBoundaries(1)
+ call laplacian(sv,Epot)
+
+ ! Solve system
+ pp = 0.0_dp
+ call iccg(pp,iep)
+
+ ! First way:
+ ppref = pp(pRefCell)
+ Epot(1:numCells) = (1.0_dp-urf(iep))*Epot(1:numCells) + urf(iep)*(pp(1:numCells)-ppref)
+ ! Second way:
+ ! epavg = sum(pp(1:numCells))/dble(numCells)
+ ! pp(1:numCells) = pp(1:numCells) - epavg
+ ! Epot(1:numCells) = (1.0_dp-urf(iep))*Epot(1:numCells) + urf(iep)*pp(1:numCells)
+
+ ! Update Epot at boundaries and calculate gradient right away, we'll need it.
+ call updateEpotAtBoundaries(1)
+ call grad(Epot,dEpotdxi)
+
+ ! Report range of scalar values and clip if negative
+ ! fimin = minval(Epot(1:numCells))
+ ! fimax = maxval(Epot(1:numCells))
+
+ ! write(6,'(2x,es11.4,3a,es11.4)') fimin,' <= ',chvar(iep),' <= ',fimax
+
+end subroutine
+
+
+!***********************************************************************
+!
+subroutine updateEpotAtBoundaries( istage )
+!
+!***********************************************************************
+!
+! Purpose:
+! Set Electric potential at boundaries.
+!
+! Discussion:
+! istage = 1 : At boundary faces, we set the values of owner cell,
+! we need those boundary values to be able to calculate
+! pressure or pressure correction gradients.
+! istage = 2 : We perform linear extrapolation from owner cell using
+! previosuly calculated cell centered gradients.
+! istage = 3,etc. Same as istage=2.
+! Question is do we need more than 2 passes?
+! Numerical experiments are needed.
+!
+!***********************************************************************
+!
+ use types
+ use parameters
+ use geometry
+
+ implicit none
+!
+!***********************************************************************
+!
+ integer, intent(in) :: istage
+
+ ! Locals:
+ integer :: i, ijp, ijb, iface
+ integer :: ib
+ real(dp) :: xpb, ypb, zpb
+
+ if ( istage.eq.1 ) then
+
+ ! Loop Boundary faces:
+ do ib=1,numBoundaries
+ if ( bctype(ib) == 'wall' ) then
+ do i=1,nfaces(ib)
+ iface = startFace(ib) + i
+ ijp = owner(iface)
+ ijb = iBndValueStart(ib) + i
+ Epot(ijb) = Epot(ijp)
+ end do
+ endif
+ enddo
+
+ else ! istage==2 and higher
+
+ ! ! Loop Boundary faces:
+
+ ! Wall faces
+ do ib=1,numBoundaries
+
+ if ( bctype(ib) == 'wall' ) then
+
+ do i=1,nfaces(ib)
+
+ iface = startFace(ib) + i
+ ijp = owner(iface)
+ ijb = iBndValueStart(ib) + i
+
+ ! Distance vector
+ xpb = xf(iface)-xc(ijp)
+ ypb = yf(iface)-yc(ijp)
+ zpb = zf(iface)-zc(ijp)
+
+ ! Linear extrapolation
+ Epot(ijb) = Epot(ijp) + dEpotdxi(1,ijp)*xpb+dEpotdxi(2,ijp)*ypb+dEpotdxi(3,ijp)*zpb
+
+ end do
+
+ endif
+
+ enddo
+
+ endif ! istage
+
+end subroutine
+
+end module
+
diff --git a/src/finiteVolume/fvEqnDiscretization/Pressure/calcp_piso.f90 b/src/finiteVolume/fvEqnDiscretization/Pressure/calcp_piso.f90
index c6ef936..30946c4 100644
--- a/src/finiteVolume/fvEqnDiscretization/Pressure/calcp_piso.f90
+++ b/src/finiteVolume/fvEqnDiscretization/Pressure/calcp_piso.f90
@@ -61,7 +61,7 @@ subroutine calcp_piso
use gradients
use hcoef
use fieldmanipulation
- use faceflux_mass, only: facefluxmass_piso,fluxmc
+ use faceflux_mass
implicit none
!
@@ -75,6 +75,8 @@ subroutine calcp_piso
! Before entering the corection loop backup a_nb coefficient arrays:
h = a
+ if( const_mflux ) call constant_mass_flow_forcing
+
!== PISO Corrector loop =============================================
do icorr=1,ncorr
@@ -121,6 +123,7 @@ subroutine calcp_piso
! Tentative (!) velocity gradients used for velocity interpolation:
+ call updateVelocityAtBoundary
call grad(U,dUdxi)
call grad(V,dVdxi)
call grad(W,dWdxi)
@@ -130,7 +133,6 @@ subroutine calcp_piso
a = 0.0_dp
su = 0.0_dp
-
! > Assemble off diagonal entries of system matrix and find mass flux,
! accumulate diagonal entries of sysem matrix, and rhs vector stored in su array.
@@ -141,7 +143,7 @@ subroutine calcp_piso
ijn = neighbour(i)
call facefluxmass_piso( ijp, ijn, xf(i), yf(i), zf(i), arx(i), ary(i), arz(i), facint(i), &
- cap, can, flmass(i), flmasso(i), flmassoo(i),flmassooo(i) )
+ cap, can, flmass(i) )!, flmasso(i), flmassoo(i),flmassooo(i) )
! > Off-diagonal elements:
@@ -233,28 +235,34 @@ subroutine calcp_piso
!
! Solve pressure equation system
!
- call iccg(p,ip)
+ call iccg(pp,ip)
! We have pure Neumann problem - take out the average of the field as the additive constant
- pavg = sum(p(1:numCells))/dble(numCells)
- p(1:numCells) = p(1:numCells) - pavg
+ pavg = sum(pp(1:numCells))/dble(numCells)
+ ! p(1:numCells) = p(1:numCells) - pavg
+
+ ! Under-relaxation
+ p(1:numCells) = (1.0_dp-urf(ip))*p(1:numCells) + urf(ip)*(pp(1:numCells)-pavg)
+
+ ! Pressure gradient
+ do istage=1,nipgrad
+
+ ! Pressure corr. at boundaries (for correct calculation of pp gradient)
+ call bpres(p,istage)
+
+ ! Calculate pressure-correction gradient and store it in pressure gradient field.
+ call grad(p,dPdxi)
+ end do
+
+ ! If simulation uses least-squares gradients call this to get conservative pressure correction gradients.
+ if ( lstsq_qr .or. lstsq_dm .or. lstsq_qr ) call grad(p,dPdxi,'gauss_corrected','nolimit')
!
! Laplacian source term modification due to non-orthogonality.
!
if(ipcorr.ne.npcor) then
- ! Pressure gradient
- do istage=1,nipgrad
-
- ! Pressure at boundaries.
- call bpres(p,istage)
-
- ! Calculate pressure gradient field.
- call grad(p,dPdxi,'gauss_corrected','no-limit')
-
- end do
! Add nonorthogonal terms from laplacian discretization to RHS of pressure eqn.
do i=1,numInnerFaces
@@ -267,16 +275,12 @@ subroutine calcp_piso
su(ijp) = su(ijp)-fmcor
su(ijn) = su(ijn)+fmcor
- enddo
-
-
+ enddo
- !// On the last non-orthogonality correction, correct the flux using the most up-to-date pressure
- !// The .flux method includes contributions from all implicit terms of the pEqn (the Laplacian)
- ! phi -= pEqn.flux();
-
- ! We have hit the last iteration of nonorthogonality correction:
- else ! or in other words if(ipcorr.eq.npcor) then
+ !
+ ! We have hit the last iteration of nonorthogonality correction:
+ !
+ else ! or in other words if(ipcorr.eq.npcor) then
!
! Correct mass fluxes at inner cv-faces only (only inner flux)
@@ -299,16 +303,16 @@ subroutine calcp_piso
! Additional mass flux correction due to non-orthogonality.
!
- ! Pressure gradient
- do istage=1,nipgrad
+ ! ! Pressure gradient
+ ! do istage=1,nipgrad
- ! Pressure at boundaries.
- call bpres(p,istage)
+ ! ! Pressure at boundaries.
+ ! call bpres(p,istage)
- ! Calculate pressure gradient field.
- call grad(p,dPdxi,'gauss_corrected','nolimit')
+ ! ! Calculate pressure gradient field.
+ ! call grad(p,dPdxi,'gauss_corrected','no-limit')
- end do
+ ! end do
! do i=1,numInnerFaces
@@ -327,7 +331,6 @@ subroutine calcp_piso
!~~~~ END: Non orthogonal corrections loop ~~~~~~~~~~~~~~~~~~~~~~~~~
enddo
-stop
!// Add pressure gradient to interior velocity and BC's. Note that this pressure is not just a small
!// correction to a previous pressure, but is the entire pressure field. Contrast this to the use of p'
@@ -338,9 +341,9 @@ subroutine calcp_piso
! Correct velocities
!
do inp=1,numCells
- u(inp) = u(inp) - apu(inp)*dPdxi(1,inp)*vol(inp)
- v(inp) = v(inp) - apv(inp)*dPdxi(2,inp)*vol(inp)
- w(inp) = w(inp) - apw(inp)*dPdxi(3,inp)*vol(inp)
+ u(inp) = u(inp) - apu(inp)*dPdxi(1,inp)*vol(inp)
+ v(inp) = v(inp) - apv(inp)*dPdxi(2,inp)*vol(inp)
+ w(inp) = w(inp) - apw(inp)*dPdxi(3,inp)*vol(inp)
enddo
! Explicit correction of boundary conditions
diff --git a/src/finiteVolume/fvEqnDiscretization/Pressure/calcp_simple.f90 b/src/finiteVolume/fvEqnDiscretization/Pressure/calcp_simple.f90
index b7c6611..99368e4 100644
--- a/src/finiteVolume/fvEqnDiscretization/Pressure/calcp_simple.f90
+++ b/src/finiteVolume/fvEqnDiscretization/Pressure/calcp_simple.f90
@@ -35,6 +35,9 @@ subroutine calcp_simple
a = 0.0_dp
su = 0.0_dp
+
+ if( const_mflux ) call constant_mass_flow_forcing
+
! Tentative (!) velocity gradients used for velocity interpolation:
call grad(U,dUdxi)
call grad(V,dVdxi)
@@ -150,6 +153,7 @@ subroutine calcp_simple
! If simulation uses least-squares gradients call this to get conservative pressure correction gradients.
if ( lstsq_qr .or. lstsq_dm .or. lstsq_qr ) call grad(pp,dPdxi,'gauss_corrected','nolimit')
+
! Reference pressure correction - p'
ppref = pp(pRefCell)
diff --git a/src/finiteVolume/fvEqnDiscretization/Pressure/continuityErrors.f90 b/src/finiteVolume/fvEqnDiscretization/Pressure/continuityErrors.f90
index 22f0196..b150ebd 100644
--- a/src/finiteVolume/fvEqnDiscretization/Pressure/continuityErrors.f90
+++ b/src/finiteVolume/fvEqnDiscretization/Pressure/continuityErrors.f90
@@ -6,8 +6,9 @@ subroutine continuityErrors
use types
use parameters, only: sumLocalContErr, globalContErr, cumulativeContErr
use geometry, only: numInnerFaces, owner, neighbour, numBoundaries, bctype, nfaces, startFace
- use sparse_matrix, only: res
+ use sparse_matrix, only: res,apu
use variables, only: flmass
+ use fieldManipulation, only: volumeWeightedAverage
implicit none
@@ -54,11 +55,11 @@ subroutine continuityErrors
enddo
- ! sumLocalContErr = volumeWeightedAverage( abs(res) )
+ sumLocalContErr = volumeWeightedAverage( abs(res*apu) )
! globalContErr = volumeWeightedAverage( res )
- sumLocalContErr = sum( abs( res ) )
+ ! sumLocalContErr = sum( abs( res ) )
globalContErr = sum( res )
@@ -66,7 +67,7 @@ subroutine continuityErrors
res = 0.0_dp
- write(6,'(3(a,es10.3))') " time step continuity errors : sum local = ", sumLocalContErr, &
+ write(6,'(3(a,es10.3))') " time step continuity errors : avg local = ", sumLocalContErr, &
& ", global = ", globalContErr, &
& ", cumulative = ", cumulativeContErr
diff --git a/src/finiteVolume/fvEqnDiscretization/ScalarEqns/concentration.f90 b/src/finiteVolume/fvEqnDiscretization/ScalarEqns/concentration.f90
index 974da40..4be09dc 100644
--- a/src/finiteVolume/fvEqnDiscretization/ScalarEqns/concentration.f90
+++ b/src/finiteVolume/fvEqnDiscretization/ScalarEqns/concentration.f90
@@ -85,7 +85,7 @@ subroutine calcsc(Fi,dFidxi,ifi)
!
! UNSTEADY TERM
!
- if( bdf ) then
+ if( bdf .or. cn ) then
apotime = den(inp)*vol(inp)/timestep
su(inp) = su(inp) + apotime*cono(inp)
sp(inp) = sp(inp) + apotime
diff --git a/src/finiteVolume/fvEqnDiscretization/ScalarEqns/temperature.f90 b/src/finiteVolume/fvEqnDiscretization/ScalarEqns/temperature.f90
index d19b697..a240c9a 100644
--- a/src/finiteVolume/fvEqnDiscretization/ScalarEqns/temperature.f90
+++ b/src/finiteVolume/fvEqnDiscretization/ScalarEqns/temperature.f90
@@ -6,12 +6,12 @@ module temperature
use parameters
use geometry
use variables
- use scalar_fluxes, only: facefluxsc
+ ! use scalar_fluxes, only: facefluxsc
implicit none
! Constants
- real(dp), parameter :: sigt = 0.85_dp
+ real(dp), parameter :: sigt = 1.0_dp
private
@@ -22,7 +22,7 @@ module temperature
contains
-subroutine calculate_temperature_field()
+subroutine calculate_temperature_field
!
! Main module routine to assemble and solve temperature field.
!
@@ -30,6 +30,7 @@ subroutine calculate_temperature_field()
use parameters
use variables
use gradients
+
implicit none
call calcsc(T,dTdxi,ien) ! Assemble and solve temperature eq.
@@ -63,18 +64,18 @@ subroutine calcsc(Fi,dFidxi,ifi)
!
! Local variables
!
- integer :: i, k, inp, ijp, ijn, ijb, ib, iface
+ integer :: i, k, inp, ijp, ijn, ijb, ib, iface, iWall
real(dp) :: gam, prtr, apotime, urfrs, urfms
real(dp) :: cap, can, suadd
real(dp) :: off_diagonal_terms
real(dp) :: coef,dcoef
real(dp) :: fimax,fimin
- real(dp) :: arx,ary,arz,are,nxf,nyf,nzf,dTn
+ real(dp) :: are,nxf,nyf,nzf,dTn
! Variable specific coefficients:
gam = gds(ifi)
- prtr = 1.0d0/sigt
+ prtr = 1.0d0/pranl
! Calculate gradient:
call grad(fi,dfidxi)
@@ -91,14 +92,16 @@ subroutine calcsc(Fi,dFidxi,ifi)
! Unsteady Term
- if( bdf ) then
- apotime = den(inp)*vol(inp)/timestep
- su(inp) = su(inp) + apotime*to(inp)
- sp(inp) = sp(inp) + apotime
- elseif( bdf2 ) then
- apotime=den(inp)*vol(inp)/timestep
- su(inp) = su(inp) + apotime*( 2*to(inp) - 0.5_dp*too(inp) )
- sp(inp) = sp(inp) + 1.5_dp*apotime
+ if (ltransient) then
+ if( bdf .or. cn ) then
+ apotime = den(inp)*vol(inp)/timestep
+ su(inp) = su(inp) + apotime*to(inp)
+ sp(inp) = sp(inp) + apotime
+ elseif( bdf2 ) then
+ apotime=den(inp)*vol(inp)/timestep
+ su(inp) = su(inp) + apotime*( 2*to(inp) - 0.5_dp*too(inp) )
+ sp(inp) = sp(inp) + 1.5_dp*apotime
+ endif
endif
@@ -117,40 +120,40 @@ subroutine calcsc(Fi,dFidxi,ifi)
! Inner faces:
do i=1,numInnerFaces
- ijp = owner(i)
- ijn = neighbour(i)
+ ijp = owner(i)
+ ijn = neighbour(i)
- call facefluxsc( ijp, ijn, &
- xf(i), yf(i), zf(i), arx(i), ary(i), arz(i), &
- flmass(i), facint(i), gam, &
- fi, dFidxi, prtr, cap, can, suadd )
+ call facefluxsc( ijp, ijn, &
+ xf(i), yf(i), zf(i), arx(i), ary(i), arz(i), &
+ flmass(i), facint(i), gam, &
+ fi, dFidxi, prtr, cap, can, suadd )
- ! > Off-diagonal elements:
+ ! > Off-diagonal elements:
- ! (icell,jcell) matrix element:
- k = icell_jcell_csr_index(i)
- a(k) = can
+ ! (icell,jcell) matrix element:
+ k = icell_jcell_csr_index(i)
+ a(k) = can
- ! (jcell,icell) matrix element:
- k = jcell_icell_csr_index(i)
- a(k) = cap
+ ! (jcell,icell) matrix element:
+ k = jcell_icell_csr_index(i)
+ a(k) = cap
- ! > Elements on main diagonal:
+ ! > Elements on main diagonal:
- ! ! (icell,icell) main diagonal element
- ! k = diag(ijp)
- ! a(k) = a(k) - can
- sp(ijp) = sp(ijp) - can
+ ! ! (icell,icell) main diagonal element
+ k = diag(ijp)
+ a(k) = a(k) - can
+ ! sp(ijp) = sp(ijp) - can
- ! ! (jcell,jcell) main diagonal element
- ! k = diag(ijn)
- ! a(k) = a(k) - cap
- sp(ijn) = sp(ijn) - cap
+ ! ! (jcell,jcell) main diagonal element
+ k = diag(ijn)
+ a(k) = a(k) - cap
+ !sp(ijn) = sp(ijn) - cap
- ! > Sources:
+ ! > Explicit part of convection and difussion fluxes
- su(ijp) = su(ijp) + suadd
- su(ijn) = su(ijn) - suadd
+ su(ijp) = su(ijp) + suadd
+ su(ijn) = su(ijn) - suadd
enddo
@@ -159,6 +162,8 @@ subroutine calcsc(Fi,dFidxi,ifi)
! Boundary conditions
!
+ iWall = 0
+
do ib=1,numBoundaries
if ( bctype(ib) == 'inlet' ) then
@@ -169,7 +174,7 @@ subroutine calcsc(Fi,dFidxi,ifi)
ijp = owner(iface)
ijb = iBndValueStart(ib) + i
- call facefluxsc( ijp, ijb, &
+ call facefluxsc_boundary( ijp, ijb, &
xf(iface), yf(iface), zf(iface), arx(iface), ary(iface), arz(iface), &
flmass(iface), &
Fi, dFidxi, prtr, cap, can, suadd)
@@ -188,7 +193,7 @@ subroutine calcsc(Fi,dFidxi,ifi)
ijp = owner(iface)
ijb = iBndValueStart(ib) + i
- call facefluxsc( ijp, ijb, &
+ call facefluxsc_boundary( ijp, ijb, &
xf(iface), yf(iface), zf(iface), arx(iface), ary(iface), arz(iface), &
flmass(iface), &
FI, dFidxi, prtr, cap, can, suadd )
@@ -199,7 +204,7 @@ subroutine calcsc(Fi,dFidxi,ifi)
end do
- elseif ( bctype(ib) == 'wallIsoth') then
+ elseif ( bctype(ib) == 'wall') then
! Isothermal wall boundaries (that's Dirichlet on temperature)
@@ -208,10 +213,13 @@ subroutine calcsc(Fi,dFidxi,ifi)
iface = startFace(ib) + i
ijp = owner(iface)
ijb = iBndValueStart(ib) + i
+ iWall = iWall + 1
- dcoef = (viscos+(vis(ijp)-viscos)/sigt)/pranl ! Vrlo diskutabilno, proveriti!
- coef=dcoef*srdw(i)
- a(diag(ijp)) = a(diag(ijp)) + coef
+ dcoef = viscos/pranl+(vis(ijp)-viscos)/sigt
+ coef=dcoef*srdw(iWall)
+ !# are = sqrt(arx(iface)**2+ary(iface)**2+arz(iface)**2)
+ !# coef = dcoef*are/dnw(iWall)
+ sp(ijp) = sp(ijp) + coef
su(ijp) = su(ijp) + coef*t(ijb)
enddo
@@ -240,9 +248,10 @@ subroutine calcsc(Fi,dFidxi,ifi)
iface = startFace(ib) + i
ijp = owner(iface)
ijb = iBndValueStart(ib) + i
+ iWall = iWall + 1
- dcoef = (viscos+(vis(ijp)-viscos)/sigt)/pranl
- coef=dcoef*srdw(i)
+ dcoef = viscos/pranl+(vis(ijp)-viscos)/sigt
+ coef=dcoef*srdw(iWall)
! Value of the temprature gradient in normal direction is set trough
! proper choice of component values. Let's project in to normal direction
@@ -257,7 +266,7 @@ subroutine calcsc(Fi,dFidxi,ifi)
nzf = arz(iface)/are
! Gradient in face-normal direction
- dTn = (dTdxi(1,ijb)*nxf+dTdxi(2,ijb)*nyf+dTdxi(3,ijb)*nzf))
+ dTn = dTdxi(1,ijb)*nxf+dTdxi(2,ijb)*nyf+dTdxi(3,ijb)*nzf
! Explicit source
su(ijp) = su(ijp) + coef*dTn
@@ -274,24 +283,24 @@ subroutine calcsc(Fi,dFidxi,ifi)
! Modify coefficients for Crank-Nicolson
if (cn) then
- a = 0.5_dp*a ! Doesn't affect the main diagonal because it's still zero.
+ a = 0.5_dp*a ! Doesn't affect the main diagonal because it's still zero.
- do i = 1,numInnerFaces
- ijp = owner(i)
- ijn = neighbour(i)
+ do i = 1,numInnerFaces
+ ijp = owner(i)
+ ijn = neighbour(i)
- k = icell_jcell_csr_index(i)
- su(ijp) = su(ijp) - a(k)*to(ijn)
+ k = icell_jcell_csr_index(i)
+ su(ijp) = su(ijp) - a(k)*to(ijn)
- k = jcell_icell_csr_index(i)
- su(ijn) = su(ijn) - a(k)*to(ijp)
- enddo
- do ijp=1,numCells
- apotime=den(ijp)*vol(ijp)/timestep
- off_diagonal_terms = sum( a( ioffset(ijp) : ioffset(ijp+1)-1 ) ) !- a(diag(ijp))
- su(ijp) = su(ijp) + (apotime + off_diagonal_terms)*to(ijp)
- sp(ijp) = sp(ijp)+apotime
- enddo
+ k = jcell_icell_csr_index(i)
+ su(ijn) = su(ijn) - a(k)*to(ijp)
+ enddo
+ do ijp=1,numCells
+ apotime=den(ijp)*vol(ijp)/timestep
+ off_diagonal_terms = sum( a( ioffset(ijp) : ioffset(ijp+1)-1 ) ) - a(diag(ijp))
+ su(ijp) = su(ijp) + (apotime + off_diagonal_terms)*to(ijp)
+ sp(ijp) = sp(ijp)+apotime
+ enddo
endif
@@ -301,15 +310,16 @@ subroutine calcsc(Fi,dFidxi,ifi)
! Main diagonal term assembly:
do inp = 1,numCells
- ! Main diagonal term assembly:
- ! Sum all coefs in a row of a sparse matrix, but since we also included diagonal element
- ! we substract it from the sum, to eliminate it from the sum.
- off_diagonal_terms = sum( a(ioffset(inp) : ioffset(inp+1)-1) ) !- a(diag(ijp)) because = 0
- a(diag(inp)) = sp(inp) - off_diagonal_terms
- ! Underelaxation:
- a(diag(inp)) = a(diag(inp))*urfrs
- su(inp) = su(inp) + urfms*a(diag(inp))*fi(inp)
+ ! Main diagonal term assembly:
+ ! Sum all coefs in a row of a sparse matrix, but since we also included diagonal element
+ ! we substract it from the sum, to eliminate it from the sum.
+ off_diagonal_terms = sum( a(ioffset(inp) : ioffset(inp+1)-1) ) - a(diag(inp))
+ a(diag(inp)) = sp(inp) - off_diagonal_terms
+
+ ! Underelaxation:
+ a(diag(inp)) = a(diag(inp))*urfrs
+ su(inp) = su(inp) + urfms*a(diag(inp))*fi(inp)
enddo
@@ -348,4 +358,292 @@ subroutine calcsc(Fi,dFidxi,ifi)
end subroutine calcsc
+
+!***********************************************************************
+!
+subroutine facefluxsc(ijp, ijn, xf, yf, zf, arx, ary, arz, &
+ flmass, lambda, gam, FI, dFidxi, &
+ prtr, cap, can, suadd)
+!
+!***********************************************************************
+!
+ use types
+ use parameters
+ use variables, only: vis
+ use interpolation
+ use gradients
+
+ implicit none
+!
+!***********************************************************************
+!
+
+ integer, intent(in) :: ijp, ijn
+ real(dp), intent(in) :: xf,yf,zf
+ real(dp), intent(in) :: arx, ary, arz
+ real(dp), intent(in) :: flmass
+ real(dp), intent(in) :: lambda
+ real(dp), intent(in) :: gam
+ real(dp), dimension(numTotal), intent(in) :: Fi
+ real(dp), dimension(3,numCells), intent(in) :: dFidxi
+ real(dp), intent(in) :: prtr
+ real(dp), intent(inout) :: cap, can, suadd
+
+
+! Local variables
+ integer :: nrelax
+ character(len=12) :: approach
+ real(dp) :: are
+ real(dp) :: xpn,ypn,zpn!, xi,yi,zi,r1,r2,psie,psiw
+ real(dp) :: dpn
+ real(dp) :: Cp,Ce
+ real(dp) :: fii,fm
+ real(dp) :: fdfie,fdfii,fcfie,fcfii,ffic
+ real(dp) :: de, game, viste
+ real(dp) :: fxp,fxn
+ real(dp) :: dfixi,dfiyi,dfizi
+ real(dp) :: dfixii,dfiyii,dfizii
+!----------------------------------------------------------------------
+
+ ! > Geometry:
+
+ ! Face interpolation factor
+ fxn=lambda
+ fxp=1.0_dp-lambda
+
+ ! Distance vector between cell centers
+ xpn=xc(ijn)-xc(ijp)
+ ypn=yc(ijn)-yc(ijp)
+ zpn=zc(ijn)-zc(ijp)
+
+ ! Distance from P to neighbor N
+ dpn=sqrt(xpn**2+ypn**2+zpn**2)
+
+ ! cell face area
+ are=sqrt(arx**2+ary**2+arz**2)
+
+
+ ! Cell face diffussion coefficient
+ viste = (vis(ijp)-viscos)*fxp+(vis(ijn)-viscos)*fxn
+ game = viscos*prtr+viste/sigt
+
+
+ ! Difusion coefficient for linear system
+ ! de = game*are/dpn
+ de = game*(arx*arx+ary*ary+arz*arz)/(xpn*arx+ypn*ary+zpn*arz)
+
+ ! Convection fluxes - uds
+ fm = flmass
+ ce = min(fm,zero)
+ cp = max(fm,zero)
+
+ !-------------------------------------------------------
+ ! System matrix coefficients
+ !-------------------------------------------------------
+ cap = -de - max(fm,zero)
+ can = -de + min(fm,zero)
+ !-------------------------------------------------------
+
+
+ !-------------------------------------------------------
+ ! Explicit part of diffusion
+ !-------------------------------------------------------
+
+ nrelax = 0
+ approach = 'skewness'
+ ! approach = 'offset'
+
+ call sngrad(ijp, ijn, xf, yf, zf, arx, ary, arz, lambda, &
+ Fi, dFidxi, nrelax, approach, dfixi, dfiyi, dfizi, &
+ dfixii, dfiyii, dfizii)
+
+
+ ! Explicit diffusion
+ fdfie = game*(dfixii*arx + dfiyii*ary + dfizii*arz)
+
+ ! Implicit diffussion
+ fdfii = game*are/dpn*(dfixi*xpn+dfiyi*ypn+dfizi*zpn)
+
+
+ !-------------------------------------------------------
+ ! Explicit higher order convection
+ !-------------------------------------------------------
+ if( flmass .ge. zero ) then
+ ! Flow goes from p to pj - > p is the upwind node
+ fii = face_value(ijp, ijn, xf, yf, zf, fxp, fi, dFidxi)
+ else
+ ! Other way, flow goes from pj, to p -> pj is the upwind node.
+ fii = face_value(ijn, ijp, xf, yf, zf, fxn, fi, dFidxi)
+ endif
+
+ fcfie = fm*fii
+
+ !-------------------------------------------------------
+ ! Explicit first order convection
+ !-------------------------------------------------------
+ fcfii = ce*fi(ijn)+cp*fi(ijp)
+
+ !-------------------------------------------------------
+ ! Deffered correction for convection = gama_blending*(high-low)
+ !-------------------------------------------------------
+ ffic = gam*(fcfie-fcfii)
+
+ !-------------------------------------------------------
+ ! Explicit part of fluxes
+ !-------------------------------------------------------
+ suadd = -ffic+fdfie-fdfii
+
+end subroutine
+
+
+!***********************************************************************
+!
+subroutine facefluxsc_boundary(ijp, ijn, xf, yf, zf, arx, ary, arz, flmass, FI, dFidxi, prtr, cap, can, suadd)
+!
+!***********************************************************************
+!
+ use types
+ use parameters
+ use variables, only: vis
+ use gradients
+
+ implicit none
+!
+!***********************************************************************
+!
+
+ integer, intent(in) :: ijp, ijn
+ real(dp), intent(in) :: xf,yf,zf
+ real(dp), intent(in) :: arx, ary, arz
+ real(dp), intent(in) :: flmass
+ real(dp), dimension(numTotal), intent(in) :: Fi
+ real(dp), dimension(3,numTotal), intent(in) :: dFidxi
+ real(dp), intent(in) :: prtr
+ real(dp), intent(inout) :: cap, can, suadd
+
+
+! Local variables
+ real(dp) :: are
+ real(dp) :: xpn,ypn,zpn
+ real(dp) :: nxx,nyy,nzz,ixi1,ixi2,ixi3,dpn,costheta,costn
+ real(dp) :: Cp,Ce
+ real(dp) :: fm
+ real(dp) :: fdfie,fdfii
+ real(dp) :: d1x,d1y,d1z,d2x,d2y,d2z
+ real(dp) :: de, vole, game, viste
+ real(dp) :: fxp,fxn
+ real(dp) :: dfixi,dfiyi,dfizi
+ real(dp) :: dfixii,dfiyii,dfizii
+
+!----------------------------------------------------------------------
+
+ dfixi = 0.0_dp
+ dfiyi = 0.0_dp
+ dfizi = 0.0_dp
+
+ ! > Geometry:
+
+ ! Face interpolation factor
+ fxn=1.0_dp
+ fxp=0.0_dp
+
+ ! Distance vector between cell center and face center
+ xpn=xf-xc(ijp)
+ ypn=yf-yc(ijp)
+ zpn=zf-zc(ijp)
+
+ ! Distance from P to neighbor N
+ dpn=sqrt(xpn**2+ypn**2+zpn**2)
+
+ ! Components of the unit vector i_ksi
+ ixi1=xpn/dpn
+ ixi2=ypn/dpn
+ ixi3=zpn/dpn
+
+ ! Cell face area
+ are=sqrt(arx**2+ary**2+arz**2)
+
+ ! Unit vectors of the normal
+ nxx=arx/are
+ nyy=ary/are
+ nzz=arz/are
+
+ ! Angle between vectors n and i_xi - we need cosine
+ costheta=nxx*ixi1+nyy*ixi2+nzz*ixi3
+
+ ! Relaxation factor for higher-order cell face gradient
+ ! Minimal correction: nrelax = +1 :
+ !costn = costheta
+ ! Orthogonal correction: nrelax = 0 :
+ costn = 1.0_dp
+ ! Over-relaxed approach: nrelax = -1 :
+ !costn = 1./costheta
+ ! In general, nrelax can be any signed integer from some
+ ! reasonable interval [-nrelax,nrelax] (or maybe even real number):
+ !costn = costheta**nrelax
+
+ ! dpp_j * sf
+ vole=xpn*arx+ypn*ary+zpn*arz
+
+
+ ! Turbulent viscosity
+ viste = vis(ijn)-viscos
+
+ ! Cell face diffussion coefficient for TEMPERATURE
+ game = viscos*prtr + viste/sigt
+
+
+ !-- Skewness correction --
+
+ ! Overrelaxed correction vector d2, where s=dpn+d2
+ d1x = costn
+ d1y = costn
+ d1z = costn
+
+ d2x = xpn*costn
+ d2y = ypn*costn
+ d2z = zpn*costn
+
+ ! Interpolate gradients defined at CV centers to faces..
+ ! It should be dFidxi(:,ijn), because fxn=1.0, but we write dFidxi(:,ijp) because constant gradient
+ ! is applied between cell center and boundary cell face.
+ dfixi = dFidxi(1,ijp)
+ dfiyi = dFidxi(2,ijp)
+ dfizi = dFidxi(3,ijp)
+
+ !.....du/dx_i interpolated at cell face:
+ dfixii = dfixi*d1x + arx/vole*( fi(ijn)-fi(ijp)-dfixi*d2x-dfiyi*d2y-dfizi*d2z )
+ dfiyii = dfiyi*d1y + ary/vole*( fi(ijn)-fi(ijp)-dfixi*d2x-dfiyi*d2y-dfizi*d2z )
+ dfizii = dfizi*d1z + arz/vole*( fi(ijn)-fi(ijp)-dfixi*d2x-dfiyi*d2y-dfizi*d2z )
+
+ !-- Skewness correction --
+
+
+ ! Explicit diffusion
+ fdfie = game*(dfixii*arx + dfiyii*ary + dfizii*arz)
+
+ ! Implicit diffussion
+ fdfii = game*are/dpn*(dfixi*xpn+dfiyi*ypn+dfizi*zpn)
+
+
+ ! Difusion coefficient
+ de = game*are/dpn
+
+ ! Convection fluxes - uds
+ fm = flmass
+ ce = min(fm,zero)
+ cp = max(fm,zero)
+
+ ! System matrix coefficients
+ cap = -de - max(fm,zero)
+ can = -de + min(fm,zero)
+
+ !-------------------------------------------------------
+ ! Explicit part of fluxes
+ !-------------------------------------------------------
+ suadd = fdfie-fdfii
+ !-------------------------------------------------------
+
+end subroutine
+
end module temperature
\ No newline at end of file
diff --git a/src/finiteVolume/fvEqnDiscretization/TurbulenceModels/correct_turbulence.f90 b/src/finiteVolume/fvEqnDiscretization/TurbulenceModels/correct_turbulence.f90
index 1ee2c35..62186ec 100644
--- a/src/finiteVolume/fvEqnDiscretization/TurbulenceModels/correct_turbulence.f90
+++ b/src/finiteVolume/fvEqnDiscretization/TurbulenceModels/correct_turbulence.f90
@@ -10,8 +10,11 @@ subroutine correct_turbulence()
use k_omega_sst
use k_eqn_eddy
use spalart_allmaras
+
implicit none
+!+----------------------------------------------------------------------------+!
+
! Velocity gradients:
call grad(U,dUdxi)
@@ -48,5 +51,7 @@ subroutine correct_turbulence()
end select
+
+
end subroutine
diff --git a/src/finiteVolume/fvEqnDiscretization/TurbulenceModels/k_epsilon_rlzb.f90 b/src/finiteVolume/fvEqnDiscretization/TurbulenceModels/k_epsilon_rlzb.f90
index 39aebec..51e5365 100644
--- a/src/finiteVolume/fvEqnDiscretization/TurbulenceModels/k_epsilon_rlzb.f90
+++ b/src/finiteVolume/fvEqnDiscretization/TurbulenceModels/k_epsilon_rlzb.f90
@@ -220,7 +220,7 @@ subroutine calcsc(Fi,dFidxi,ifi)
!=====================================
! UNSTEADY TERM
!=====================================
- if( bdf ) then
+ if( bdf .or. cn ) then
apotime = den(inp)*vol(inp)/timestep
su(inp) = su(inp) + apotime*teo(inp)
sp(inp) = sp(inp) + apotime
@@ -292,7 +292,7 @@ subroutine calcsc(Fi,dFidxi,ifi)
!=====================================
!.....UNSTEADY TERM
!=====================================
- if( bdf ) then
+ if( bdf .or. cn ) then
apotime = den(inp)*vol(inp)/timestep
su(inp) = su(inp) + apotime*edo(inp)
sp(inp) = sp(inp) + apotime
diff --git a/src/finiteVolume/fvEqnDiscretization/TurbulenceModels/k_epsilon_rlzb_2lewt.f90 b/src/finiteVolume/fvEqnDiscretization/TurbulenceModels/k_epsilon_rlzb_2lewt.f90
index bda543d..4a213ba 100644
--- a/src/finiteVolume/fvEqnDiscretization/TurbulenceModels/k_epsilon_rlzb_2lewt.f90
+++ b/src/finiteVolume/fvEqnDiscretization/TurbulenceModels/k_epsilon_rlzb_2lewt.f90
@@ -126,6 +126,7 @@ subroutine calcsc(Fi,dFidxi,ifi)
real(dp) :: dudx,dudy,dudz,dvdx,dvdy,dvdz,dwdx,dwdy,dwdz
real(dp) :: viss
real(dp) :: fimax,fimin
+ real(dp) :: k12,Rey,lambeps,leps,eps2l
! Variable specific coefficients:
@@ -228,7 +229,7 @@ subroutine calcsc(Fi,dFidxi,ifi)
!=====================================
! UNSTEADY TERM
!=====================================
- if( bdf ) then
+ if( bdf .or. cn ) then
apotime = den(inp)*vol(inp)/timestep
su(inp) = su(inp) + apotime*teo(inp)
sp(inp) = sp(inp) + apotime
@@ -262,8 +263,7 @@ subroutine calcsc(Fi,dFidxi,ifi)
su(inp)=c1*genp*ed(inp)*vol(inp)
! Destruction of dissipation
- sp(inp)=c2*den(inp)*ed(inp)*vol(inp)/ &
- ( te(inp)+sqrt(viscos/densit*ed(inp)) )
+ sp(inp)=c2*den(inp)*ed(inp)*vol(inp)/( te(inp)+sqrt(viscos/densit*ed(inp)) )
! Negative value of production moved to lhs.
sp(inp) = sp(inp) - c1*genn*ed(inp)*vol(inp)
@@ -300,7 +300,7 @@ subroutine calcsc(Fi,dFidxi,ifi)
!=====================================
!.....UNSTEADY TERM
!=====================================
- if( bdf ) then
+ if( bdf .or. cn ) then
apotime = den(inp)*vol(inp)/timestep
su(inp) = su(inp) + apotime*edo(inp)
sp(inp) = sp(inp) + apotime
@@ -457,20 +457,20 @@ subroutine calcsc(Fi,dFidxi,ifi)
! Add this production to source vector
su(ijp)=su(ijp)+gen(ijp)*vol(ijp)
- else
- !
- ! > Wall boundary conditions for dissipation rate of turbulence kinetic energy eq.
- !
+ ! else
+ ! !
+ ! ! > Wall boundary conditions for dissipation rate of turbulence kinetic energy eq.
+ ! !
- ! Wall boundaries approximated with wall functions
- ! for correct values of dissipation all coefficients have
- ! to be zero, su equal the dissipation, and diagonal element a(diag(ijp)) = 1
+ ! ! Wall boundaries approximated with wall functions
+ ! ! for correct values of dissipation all coefficients have
+ ! ! to be zero, su equal the dissipation, and diagonal element a(diag(ijp)) = 1
- a( ioffset(ijp):ioffset(ijp+1)-1 ) = 0.0_dp
- sp(ijp) = 1.0_dp
+ ! a( ioffset(ijp):ioffset(ijp+1)-1 ) = 0.0_dp
+ ! sp(ijp) = 1.0_dp
- ed(ijp)=cmu75*te(ijp)**1.5/(cappa*dnw(iWall))
- su(ijp)=ed(ijp)
+ ! ed(ijp)=cmu75*te(ijp)**1.5/(cappa*dnw(iWall))
+ ! su(ijp)=ed(ijp)
endif
@@ -480,6 +480,61 @@ subroutine calcsc(Fi,dFidxi,ifi)
enddo ! Boundary conditions loop
+
+
+ if(ifi .eq.ied) then
+
+ ! The two-layer apprach - enhanced wall treatment
+ ! Penalty approach to set epsilon in 'near wall region' based on Rey
+ ! This will overwite what is set for the wall adjecent layer in boundary conditions loop above
+ ! and expand the region where epsilon is set to a specifi value - the whole region where Rey < Rey*
+
+ ! Loop over cells
+ do inp=1,numCells
+
+ ! sqrt(tke)
+ k12 = sqrt(abs(te(inp)))
+
+ !
+ ! Re number based on wall distance
+ !
+ Rey = den(inp)*wallDistance(inp)*k12/viscos
+
+ if (Rey < Reyst) then
+
+ !
+ ! **Now perform Jonger blending (check parameters in the header of the module and change in needed)
+ !
+
+ ! Blending factor
+ lambeps = 0.5_dp*( 1 + tanh( (Rey - Reyst)/Ablend ) )
+
+
+ ! While here we will also produce new value for epsilon based on blending between two values
+ leps = wallDistance(inp)*Clst*( 1.0-exp(-Rey/Aeps) ) ! the Chen-Patel length scale
+
+ ! Inner layer value for issipation
+ eps2l = k12**3/leps
+
+ !
+ ! **Now perform Jonger blending for dissipation
+ !
+ ed(inp) = ( lambeps*ed(inp) + (1.0-lambeps)*eps2l )
+
+ !
+ ! Penalty formulation - not exactly but close
+ !
+ a( ioffset(inp):ioffset(inp+1)-1 ) = 0.0_dp
+ sp(inp) = 1.0_dp
+ su(inp)=ed(inp)
+
+ endif
+
+ enddo
+
+ endif
+
+
! Modify coefficients for Crank-Nicolson
if (cn) then
@@ -604,13 +659,13 @@ subroutine modify_mu_eff()
integer :: iface, ijp,ijb,iWall,ivisc
real(dp) :: visold
real(dp) :: nxf,nyf,nzf,are
- real(dp) :: Vnp,Vtp,xtp,ytp,ztp,Ut2
+ real(dp) :: Vnp,Vtp,xtp,ytp,ztp
real(dp) :: viscw
real(dp) :: dudx,dudy,dudz,dvdx,dvdy,dvdz,dwdx,dwdy,dwdz
real(dp) :: s11,s12,s13,s21,s22,s23,s31,s32,s33,w12,w13,w23
real(dp) :: wrlzb,ffi,ass,ust,cmur,stild
- real(dp) :: k12,Rey,lmu,mut2l,mut,lambeps,leps,eps2l
- real(dp) :: Upvisc,Uplog,Uplblend,Gmblend,Utau
+ real(dp) :: k12,Rey,lmu,mut2l,mut,lambeps
+ real(dp) :: Uplblend,Utau
ivisc = 0
@@ -706,17 +761,6 @@ subroutine modify_mu_eff()
! Underelaxation
vis(inp)=urf(ivis)*vis(inp)+(1.0_dp-urf(ivis))*visold
- ! While here we will also produce new value for epsilon based on blending between two values
- leps = wallDistance(inp)*Clst*( 1.0-exp(-Rey/Aeps) ) ! the Chen-Patel length scale
-
- ! Inner layer value for issipation
- eps2l = k12**3/leps
-
- !
- ! **Now perform Jonger blending for dissipation
- !
- ed(inp) = ( lambeps*ed(inp) + (1.0-lambeps)*eps2l )
-
enddo
write(*,'(a,i0,a)') " Two-layer model: Rey < Rey* in ",ivisc," cells."
@@ -798,52 +842,78 @@ subroutine modify_mu_eff()
! Its magnitude
Vtp = sqrt(xtp*xtp+ytp*ytp+ztp*ztp)
- ! Tangent direction
- xtp = xtp/vtp
- ytp = ytp/vtp
- ztp = ztp/vtp
+ ! ! Tangent direction
+ ! xtp = xtp/vtp
+ ! ytp = ytp/vtp
+ ! ztp = ztp/vtp
! projektovanje razlike brzina na pravac tangencijalne brzine u cell centru ijp
- Ut2 = abs( (U(ijb)-U(ijp))*xtp + (V(ijb)-V(ijp))*ytp + (W(ijb)-W(ijp))*ztp )
+ ! Ut2 = abs( (U(ijb)-U(ijp))*xtp + (V(ijb)-V(ijp))*ytp + (W(ijb)-W(ijp))*ztp )
! Tau(iWall) = viscos*Ut2/dnw(iWall)
! Utau = sqrt( Tau(iWall) / den(ijb) )
! ypl(iWall) = den(ijb)*Utau*dnw(iWall)/viscos
! Ima i ova varijanta..ovo je tehnicki receno ystar iliti y* a ne y+
- ypl(iWall) = den(ijp)*cmu25*sqrt(te(ijp))*dnw(iWall)/viscos
+ ! ypl(iWall) = den(ijp)*cmu25*sqrt(te(ijp))*dnw(iWall)/viscos
viscw = zero
- if(ypl(iWall) > ctrans) then
- viscw = ypl(iWall)*viscos*cappa/log(Elog*ypl(iWall))
+ ! *** Enhanced wall treatment - Reichardt blending ***
- ! Shear stress for log region
- tau(iwall) = cappa*den(ijp)*Vtp*cmu25*sqrt(te(ijp))/log(Elog*ypl(iWall))
+ ! Below is a variant where we use Reichardt blending
+ ! for whole span of y+ values.
+ ! Some authors say that Reichardt function for u+ approximates
+ ! the composite u+(y+) curve, better that Kader blending function.
+
+ utau = sqrt( viscos*Vtp/(densit*dnw(iWall)) + cmu25*te(ijp) ) ! It's actually u* in original reference...
- elseif( ypl(iWall) > 3.0 ) then
+ ypl(iWall) = den(ijp)*Utau*dnw(iWall)/viscos
- !
- ! Enhanced wall treatment
- !
- Upvisc = ypl(iWall)
- Uplog = log(Elog*ypl(iWall))/cappa
- Gmblend = -0.01_dp*ypl(iWall)**4/(1.+5*ypl(iWall))
- Uplblend = exp(Gmblend)*Upvisc + exp(1./Gmblend)*Uplog
- viscw = ypl(iWall)*viscos/Uplblend
+ Uplblend = one/cappa*log(one+cappa*ypl(iWall)) + &
+ 7.8_dp*(1.-exp(-ypl(iWall)/11.0_dp)-(ypl(iWall)/11.0_dp)*exp(-ypl(iWall)/3.0_dp))
+
+ viscw = den(ijp)*utau*dnw(iWall)/Uplblend
- ! Blended version of shear stress
- tau(iwall) = den(ijp) * (Vtp/Uplblend)**2
+ ! Blended version of shear stress - probati ovo(!?)
+ ! tau(iWall) = den(ijp) * (Vtp/Uplblend)**2
- else
+ ! Varijanta 2, u originalnoj referenci...
+ tau(iWall) = den(ijp) * Vtp*Utau/Uplblend
- ! Shear stress for viscous region
- tau(iWall) = viscos*Ut2/dnw(iWall)
- Utau = sqrt( Tau(iWall) / den(ijp) )
- ypl(iWall) = den(ijp)*Utau*dnw(iWall)/viscos
+ !*** END: Enhanced wall treatment - Reichardt blending ***
- endif
+
+ ! if(ypl(iWall) > ctrans) then
+
+ ! viscw = ypl(iWall)*viscos*cappa/log(Elog*ypl(iWall))
+
+ ! ! Shear stress for log region
+ ! tau(iwall) = cappa*den(ijp)*Vtp*cmu25*sqrt(te(ijp))/log(Elog*ypl(iWall))
+
+ ! elseif( ypl(iWall) > 3.0 ) then
+
+ ! !
+ ! ! Enhanced wall treatment
+ ! !
+ ! Upvisc = ypl(iWall)
+ ! Uplog = log(Elog*ypl(iWall))/cappa
+ ! Gmblend = -0.01_dp*ypl(iWall)**4/(1.+5*ypl(iWall))
+ ! Uplblend = exp(Gmblend)*Upvisc + exp(1./Gmblend)*Uplog
+ ! viscw = ypl(iWall)*viscos/Uplblend
+
+ ! ! Blended version of shear stress
+ ! tau(iwall) = den(ijp) * (Vtp/Uplblend)**2
+
+ ! else
+
+ ! ! Shear stress for viscous region
+ ! tau(iWall) = viscos*Ut2/dnw(iWall)
+ ! Utau = sqrt( Tau(iWall) / den(ijp) )
+ ! ypl(iWall) = den(ijp)*Utau*dnw(iWall)/viscos
+
+ ! endif
! Set visw used in calcuvw wall bc treatment
visw(iWall) = max(viscos,viscw)
diff --git a/src/finiteVolume/fvEqnDiscretization/TurbulenceModels/k_epsilon_rng.f90 b/src/finiteVolume/fvEqnDiscretization/TurbulenceModels/k_epsilon_rng.f90
index fb7bdf1..65f2914 100644
--- a/src/finiteVolume/fvEqnDiscretization/TurbulenceModels/k_epsilon_rng.f90
+++ b/src/finiteVolume/fvEqnDiscretization/TurbulenceModels/k_epsilon_rng.f90
@@ -210,7 +210,7 @@ subroutine calcsc(Fi,dFidxi,ifi)
!=====================================
! UNSTEADY TERM
!=====================================
- if( bdf ) then
+ if( bdf .or. cn ) then
apotime = den(inp)*vol(inp)/timestep
su(inp) = su(inp) + apotime*teo(inp)
sp(inp) = sp(inp) + apotime
@@ -289,7 +289,7 @@ subroutine calcsc(Fi,dFidxi,ifi)
!=====================================
!.....UNSTEADY TERM
!=====================================
- if( bdf ) then
+ if( bdf .or. cn ) then
apotime = den(inp)*vol(inp)/timestep
su(inp) = su(inp) + apotime*edo(inp)
sp(inp) = sp(inp) + apotime
diff --git a/src/finiteVolume/fvEqnDiscretization/TurbulenceModels/k_epsilon_std.f90 b/src/finiteVolume/fvEqnDiscretization/TurbulenceModels/k_epsilon_std.f90
index 5858964..b671f61 100644
--- a/src/finiteVolume/fvEqnDiscretization/TurbulenceModels/k_epsilon_std.f90
+++ b/src/finiteVolume/fvEqnDiscretization/TurbulenceModels/k_epsilon_std.f90
@@ -219,7 +219,7 @@ subroutine calcsc(Fi,dFidxi,ifi)
!=====================================
! UNSTEADY TERM
!=====================================
- if( bdf ) then
+ if( bdf .or. cn ) then
apotime = den(inp)*vol(inp)/timestep
su(inp) = su(inp) + apotime*teo(inp)
sp(inp) = sp(inp) + apotime
@@ -288,7 +288,7 @@ subroutine calcsc(Fi,dFidxi,ifi)
!=====================================
!.....UNSTEADY TERM
!=====================================
- if( bdf ) then
+ if( bdf .or. cn ) then
apotime = den(inp)*vol(inp)/timestep
su(inp) = su(inp) + apotime*edo(inp)
sp(inp) = sp(inp) + apotime
diff --git a/src/finiteVolume/fvEqnDiscretization/TurbulenceModels/k_epsilon_std_2lewt.f90 b/src/finiteVolume/fvEqnDiscretization/TurbulenceModels/k_epsilon_std_2lewt.f90
index 1c93f00..d17831a 100644
--- a/src/finiteVolume/fvEqnDiscretization/TurbulenceModels/k_epsilon_std_2lewt.f90
+++ b/src/finiteVolume/fvEqnDiscretization/TurbulenceModels/k_epsilon_std_2lewt.f90
@@ -23,13 +23,13 @@ module k_epsilon_std_2lewt
real(dp), parameter :: CMU75 = cmu25**3
! Coefficients for 2-layer approach
- ! real(dp), parameter :: Reyst = 75.0 ! Also a value of 200.0 is reported in Fluent documenttion
- real(dp), parameter :: Reyst = 200.0 ! Also a value of 200.0 is reported in Fluent documenttion
+ real(dp), parameter :: Reyst = 75.0 ! Also a value of 200.0 is reported in Fluent documenttion
+ ! real(dp), parameter :: Reyst = 200.0 ! A value of 200.0 as reported in Fluent documenttion
real(dp), parameter :: Clst = cappa/cmu75
real(dp), parameter :: Aeps = 2*Clst
real(dp), parameter :: Amu = 70.0
- ! real(dp), parameter :: Ablend = 4.896499054173959 ! For Rey*=75 and alpha=0.15*Rey*
- real(dp), parameter :: Ablend = 13.057330811130559 ! For Rey*=200 and alpha=0.15*Rey*
+ real(dp), parameter :: Ablend = 4.896499054173959 ! For Rey*=75 and alpha=0.15*Rey*
+ ! real(dp), parameter :: Ablend = 13.057330811130559 ! For Rey*=200 and alpha=0.15*Rey*
private
@@ -125,6 +125,8 @@ subroutine calcsc(Fi,dFidxi,ifi)
real(dp) :: dudx,dudy,dudz,dvdx,dvdy,dvdz,dwdx,dwdy,dwdz
real(dp) :: viss
real(dp) :: fimax,fimin
+ real(dp) :: k12,Rey,lambeps,leps,eps2l
+
! Variable specific coefficients:
@@ -227,7 +229,7 @@ subroutine calcsc(Fi,dFidxi,ifi)
!=====================================
! UNSTEADY TERM
!=====================================
- if( bdf ) then
+ if( bdf .or. cn ) then
apotime = den(inp)*vol(inp)/timestep
su(inp) = su(inp) + apotime*teo(inp)
sp(inp) = sp(inp) + apotime
@@ -296,7 +298,7 @@ subroutine calcsc(Fi,dFidxi,ifi)
!=====================================
!.....UNSTEADY TERM
!=====================================
- if( bdf ) then
+ if( bdf .or. cn ) then
apotime = den(inp)*vol(inp)/timestep
su(inp) = su(inp) + apotime*edo(inp)
sp(inp) = sp(inp) + apotime
@@ -454,20 +456,20 @@ subroutine calcsc(Fi,dFidxi,ifi)
! Add this production to source vector
su(ijp)=su(ijp)+gen(ijp)*vol(ijp)
- else
- !
- ! > Wall boundary conditions for dissipation rate of turbulence kinetic energy eq.
- !
+ ! else
+ ! !
+ ! ! > Wall boundary conditions for dissipation rate of turbulence kinetic energy eq.
+ ! !
- ! Wall boundaries approximated with wall functions
- ! for correct values of dissipation all coefficients have
- ! to be zero, su equal the dissipation, and diagonal element a(diag(ijp)) = 1
+ ! ! Wall boundaries approximated with wall functions
+ ! ! for correct values of dissipation all coefficients have
+ ! ! to be zero, su equal the dissipation, and diagonal element a(diag(ijp)) = 1
- a( ioffset(ijp):ioffset(ijp+1)-1 ) = 0.0_dp
- sp(ijp) = 1.0_dp
+ ! a( ioffset(ijp):ioffset(ijp+1)-1 ) = 0.0_dp
+ ! sp(ijp) = 1.0_dp
- ed(ijp)=cmu75*te(ijp)**1.5/(cappa*dnw(iWall))
- su(ijp)=ed(ijp)
+ ! ed(ijp)=cmu75*te(ijp)**1.5/(cappa*dnw(iWall))
+ ! su(ijp)=ed(ijp)
endif
@@ -477,6 +479,61 @@ subroutine calcsc(Fi,dFidxi,ifi)
enddo ! Boundary conditions loop
+
+ if(ifi .eq.ied) then
+
+ ! The two-layer apprach - enhanced wall treatment
+ ! Penalty approach to set epsilon in 'near wall region' based on Rey
+ ! This will overwite what is set for the wall adjecent layer in boundary conditions loop above
+ ! and expand the region where epsilon is set to a specifi value - the whole region where Rey < Rey*
+
+ ! Loop over cells
+ do inp=1,numCells
+
+ ! sqrt(tke)
+ k12 = sqrt(abs(te(inp)))
+
+ !
+ ! Re number based on wall distance
+ !
+ Rey = den(inp)*wallDistance(inp)*k12/viscos
+
+ if (Rey < Reyst) then
+
+ !
+ ! **Now perform Jonger blending (check parameters in the header of the module and change in needed)
+ !
+
+ ! Blending factor
+ lambeps = 0.5_dp*( 1 + tanh( (Rey - Reyst)/Ablend ) )
+
+
+ ! While here we will also produce new value for epsilon based on blending between two values
+ leps = wallDistance(inp)*Clst*( 1.0-exp(-Rey/Aeps) ) ! the Chen-Patel length scale
+
+ ! Inner layer value for issipation
+ eps2l = k12**3/leps
+
+ !
+ ! **Now perform Jonger blending for dissipation
+ !
+ ed(inp) = ( lambeps*ed(inp) + (1.0-lambeps)*eps2l )
+
+ !
+ ! Penalty formulation - not exactly but close
+ !
+ a( ioffset(inp):ioffset(inp+1)-1 ) = 0.0_dp
+ sp(inp) = 1.0_dp
+ su(inp)=ed(inp)
+
+ endif
+
+ enddo
+
+ endif
+
+
+
! Modify coefficients for Crank-Nicolson
if (cn) then
@@ -545,7 +602,8 @@ subroutine calcsc(Fi,dFidxi,ifi)
enddo
! Solve linear system:
- call bicgstab(fi,ifi)
+ ! call bicgstab(fi,ifi)
+ call GaussSeidel(fi,ifi)
!
! Update symmetry and outlet boundaries
@@ -602,9 +660,10 @@ subroutine modify_mu_eff()
real(dp) :: visold
real(dp) :: nxf,nyf,nzf,are
real(dp) :: Vnp,Vtp,xtp,ytp,ztp
- real(dp) :: Ut2,Utau,viscw
- real(dp) :: k12,Rey,lmu,mut2l,mut,lambeps,leps,eps2l
- real(dp) :: Upvisc,Uplog,Uplblend,Gmblend
+ real(dp) :: Utau,viscw
+ real(dp) :: k12,Rey,lmu,mut2l,mut,lambeps
+ ! real(dp) :: Upvisc,Uplog,Gmblend
+ real(dp) :: Uplblend
ivisc = 0
@@ -648,17 +707,6 @@ subroutine modify_mu_eff()
! Underelaxation
vis(inp)=urf(ivis)*vis(inp)+(1.0_dp-urf(ivis))*visold
- ! While here we will also produce new value for epsilon based on blending between two values
- leps = wallDistance(inp)*Clst*( 1.0-exp(-Rey/Aeps) ) ! the Chen-Patel length scale
-
- ! Inner layer value for issipation
- eps2l = k12**3/leps
-
- !
- ! **Now perform Jonger blending for dissipation
- !
- ed(inp) = ( lambeps*ed(inp) + (1.0-lambeps)*eps2l )
-
enddo
write(*,'(a,i0,a)') " Two-layer model: Rey < Rey* in ",ivisc," cells."
@@ -740,53 +788,86 @@ subroutine modify_mu_eff()
! Its magnitude
Vtp = sqrt(xtp*xtp+ytp*ytp+ztp*ztp)
- ! Tangent direction
- xtp = xtp/vtp
- ytp = ytp/vtp
- ztp = ztp/vtp
+ ! ! Tangent direction
+ ! xtp = xtp/vtp
+ ! ytp = ytp/vtp
+ ! ztp = ztp/vtp
! projektovanje razlike brzina na pravac tangencijalne brzine u cell centru ijp
- Ut2 = abs( (U(ijb)-U(ijp))*xtp + (V(ijb)-V(ijp))*ytp + (W(ijb)-W(ijp))*ztp )
+ ! Ut2 = abs( (U(ijb)-U(ijp))*xtp + (V(ijb)-V(ijp))*ytp + (W(ijb)-W(ijp))*ztp )
! Tau(iWall) = viscos*Ut2/dnw(iWall)
! Utau = sqrt( Tau(iWall) / den(ijb) )
! ypl(iWall) = den(ijb)*Utau*dnw(iWall)/viscos
! ! Ima i ova varijanta u cisto turb. granicni sloj varijanti sa prvom celijom u log sloju
- ypl(iWall) = den(ijp)*cmu25*sqrt(te(ijp))*dnw(iWall)/viscos
! ! ...ovo je tehnicki receno ystar iliti y* a ne y+
+ ! ypl(iWall) = den(ijp)*cmu25*sqrt(te(ijp))*dnw(iWall)/viscos
viscw = zero
- if(ypl(iWall) > ctrans) then
+ ! *** Enhanced wall treatment - Reichardt blending ***
- viscw = ypl(iWall)*viscos*cappa/log(Elog*ypl(iWall))
+ ! Below is a variant where we use Reichardt blending
+ ! for whole span of y+ values.
+ ! Some authors say that Reichardt function for u+ approximates
+ ! the composite u+(y+) curve, better that Kader blending function.
+
+ utau = sqrt( viscos*Vtp/(densit*dnw(iWall)) + cmu25*te(ijp) ) ! It's actually u* in original reference...
- ! Shear stress for log region
- tau(iwall) = cappa*den(ijp)*Vtp*cmu25*sqrt(te(ijp))/log(Elog*ypl(iWall))
+ ypl(iWall) = den(ijp)*Utau*dnw(iWall)/viscos
- elseif( ypl(iWall) > 3.0 ) then
+ Uplblend = one/cappa*log(one+cappa*ypl(iWall)) + &
+ 7.8_dp*(1.-exp(-ypl(iWall)/11.0_dp)-(ypl(iWall)/11.0_dp)*exp(-ypl(iWall)/3.0_dp))
+
+ viscw = den(ijp)*utau*dnw(iWall)/Uplblend
- !
- ! Enhanced wall treatment
- !
- Upvisc = ypl(iWall)
- Uplog = log(Elog*ypl(iWall))/cappa
- Gmblend = -0.01_dp*ypl(iWall)**4/(1.+5*ypl(iWall))
- Uplblend = exp(Gmblend)*Upvisc + exp(1./Gmblend)*Uplog
- viscw = ypl(iWall)*viscos/Uplblend
+ ! Blended version of shear stress - probati ovo(!?)
+ ! tau(iWall) = den(ijp) * (Vtp/Uplblend)**2
- ! Blended version of shear stress
- tau(iwall) = den(ijp) * (Vtp/Uplblend)**2
+ ! Varijanta 2, u originalnoj referenci...
+ tau(iWall) = den(ijp) * Vtp*Utau/Uplblend
- else
+ !*** END: Enhanced wall treatment - Reichardt blending ***
- ! Shear stress for viscous region
- tau(iWall) = viscos*Ut2/dnw(iWall)
- Utau = sqrt( Tau(iWall) / den(ijp) )
- ypl(iWall) = den(ijp)*Utau*dnw(iWall)/viscos
+ ! ! *** Enhanced wall treatment - Kader blending ***
- endif
+ ! ! Below is a variant where we use Kader blending only for 3 < y+ < 10,
+ ! ! and for other ( y+ < 3 and y+ > 11.225 or ctrans ) we use viscous
+ ! ! or logarithmic profiles respectively.
+ ! ! We can use Kader function for the whole region, because it approximates it.
+ ! ! Some authors say though that Kader blending function isn't that great because
+ ! ! it underestimates velocity in buffer region, and has some unusual kink there.
+
+ ! if(ypl(iWall) > ctrans) then
+
+ ! viscw = ypl(iWall)*viscos*cappa/log(Elog*ypl(iWall))
+
+ ! ! Shear stress for log region
+ ! tau(iwall) = cappa*den(ijp)*Vtp*cmu25*sqrt(te(ijp))/log(Elog*ypl(iWall))
+
+ ! elseif( ypl(iWall) > 3.0 ) then
+
+ ! !
+ ! ! Enhanced wall treatment - Kader blending.
+ ! !
+ ! Upvisc = ypl(iWall)
+ ! Uplog = log(Elog*ypl(iWall))/cappa
+ ! Gmblend = -0.01_dp*ypl(iWall)**4/(1.+5*ypl(iWall))
+ ! Uplblend = exp(Gmblend)*Upvisc + exp(1./Gmblend)*Uplog
+ ! viscw = ypl(iWall)*viscos/Uplblend
+
+ ! ! Blended version of shear stress
+ ! tau(iwall) = den(ijp) * (Vtp/Uplblend)**2
+
+ ! else
+
+ ! ! Shear stress for viscous region
+ ! tau(iWall) = viscos*Ut2/dnw(iWall)
+ ! Utau = sqrt( Tau(iWall) / den(ijp) )
+ ! ypl(iWall) = den(ijp)*Utau*dnw(iWall)/viscos
+
+ ! endif
visw(iWall) = max(viscos,viscw)
vis(ijb) = visw(iWall)
diff --git a/src/finiteVolume/fvEqnDiscretization/TurbulenceModels/k_epsilon_zeta_f.f90 b/src/finiteVolume/fvEqnDiscretization/TurbulenceModels/k_epsilon_zeta_f.f90
index f28218b..87790ed 100644
--- a/src/finiteVolume/fvEqnDiscretization/TurbulenceModels/k_epsilon_zeta_f.f90
+++ b/src/finiteVolume/fvEqnDiscretization/TurbulenceModels/k_epsilon_zeta_f.f90
@@ -282,7 +282,7 @@ subroutine calcsc(Fi,dFidxi,ifi)
!=====================================
! UNSTEADY TERM
!=====================================
- if( bdf ) then
+ if( bdf .or. cn ) then
apotime = den(inp)*vol(inp)/timestep
su(inp) = su(inp) + apotime*teo(inp)
sp(inp) = sp(inp) + apotime
@@ -351,7 +351,7 @@ subroutine calcsc(Fi,dFidxi,ifi)
!=====================================
! UNSTEADY TERM
!=====================================
- if( bdf ) then
+ if( bdf .or. cn ) then
apotime = den(inp)*vol(inp)/timestep
su(inp) = su(inp) + apotime*edo(inp)
sp(inp) = sp(inp) + apotime
diff --git a/src/finiteVolume/fvEqnDiscretization/TurbulenceModels/k_eqn_eddy.f90 b/src/finiteVolume/fvEqnDiscretization/TurbulenceModels/k_eqn_eddy.f90
index d47c3c6..df03589 100644
--- a/src/finiteVolume/fvEqnDiscretization/TurbulenceModels/k_eqn_eddy.f90
+++ b/src/finiteVolume/fvEqnDiscretization/TurbulenceModels/k_eqn_eddy.f90
@@ -207,7 +207,7 @@ subroutine calcsc(Fi,dFidxi,ifi)
! UNSTEADY TERM
- if( bdf ) then
+ if( bdf .or. cn ) then
apotime = den(inp)*vol(inp)/timestep
su(inp) = su(inp) + apotime*teo(inp)
sp(inp) = sp(inp) + apotime
@@ -328,6 +328,7 @@ subroutine calcsc(Fi,dFidxi,ifi)
su(ijp )= su(ijp)-gen(ijp)*vol(ijp) ! take out standard production from wall ajdecent cell.
viss=viscos
if(ypl(i).gt.ctrans) viss=visw(iwall)
+ ! viss = max(viscos,visw(iWall))
! Face area
are = sqrt(arx(iface)**2+ary(iface)**2+arz(iface)**2)
@@ -346,7 +347,7 @@ subroutine calcsc(Fi,dFidxi,ifi)
ztp = W(ijp)-Vnp*nzf
! Its magnitude
- Vtp = xtp*xtp+ytp*ytp+ztp*ztp
+ Vtp = sqrt(xtp*xtp+ytp*ytp+ztp*ztp)
! Tangent direction - unit vector
xtp = xtp/vtp
@@ -561,7 +562,7 @@ subroutine modify_mu_eff()
ztp = W(ijp)-Vnp*nzf
! Its magnitude
- Vtp = xtp*xtp+ytp*ytp+ztp*ztp
+ Vtp = sqrt(xtp*xtp+ytp*ytp+ztp*ztp)
! Tangent direction
xtp = xtp/vtp
@@ -576,7 +577,7 @@ subroutine modify_mu_eff()
ypl(iWall) = den(ijb)*Utau*dnw(iWall)/viscos
! ! Ima i ova varijanta u cisto turb. granicni sloj varijanti sa prvom celijom u log sloju
- ! ypl(i) = den(ijb)*cmu25*sqrt(te(ijp))*dnw(i)/viscos
+ !ypl(i) = den(ijb)*cmu25*sqrt(te(ijp))*dnw(i)/viscos
! ! ...ovo je tehnicki receno ystar iliti y* a ne y+
viscw = zero
diff --git a/src/finiteVolume/fvEqnDiscretization/TurbulenceModels/k_omega_EARSM_WJ.f90 b/src/finiteVolume/fvEqnDiscretization/TurbulenceModels/k_omega_EARSM_WJ.f90
new file mode 100644
index 0000000..2850440
--- /dev/null
+++ b/src/finiteVolume/fvEqnDiscretization/TurbulenceModels/k_omega_EARSM_WJ.f90
@@ -0,0 +1,1019 @@
+module k_omega_sst
+!
+! Implementation of k-omega Shear Stress Transport (SST) two equation turbulence model.
+!
+! REFERENCES:
+! * ANSYS FLUENT Theory Guide
+! * Menter, F. R., "Two-Equation Eddy-Viscosity Turbulence Models for Engineering Applications",
+! AIAA Journal, Vol. 32, No. 8, August 1994, pp. 1598-1605.
+! * Menter, F. R., Kuntz, M., and Langtry, R., "Ten Years of Industrial Experience with the SST Turbulence Model",
+! Turbulence, Heat and Mass Transfer 4, ed: K. Hanjalic, Y. Nagano, and M. Tummers, Begell House, Inc., 2003, pp. 625 - 632.
+!
+ use types
+ use parameters
+ use geometry
+ use variables
+ use scalar_fluxes, only: facefluxsc
+
+ implicit none
+
+ logical :: LowRe = .false. ! Has to be set in calling routine or in main program.
+
+ ! Turbulence model constants
+
+ IF (EARSM_WJ) THEN
+ SIGMK1=1.1d0
+ SIGMK2=1.1d0
+ SIGMOM1=0.53d0
+ SIGMOM2=1.0
+ BETAI1=0.0747
+ BETAI2=0.0828
+ A1=0.31D0
+ ALPHA1=0.518d0
+ ALPHA2=0.44
+ BETTAST=0.09
+ END IF
+
+ IF (EARSM_M) THEN
+ SIGMK1=0.5d0
+ SIGMK2=1.1d0
+ SIGMOM1=0.5d0
+ SIGMOM2=0.856d0
+ BETAI1=0.075
+ BETAI2=0.0828
+ A1=0.31D0
+ BETTAST=0.09
+ ALPHA1=(BETAI1/BETTAST)-CAPPA**2/(SQRT(BETTAST)*SIGMOM1)
+ ALPHA2=(BETAI2/BETTAST)-CAPPA**2/(SQRT(BETTAST)*SIGMOM2)
+ END IF
+
+ real(dp), parameter :: BETTAST=0.09_dp
+ real(dp), parameter :: SIGMK1=1.176_dp
+ real(dp), parameter :: SIGMK2=1.0_dp
+ real(dp), parameter :: SIGMOM1=2.0_dp
+ real(dp), parameter :: SIGMOM2=1.168_dp
+ real(dp), parameter :: BETAI1=0.075_dp
+ real(dp), parameter :: BETAI2=0.0828_dp
+ real(dp), parameter :: A1=0.31_dp
+
+! SST-1994 coefficients
+! ALPHA1=(BETAI1/BETTAST)-CAPPA**2/(SQRT(BETTAST)*SIGMAOM1)
+! ALPHA2=(BETAI2/BETTAST)-CAPPA**2/(SQRT(BETTAST)*SIGMAOM2)
+
+! SST-2003 coefficients. The first is higher than the original constant
+! definition by approximately 0.43%, and the second is lower by less than 0.08%.
+ real(dp), parameter :: ALPHA1=5./9.0_dp
+ real(dp), parameter :: ALPHA2=0.44_dp
+
+ real(dp), parameter :: C3 = 1.44_dp
+
+ ! Derived constants
+ real(dp), parameter :: CMU25 = sqrt(sqrt(BETTAST))
+ real(dp), parameter :: CMU75 = cmu25**3
+
+ real(dp), dimension(:), allocatable :: fsst
+
+ private
+
+ public :: LowRe
+ public :: correct_turbulence_k_omega_sst
+ public :: correct_turbulence_inlet_k_omega_sst
+
+contains
+
+
+!***********************************************************************
+!
+subroutine correct_turbulence_k_omega_sst()
+!
+!***********************************************************************
+!
+! Main module routine to solve turbulence model equations and update effective viscosity.
+!
+!***********************************************************************
+ use types
+ use parameters
+ use variables
+ use gradients
+ implicit none
+
+ if(.not.allocated(fsst)) then
+ allocate(fsst(numTotal))
+ write(*,'(a)') " **Allocated SST blending function."
+ endif
+
+ call calcsc(TE,dTEdxi,ite) ! Assemble and solve turbulence kinetic energy eq.
+ call calcsc(ED,dEDdxi,ied) ! Assemble and solve specific dissipation rate (omega [1/s]) of tke eq.
+ call modify_mu_eff()
+
+end subroutine
+
+
+!***********************************************************************
+!
+subroutine correct_turbulence_inlet_k_omega_sst()
+!
+!***********************************************************************
+!
+! Update effective viscosity at inlet
+!
+ implicit none
+
+ call modify_mu_eff_inlet()
+
+end subroutine
+
+
+!***********************************************************************
+!
+subroutine calcsc(Fi,dFidxi,ifi)
+!
+!***********************************************************************
+!
+! Discretization of scalar equation
+!
+!***********************************************************************
+ use types
+ use parameters
+ use geometry
+ use variables
+ use sparse_matrix
+ use gradients
+ use title_mod
+
+ implicit none
+
+ integer, intent(in) :: ifi
+ real(dp), dimension(numTotal) :: fi
+ real(dp), dimension(3,numCells) :: dfidxi
+
+!
+! Local variables
+!
+ integer :: i, k, inp, ijp, ijn, ijb, ib, iface, iwall
+ real(dp) :: gam, prtr, prtr_ijp, prtr_ijn, apotime, const, urfrs, urfms
+ real(dp) :: utp, vtp, wtp, utn, vtn, wtn
+ real(dp) :: genp, genn
+ real(dp) :: uttbuoy, vttbuoy, wttbuoy
+ real(dp) :: cap, can, suadd
+ real(dp) :: magStrainSq
+ real(dp) :: off_diagonal_terms
+ real(dp) :: are,nxf,nyf,nzf,vnp,xtp,ytp,ztp,ut2
+ ! real(dp) :: dudx,dudy,dudz,dvdx,dvdy,dvdz,dwdx,dwdy,dwdz
+ real(dp) :: viss
+ real(dp) :: fimax,fimin
+ real(dp) :: wldist,domegapl,ksi,tmp
+ real(dp) :: dtedx,dtedy,dtedz,deddx,deddy,deddz
+ real(dp) :: alphast,alphasst,bettasst,domega,vist
+ real(dp) :: wlog,wvis
+ real(dp) :: W_S,Ri,F4
+
+
+! Variable specific coefficients:
+ gam=gds(ifi)
+
+
+! Calculate gradient:
+ call grad(fi,dfidxi)
+
+! Initialize coef and source arrays
+ a = 0.0_dp
+ su = 0.0_dp
+ sp = 0.0_dp
+
+!
+! CALCULATE SOURCE TERMS INTEGRATED OVER VOLUME
+!
+
+ ! TKE volume source terms
+ if(ifi.eq.ite) then
+
+
+ !=========================================================
+ ! STANDARD PRODUCTION
+ ! Note:
+ ! In find_strain_rate we calculate strain rate as:
+ ! S = sqrt (2*Sij*Sij).
+ !=========================================================
+
+ do inp=1,numCells
+
+ ! dudx = dudxi(1,inp)
+ ! dudy = dudxi(2,inp)
+ ! dudz = dudxi(3,inp)
+
+ ! dvdx = dvdxi(1,inp)
+ ! dvdy = dvdxi(2,inp)
+ ! dvdz = dvdxi(3,inp)
+
+ ! dwdx = dwdxi(1,inp)
+ ! dwdy = dwdxi(2,inp)
+ ! dwdz = dwdxi(3,inp)
+
+ ! ! Minus here in fron because UU,UV,... calculated in calcstress hold -tau_ij
+ ! ! So the exact production is calculated as tau_ij*dui/dxj
+ ! gen(inp) = -den(inp)*( uu(inp)*dudx+uv(inp)*(dudy+dvdx)+ &
+ ! uw(inp)*(dudz+dwdx)+vv(inp)*dvdy+ &
+ ! vw(inp)*(dvdz+dwdy)+ww(inp)*dwdz )
+
+
+ magStrainSq=magStrain(inp)*magStrain(inp)
+ gen(inp)=abs(vis(inp)-viscos)*magStrainSq
+
+ ! PRODUCTION LIMITER FOR SST AND SAS MODELS:
+ ! 10*bettainf=10*0.09=0.9 -> see below TODO BETTAST for Low-Re
+
+ ! High-Re version...............................................................
+ gen(inp)=min(gen(inp),0.9_dp*den(inp)*te(inp)*ed(inp))
+
+ if (LowRe) then
+ ! Low-Re version of Wilcox and SST k-omega......................................
+ tmp=10*bettast*(4./15.0_dp+(den(inp)*te(inp)/(8.0_dp*viscos*ed(inp)))**4) & !
+ /(1.0_dp +(den(inp)*te(inp)/(8.0_dp*viscos*ed(inp)))**4) !
+ gen(inp)=min(gen(inp),tmp*den(inp)*te(inp)*ed(inp)) !
+ !...............................................................................!
+ end if
+
+ enddo
+
+ !
+ !=====================================
+ ! VOLUME SOURCE TERMS
+ !=====================================
+ do inp=1,numCells
+
+ genp=max(gen(inp),zero)
+ genn=min(gen(inp),zero)
+
+ ! Add production term to the rhs:
+ su(inp)=genp*vol(inp)
+
+ !======================================================================
+ ! Note there is possibility to add a source term to eliminate
+ ! non-physical decay of turbulence variables in the freestream
+ ! for external aerodynamic problems
+ ! Reference:
+ ! Spalart, P. R. and Rumsey, C. L., "Effective Inflow Conditions for
+ ! Turbulence Models in Aerodynamic Calculations," AIAA Journal,
+ ! Vol. 45, No. 10, 2007, pp. 2544 - 2553.
+ !======================================================================
+ ! ADD SUSTAIN TERMS (ONLY FOR SST!):
+ ! su(inp)=su(inp)+bettast*tein*edin*den(inp)*vol(inp)
+
+ ! Add destruction term to the lhs:
+
+ !.....High-Re version.....................................................
+ sp(inp)=bettast*ed(inp)*den(inp)*vol(inp)
+
+ if(LowRe) then
+ !.....Low-Re version of Wilcox and SST k-omega.............................
+ tmp = BETTAST*(4./15.0_dp+(den(inp)*te(inp)/(8*viscos*ed(inp)))**4) & !
+ /(1.0_dp +(den(inp)*te(inp)/(8*viscos*ed(inp)))**4) !
+ sp(inp)=tmp*ed(inp)*den(inp)*vol(inp) !
+ !.........................................................................!
+ endif
+
+ ! If gen negative move to lhs
+ sp(inp)=sp(inp)-genn*vol(inp)/(te(inp)+small)
+
+
+ !
+ !=====================================
+ ! VOLUME SOURCE TERMS: buoyancy
+ !=====================================
+ if(lcal(ien).and.lbuoy) then
+
+ ! When bouy activated we need the freshest utt,vtt,wtt - turbulent heat fluxes
+ call calcheatflux
+
+ if(boussinesq) then
+ uttbuoy=-gravx*den(inp)*utt(inp)*vol(inp)*beta
+ vttbuoy=-gravy*den(inp)*vtt(inp)*vol(inp)*beta
+ wttbuoy=-gravz*den(inp)*wtt(inp)*vol(inp)*beta
+ else
+ uttbuoy=-gravx*den(inp)*utt(inp)*vol(inp)/(t(inp)+273.15_dp)
+ vttbuoy=-gravy*den(inp)*vtt(inp)*vol(inp)/(t(inp)+273.15_dp)
+ wttbuoy=-gravz*den(inp)*wtt(inp)*vol(inp)/(t(inp)+273.15_dp)
+ end if
+
+ utp=max(uttbuoy,zero)
+ vtp=max(vttbuoy,zero)
+ wtp=max(wttbuoy,zero)
+ utn=min(uttbuoy,zero)
+ vtn=min(vttbuoy,zero)
+ wtn=min(wttbuoy,zero)
+
+ su(inp)=su(inp)+utp+vtp+wtp
+ sp(inp)=sp(inp)-(utn+vtn+wtn)/(te(inp)+small)
+
+ end if
+
+ !
+ !=====================================
+ ! UNSTEADY TERM
+ !=====================================
+ if( bdf .or. cn ) then
+ apotime = den(inp)*vol(inp)/timestep
+ su(inp) = su(inp) + apotime*teo(inp)
+ sp(inp) = sp(inp) + apotime
+ elseif( bdf2 ) then
+ apotime=den(inp)*vol(inp)/timestep
+ su(inp) = su(inp) + apotime*( 2*teo(inp) - 0.5_dp*teoo(inp) )
+ sp(inp) = sp(inp) + 1.5_dp*apotime
+ endif
+
+ ! End of TKE volume source terms
+ enddo
+
+!****************************************
+ elseif(ifi.eq.ied) then
+!****************************************
+
+ ! Omega volume source terms
+
+ do inp=1,numCells
+
+ ! Wall distance
+ wldist = walldistance(inp)
+
+ ! Gradient of turbulence kinetic energy
+ dtedx=dTEdxi(1,inp)
+ dtedy=dTEdxi(2,inp)
+ dtedz=dTEdxi(3,inp)
+
+ ! Gradient of turbulence kinetic energy specific dissipation rate
+ deddx=dEDdxi(1,inp)
+ deddy=dEDdxi(2,inp)
+ deddz=dEDdxi(3,inp)
+
+ ! Find $d_{\omega}^{+}$ d_omega+
+ domegapl=max(2*den(inp)/(SIGMOM2*ed(inp)) * (dtedx*deddx+dtedy*deddy+dtedz*deddz),1e-20)
+
+ ! Find ksi
+ ksi=min( max( &
+ sqrt(te(inp))/(BETTAST*wldist*ed(inp)+small), &
+ 500.0_dp*viscos/den(inp)/(wldist**2*ed(inp)+small) &
+ ), &
+ 4.0_dp*den(inp)*te(inp)/(SIGMOM2*domegapl*wldist**2) &
+ )
+
+ ! Find the SST model blending function f_sst:
+ fsst(inp) = tanh(ksi**4)
+
+ enddo
+
+ !
+ !=====================================
+ ! VOLUME SOURCE TERMS
+ !=====================================
+ do inp=1,numCells
+
+ genp=max(gen(inp),zero)
+ genn=min(gen(inp),zero)
+
+
+ ! Production of dissipation
+ vist = (vis(inp)-viscos)/densit
+
+ ! Production coefficient alpha_sst
+ !.....High-Re version...............................................
+ alphasst=fsst(inp)*alpha1+(1.0_dp-fsst(inp))*alpha2 !<
+
+ If(LowRe) then
+ ! Low-Re version of SST k-omega......................................
+ alphast=(0.024_dp+(densit*te(inp))/(6.0_dp*viscos*ed(inp))) & !
+ /(1.0_dp+(densit*te(inp))/(6.0_dp*viscos*ed(inp))) !
+ tmp=alpha1/alphast* & !
+ (1./9.0_dp+ (densit*te(inp))/(2.95_dp*viscos*ed(inp))) & !
+ /(1.0_dp + (densit*te(inp))/(2.95_dp*viscos*ed(inp))) !
+ alphasst=fsst(inp)*tmp + (1.0_dp-fsst(inp))*alpha2 !<
+ !.................................................................!
+ endif
+
+ su(inp)=alphasst*genp*vol(inp)/(vist+small)
+
+ ! FIND D_omega CROSS DIFFUSION MODIFICATION:
+
+ ! Gradient of turbulence kinetic energy
+ dtedx=dTEdxi(1,inp)
+ dtedy=dTEdxi(2,inp)
+ dtedz=dTEdxi(3,inp)
+
+ ! Gradient of turbulence kinetic energy specific dissipation rate
+ deddx=dEDdxi(1,inp)
+ deddy=dEDdxi(2,inp)
+ deddz=dEDdxi(3,inp)
+
+ domega = 2*(1.0_dp-fsst(inp))*den(inp)/(SIGMOM2*ed(inp)+small)*(dtedx*deddx+dtedy*deddy+dtedz*deddz)
+ domega = max(domega,0.0_dp)
+
+ su(inp)=su(inp)+domega*vol(inp)
+
+
+
+ ! Destruction of dissipation.
+
+ ! Destruction coefficient beta_sst
+ bettasst=fsst(inp)*betai1+(1.0_dp-fsst(inp))*betai2
+
+ ! ADD SUSTAIN TERMS
+ ! su(inp)=su(inp)+bettasst*edin*edin*den(inp)*vol(inp)
+
+
+ ! Add destruction term (-beta*rho*w**2) to the lhs :
+ ! sp(inp)=bettasst*den(inp)*ed(inp)*vol(inp)
+ !..or using the destruction term that incorporates Simplified Curvature Correction:
+ ! Multiply destruction by F4 Simplified Curvature Correction term b Hellsten
+ ! to obtain SST-2003RC-Hellsten model
+ W_S = Vorticity(inp)/magStrain(inp)
+ Ri = W_S*(W_S-one)
+ F4 = one/(one + 1.4_dp*Ri)
+ sp(inp)=F4*bettasst*den(inp)*ed(inp)*vol(inp)
+
+ ! Negative value of production moved to lhs.
+ sp(inp)=sp(inp)-alphasst*genn*vol(inp)/(vist*ed(inp)+small)
+
+ !
+ !=====================================
+ ! VOLUME SOURCE TERMS: Buoyancy
+ !=====================================
+ if(lcal(ien).and.lbuoy) then
+ const=c3*den(inp)*ed(inp)*vol(inp)/(te(inp)+small)
+
+ if(boussinesq) then
+ uttbuoy=-gravx*utt(inp)*const*beta
+ vttbuoy=-gravy*vtt(inp)*const*beta
+ wttbuoy=-gravz*wtt(inp)*const*beta
+ else
+ uttbuoy=-gravx*utt(inp)*const/(t(inp)+273.15)
+ vttbuoy=-gravy*vtt(inp)*const/(t(inp)+273.15)
+ wttbuoy=-gravz*wtt(inp)*const/(t(inp)+273.15)
+ end if
+
+ utp=max(uttbuoy,zero)
+ vtp=max(vttbuoy,zero)
+ wtp=max(wttbuoy,zero)
+ utn=min(uttbuoy,zero)
+ vtn=min(vttbuoy,zero)
+ wtn=min(wttbuoy,zero)
+
+ su(inp)=su(inp)+utp+vtp+wtp
+ sp(inp)=sp(inp)-(utn+vtn+wtn)/(ed(inp)+small)
+ end if
+
+ !
+ !=====================================
+ ! UNSTEADY TERM
+ !=====================================
+ if( bdf .or. cn ) then
+ apotime = den(inp)*vol(inp)/timestep
+ su(inp) = su(inp) + apotime*edo(inp)
+ sp(inp) = sp(inp) + apotime
+ elseif( bdf2 ) then
+ apotime=den(inp)*vol(inp)/timestep
+ su(inp) = su(inp) + apotime*( 2*edo(inp) - 0.5_dp*edoo(inp) )
+ sp(inp) = sp(inp) + 1.5_dp*apotime
+ endif
+
+ ! End of Epsilon volume source terms
+ enddo
+!--------------------------------------
+ end if
+
+!
+! CALCULATE TERMS INTEGRATED OVER FACES
+!
+
+ ! Inner faces:
+ do i=1,numInnerFaces
+ ijp = owner(i)
+ ijn = neighbour(i)
+
+ ! In SST model the Effective diffusivity is a field variable:
+ if(ifi.eq.ite) then
+ prtr_ijp = fsst(ijp)*(1./sigmk1) + (1.0_dp-fsst(ijp))*(1./sigmk2)
+ prtr_ijn = fsst(ijn)*(1./sigmk1) + (1.0_dp-fsst(ijn))*(1./sigmk2)
+ else
+ prtr_ijp = fsst(ijp)*(1./sigmom1) + (1.0_dp-fsst(ijp))*(1./sigmom2)
+ prtr_ijn = fsst(ijn)*(1./sigmom1) + (1.0_dp-fsst(ijn))*(1./sigmom2)
+ endif
+
+ call facefluxsc( ijp, ijn, &
+ xf(i), yf(i), zf(i), arx(i), ary(i), arz(i), &
+ flmass(i), facint(i), gam, &
+ fi, dFidxi, prtr_ijp, cap, can, suadd )
+ ! fi, dFidxi, prtr_ijp, prtr_ijn, cap, can, suadd )
+
+ ! > Off-diagonal elements:
+
+ ! (icell,jcell) matrix element:
+ k = icell_jcell_csr_index(i)
+ a(k) = can
+
+ ! (jcell,icell) matrix element:
+ k = jcell_icell_csr_index(i)
+ a(k) = cap
+
+ ! > Elements on main diagonal:
+
+ ! ! (icell,icell) main diagonal element
+ k = diag(ijp)
+ a(k) = a(k) - can
+
+ ! ! (jcell,jcell) main diagonal element
+ k = diag(ijn)
+ a(k) = a(k) - cap
+
+ ! > Sources:
+
+ su(ijp) = su(ijp) + suadd
+ su(ijn) = su(ijn) - suadd
+
+ enddo
+
+ !
+ ! Boundary conditions
+ !
+
+ iWall = 0
+
+ do ib=1,numBoundaries
+
+ if ( bctype(ib) == 'inlet' ) then
+
+ do i=1,nfaces(ib)
+
+ iface = startFace(ib) + i
+ ijp = owner(iface)
+ ijb = iBndValueStart(ib) + i
+
+ ! In SST model the Effective diffusivity is a field variable:
+ if(ifi.eq.ite) then
+ prtr=fsst(ijp)*(1./sigmk1) + (1.0_dp-fsst(ijp))*(1./sigmk2)
+ else
+ prtr=fsst(ijp)*(1./sigmom1) + (1.0_dp-fsst(ijp))*(1./sigmom2)
+ endif
+
+ call facefluxsc( ijp, ijb, &
+ xf(iface), yf(iface), zf(iface), arx(iface), ary(iface), arz(iface), &
+ flmass(iface), &
+ Fi, dFidxi, prtr, cap, can, suadd )
+
+ Sp(ijp) = Sp(ijp)-can
+
+ Su(ijp) = Su(ijp) - can*fi(ijb) + suadd
+
+ end do
+
+
+ elseif ( bctype(ib) == 'outlet' ) then
+
+ do i=1,nfaces(ib)
+
+ iface = startFace(ib) + i
+ ijp = owner(iface)
+ ijb = iBndValueStart(ib) + i
+
+ ! In SST model the Effective diffusivity is a field variable:
+ if(ifi.eq.ite) then
+ prtr=fsst(ijp)*(1./sigmk1) + (1.0_dp-fsst(ijp))*(1./sigmk2)
+ else
+ prtr=fsst(ijp)*(1./sigmom1) + (1.0_dp-fsst(ijp))*(1./sigmom2)
+ endif
+
+ call facefluxsc( ijp, ijb, &
+ xf(iface), yf(iface), zf(iface), arx(iface), ary(iface), arz(iface), &
+ flmass(iface), &
+ FI, dFidxi, prtr, cap, can, suadd )
+
+ Sp(ijp) = Sp(ijp)-can
+
+ Su(ijp) = Su(ijp) - can*fi(ijb) + suadd
+
+ end do
+
+ elseif ( bctype(ib) == 'wall') then
+
+ do i=1,nfaces(ib)
+
+ iface = startFace(ib) + i
+ ijp = owner(iface)
+ ijb = iBndValueStart(ib) + i
+ iWall = iWall + 1
+
+ if (ifi .eq. ite) then
+
+ !
+ ! > Wall boundary conditions for turbulence kinetic energy eq.
+ !
+
+ su(ijp )= su(ijp)-gen(ijp)*vol(ijp) ! take out standard production from wall ajdecent cell.
+
+ viss=viscos
+ if(ypl(i).gt.ctrans) viss=visw(iwall)
+ ! viss = max(viscos,visw(iWall))
+
+ ! Face area
+ are = sqrt(arx(iface)**2+ary(iface)**2+arz(iface)**2)
+
+ ! Face normals
+ nxf = arx(iface)/are
+ nyf = ary(iface)/are
+ nzf = arz(iface)/are
+
+ ! Magnitude of a cell center velocity projected on boundary face normal
+ Vnp = U(ijp)*nxf+V(ijp)*nyf+W(ijp)*nzf
+
+ ! Tangential velocity components
+ xtp = U(ijp)-Vnp*nxf
+ ytp = V(ijp)-Vnp*nyf
+ ztp = W(ijp)-Vnp*nzf
+
+ ! Its magnitude
+ Vtp = sqrt(xtp*xtp+ytp*ytp+ztp*ztp)
+
+ ! Tangent direction - unit vector
+ xtp = xtp/vtp
+ ytp = ytp/vtp
+ ztp = ztp/vtp
+
+ ! projektovanje razlike brzina na pravac tangencijalne brzine u cell centru ijp
+ Ut2 = abs( (U(ijb)-U(ijp))*xtp + (V(ijb)-V(ijp))*ytp + (W(ijb)-W(ijp))*ztp )
+
+ Tau(iWall) = viss*Ut2/dnw(iwall)
+
+ gen(ijp)=abs(tau(iWall))*cmu25*sqrt(te(ijp))/(dnw(iwall)*cappa)
+
+ su(ijp)=su(ijp)+gen(ijp)*vol(ijp)
+
+ else
+
+ ! Wall boundaries approximated with wall functions
+ ! for correct values of dissipation all coefficients have
+ ! to be zero, su equal the dissipation, and ap = 1
+
+ ! Automatic wall treatment - quadratic blend of log-layer and vis sublayer value:
+ wlog=sqrt(te(ijp))/(cmu25*cappa*dnw(iWall))
+
+ wvis=6.0_dp*(viscos/den(ijp))/(betai1*dnw(iWall)**2)
+
+ ed(ijp) = sqrt(wvis**2+wlog**2)
+ su(ijp)=ed(ijp)
+
+ a( ioffset(ijp):ioffset(ijp+1)-1 ) = 0.0_dp
+ sp(ijp) = 1.0_dp
+
+ endif
+
+ enddo
+
+ endif
+
+ enddo
+
+ ! Modify coefficients for Crank-Nicolson
+ if (cn) then
+
+ a = 0.5_dp*a ! Doesn't affect the main diagonal because it's still zero.
+
+ if(ifi.eq.ite) then
+
+ do i = 1,numInnerFaces
+ ijp = owner(i)
+ ijn = neighbour(i)
+
+ k = icell_jcell_csr_index(i)
+ su(ijp) = su(ijp) - a(k)*teo(ijn)
+
+ k = jcell_icell_csr_index(i)
+ su(ijn) = su(ijn) - a(k)*teo(ijp)
+ enddo
+ do ijp=1,numCells
+ apotime=den(ijp)*vol(ijp)/timestep
+ off_diagonal_terms = sum( a( ioffset(ijp) : ioffset(ijp+1)-1 ) ) - a(diag(ijp))
+ su(ijp) = su(ijp) + (apotime + off_diagonal_terms)*teo(ijp)
+ sp(ijp) = sp(ijp)+apotime
+ enddo
+
+ else ! ifi.eq.ied
+
+ do i = 1,numInnerFaces
+ ijp = owner(i)
+ ijn = neighbour(i)
+
+ k = icell_jcell_csr_index(i)
+ su(ijp) = su(ijp) - a(k)*edo(ijn)
+
+ k = jcell_icell_csr_index(i)
+ su(ijn) = su(ijn) - a(k)*edo(ijp)
+ enddo
+ do ijp=1,numCells
+ apotime=den(ijp)*vol(ijp)/timestep
+ off_diagonal_terms = sum( a( ioffset(ijp) : ioffset(ijp+1)-1 ) ) - a(diag(ijp))
+ su(ijp) = su(ijp) + (apotime + off_diagonal_terms)*edo(ijp)
+ sp(ijp) = sp(ijp)+apotime
+ enddo
+
+ endif
+
+ endif
+
+ ! Underrelaxation factors
+ urfrs=urfr(ifi)
+ urfms=urfm(ifi)
+
+ ! Main diagonal term assembly:
+ do inp = 1,numCells
+
+ ! Main diagonal term assembly:
+ a(diag(inp)) = sp(inp)
+ do k = ioffset(inp),ioffset(inp+1)-1
+ if (k.eq.diag(inp)) cycle
+ a(diag(inp)) = a(diag(inp)) - a(k)
+ enddo
+
+ ! Underelaxation:
+ a(diag(inp)) = a(diag(inp))*urfrs
+ su(inp) = su(inp) + urfms*a(diag(inp))*fi(inp)
+
+ enddo
+
+ ! Solve linear system:
+ call bicgstab(fi,ifi)
+
+ !
+ ! Update symmetry and outlet boundaries
+ !
+ do ib=1,numBoundaries
+
+ if ( bctype(ib) == 'outlet' .or. bctype(ib) == 'symmetry' ) then
+
+ do i=1,nfaces(ib)
+
+ iface = startFace(ib) + i
+ ijp = owner(iface)
+ ijb = iBndValueStart(ib) + i
+
+ fi(ijb)=fi(ijp)
+
+ enddo
+
+ endif
+
+ enddo
+
+! Report range of scalar values and clip if negative
+ fimin = minval(fi)
+ fimax = maxval(fi)
+
+ write(6,'(2x,es11.4,3a,es11.4)') fimin,' <= ',chvar(ifi),' <= ',fimax
+
+! These field values cannot be negative
+ if(fimin.lt.0.0_dp) fi = max(fi,small)
+
+end subroutine calcsc
+
+
+!***********************************************************************
+!
+subroutine modify_mu_eff()
+!
+!***********************************************************************
+!
+! Update turbulent and effective viscosity.
+!
+!***********************************************************************
+ use types
+ use parameters
+ use geometry
+ use variables
+ implicit none
+
+ integer :: i,inp
+ integer :: ib,iface,ijp,ijb,iwall
+ real(dp) :: visold
+ real(dp) :: nxf,nyf,nzf,are
+ real(dp) :: Vnp,Vtp,xtp,ytp,ztp
+ real(dp) :: Utau,viscw
+ real(dp) :: wldist,etha,f2_sst,alphast
+ real(dp) :: Utauvis,Utaulog,Upl
+ ! real(dp) :: fimax,fimin
+
+
+ ! Loop trough cells
+ do inp=1,numCells
+
+ ! Store old value
+ visold=vis(inp)
+
+ ! Update effective viscosity:
+ vis(inp)=viscos+den(inp)*(cmueff(inp)/cmu)*te(inp)/(ed(inp)+small)
+
+ !====================================================
+ !.....FOR EARSM WJ model by Menter et.al. (2009)
+ !====================================================
+ IF(EARSM_M) vis(inp)=viscos+den(inp)*te(inp)/(ed(inp)+small)
+
+ ! Underelaxation
+ vis(inp)=urf(ivis)*vis(inp)+(1.0_dp-urf(ivis))*visold
+
+ enddo
+
+ !
+ ! Boundary faces
+ !
+
+ iWall = 0
+
+ do ib=1,numBoundaries
+
+ if ( bctype(ib) == 'inlet' ) then
+
+ do i=1,nfaces(ib)
+
+ iface = startFace(ib) + i
+ ijp = owner(iface)
+ ijb = iBndValueStart(ib) + i
+
+ Vis(ijb) = Vis(ijp)
+
+ end do
+
+ elseif ( bctype(ib) == 'outlet' ) then
+
+ do i=1,nfaces(ib)
+
+ iface = startFace(ib) + i
+ ijp = owner(iface)
+ ijb = iBndValueStart(ib) + i
+
+ Vis(ijb) = Vis(ijp)
+
+ enddo
+
+ elseif ( bctype(ib) == 'symmetry') then
+
+ do i=1,nfaces(ib)
+
+ iface = startFace(ib) + i
+ ijp = owner(iface)
+ ijb = iBndValueStart(ib) + i
+
+ Vis(ijb) = Vis(ijp)
+
+ end do
+
+ elseif ( bctype(ib) == 'wall') then
+
+ do i=1,nfaces(ib)
+
+ iface = startFace(ib) + i
+ ijp = owner(iface)
+ ijb = iBndValueStart(ib) + i
+ iWall = iWall + 1
+
+ !
+ ! Wall boundaries - update Visw and Ypl
+ !
+
+ ! Face area
+ are = sqrt(arx(iface)**2+ary(iface)**2+arz(iface)**2)
+
+ ! Face normals
+ nxf = arx(iface)/are
+ nyf = ary(iface)/are
+ nzf = arz(iface)/are
+
+ ! Magnitude of a cell center velocity projected on boundary face normal
+ Vnp = U(ijp)*nxf+V(ijp)*nyf+W(ijp)*nzf
+
+ ! Tangential velocity components
+ xtp = U(ijp)-Vnp*nxf
+ ytp = V(ijp)-Vnp*nyf
+ ztp = W(ijp)-Vnp*nzf
+
+ ! Magnitude of tangential velocity component
+ Vtp = sqrt(xtp*xtp+ytp*ytp+ztp*ztp)
+
+ ! ! Tangent direction
+ ! xtp = xtp/vtp
+ ! ytp = ytp/vtp
+ ! ztp = ztp/vtp
+
+ ! ! projektovanje razlike brzina na pravac tangencijalne brzine u cell centru ijp
+ ! Ut2 = abs( (U(ijb)-U(ijp))*xtp + (V(ijb)-V(ijp))*ytp + (W(ijb)-W(ijp))*ztp )
+
+ ! Tau(iWall) = viscos*Ut2/dnw(iWall)
+ ! Utau = sqrt( Tau(iWall) / den(ijb) )
+ ! ypl(iWall) = den(ijb)*Utau*dnw(iWall)/viscos
+
+ ! Ima i ova varijanta...ovo je tehnicki receno ystar iliti y* a ne y+
+ ! ypl(iWall) = den(ijp)*cmu25*sqrt(te(ijp))*dnw(iWall)/viscos
+
+
+ ! *** Automatic wall treatment ***
+
+ utau = sqrt( viscos*Vtp/(densit*dnw(iWall)) + cmu25*te(ijp) ) ! It's actually u* in original reference...
+
+ ypl(iWall) = den(ijp)*Utau*dnw(iWall)/viscos
+
+ Utauvis=ypl(iWall)
+ Utaulog=1.0/cappa*log(Elog*ypl(iWall))
+
+ Upl=sqrt(sqrt(Utauvis**4+Utaulog**4))
+
+ viscw = den(ijp)*utau*dnw(iWall)/Upl
+
+ ! Blended version of shear stress - probati ovo(!?)
+ ! tau(iWall) = den(ijp) * (Vtp/Uplblend)**2
+
+ ! Varijanta 2, u originalnoj referenci...
+ tau(iWall) = den(ijp) * Vtp*Utau/Upl
+
+ !*** END: Automatic wall treatment ***
+
+ ! ! *** Enhanced wall treatment - Reichardt blending ***
+
+ ! ! Below is a variant where we use Reichardt blending
+ ! ! for whole span of y+ values.
+ ! ! Some authors say that Reichardt function for u+ approximates
+ ! ! the composite u+(y+) curve, better that Kader blending function.
+
+ ! utau = sqrt( viscos*Vtp/(densit*dnw(iWall)) + cmu25*te(ijp) ) ! It's actually u* in original reference...
+
+ ! ypl(iWall) = den(ijp)*Utau*dnw(iWall)/viscos
+
+ ! Uplblend = one/cappa*log(one+cappa*ypl(iWall)) + &
+ ! 7.8_dp*(1.-exp(-ypl(iWall)/11.0_dp)-(ypl(iWall)/11.0_dp)*exp(-ypl(iWall)/3.0_dp))
+
+ ! viscw = den(ijp)*utau*dnw(iWall)/Uplblend
+
+ ! ! Blended version of shear stress - probati ovo(!?)
+ ! ! tau(iWall) = den(ijp) * (Vtp/Uplblend)**2
+
+ ! ! Varijanta 2, u originalnoj referenci...
+ ! tau(iWall) = den(ijp) * Vtp*Utau/Uplblend
+
+ ! !*** END: Enhanced wall treatment - Reichardt blending ***
+
+ ! viscw = zero
+ ! if(ypl(iWall) > ctrans) then
+ ! viscw = ypl(iWall)*viscos*cappa/log(Elog*ypl(iWall))
+ ! endif
+ ! Wall shear stress
+ ! tau(iwall) = cappa*den(ijp)*Vtp*cmu25*sqrt(te(ijp))/log(Elog*ypl(iWall))
+
+ visw(iWall) = max(viscos,viscw)
+ vis(ijb) = visw(iWall)
+
+ enddo
+
+ endif
+
+ enddo
+
+ ! fimin = minval(vis/viscos)
+ ! fimax = maxval(vis/viscos)
+
+ ! write(6,'(2x,es11.4,3a,es11.4)') fimin,' <= Viscosity ratio <= ',fimax
+
+
+end subroutine modify_mu_eff
+
+
+subroutine modify_mu_eff_inlet()
+!
+! Update turbulent and effective viscosity at inlet.
+!
+ use types
+ use parameters
+ use geometry, only: numBoundaries,nfaces,iBndValueStart
+ use variables
+
+ implicit none
+
+ integer :: i,ib,ijb
+
+ !
+ ! Boundary faces
+ !
+ do ib=1,numBoundaries
+
+ if ( bctype(ib) == 'inlet' ) then
+
+ do i=1,nfaces(ib)
+
+ ijb = iBndValueStart(ib) + i
+
+ Vis(ijb) = viscos+den(ijb)*te(ijb)/(ed(ijb)+small)
+
+ end do
+
+ endif
+
+ enddo
+
+end subroutine modify_mu_eff_inlet
+
+
+end module k_omega_sst
\ No newline at end of file
diff --git a/src/finiteVolume/fvEqnDiscretization/TurbulenceModels/k_omega_sst.f90 b/src/finiteVolume/fvEqnDiscretization/TurbulenceModels/k_omega_sst.f90
index 82b8ab2..ce746c3 100644
--- a/src/finiteVolume/fvEqnDiscretization/TurbulenceModels/k_omega_sst.f90
+++ b/src/finiteVolume/fvEqnDiscretization/TurbulenceModels/k_omega_sst.f90
@@ -129,16 +129,18 @@ subroutine calcsc(Fi,dFidxi,ifi)
real(dp) :: genp, genn
real(dp) :: uttbuoy, vttbuoy, wttbuoy
real(dp) :: cap, can, suadd
- ! real(dp) :: magStrainSq
+ real(dp) :: magStrainSq
real(dp) :: off_diagonal_terms
real(dp) :: are,nxf,nyf,nzf,vnp,xtp,ytp,ztp,ut2
- real(dp) :: dudx,dudy,dudz,dvdx,dvdy,dvdz,dwdx,dwdy,dwdz
+ ! real(dp) :: dudx,dudy,dudz,dvdx,dvdy,dvdz,dwdx,dwdy,dwdz
real(dp) :: viss
real(dp) :: fimax,fimin
real(dp) :: wldist,domegapl,ksi,tmp
real(dp) :: dtedx,dtedy,dtedz,deddx,deddy,deddz
- real(dp) :: alphast,alphasst,bettasst,domega,vist,wlog,wvis
-
+ real(dp) :: alphast,alphasst,bettasst,domega,vist
+ real(dp) :: wlog,wvis
+ ! real(dp) :: W_S,Ri,F4
+
! Variable specific coefficients:
gam=gds(ifi)
@@ -169,31 +171,30 @@ subroutine calcsc(Fi,dFidxi,ifi)
do inp=1,numCells
- dudx = dudxi(1,inp)
- dudy = dudxi(2,inp)
- dudz = dudxi(3,inp)
-
- dvdx = dvdxi(1,inp)
- dvdy = dvdxi(2,inp)
- dvdz = dvdxi(3,inp)
+ ! dudx = dudxi(1,inp)
+ ! dudy = dudxi(2,inp)
+ ! dudz = dudxi(3,inp)
- dwdx = dwdxi(1,inp)
- dwdy = dwdxi(2,inp)
- dwdz = dwdxi(3,inp)
+ ! dvdx = dvdxi(1,inp)
+ ! dvdy = dvdxi(2,inp)
+ ! dvdz = dvdxi(3,inp)
- ! Minus here in fron because UU,UV,... calculated in calcstress hold -tau_ij
- ! So the exact production is calculated as tau_ij*dui/dxj
- gen(inp) = -den(inp)*( uu(inp)*dudx+uv(inp)*(dudy+dvdx)+ &
- uw(inp)*(dudz+dwdx)+vv(inp)*dvdy+ &
- vw(inp)*(dvdz+dwdy)+ww(inp)*dwdz )
+ ! dwdx = dwdxi(1,inp)
+ ! dwdy = dwdxi(2,inp)
+ ! dwdz = dwdxi(3,inp)
+ ! ! Minus here in fron because UU,UV,... calculated in calcstress hold -tau_ij
+ ! ! So the exact production is calculated as tau_ij*dui/dxj
+ ! gen(inp) = -den(inp)*( uu(inp)*dudx+uv(inp)*(dudy+dvdx)+ &
+ ! uw(inp)*(dudz+dwdx)+vv(inp)*dvdy+ &
+ ! vw(inp)*(dvdz+dwdy)+ww(inp)*dwdz )
- ! magStrainSq=magStrain(inp)*magStrain(inp)
- ! gen(inp)=abs(vis(inp)-viscos)*magStrainSq
+ magStrainSq=magStrain(inp)*magStrain(inp)
+ gen(inp)=abs(vis(inp)-viscos)*magStrainSq
! PRODUCTION LIMITER FOR SST AND SAS MODELS:
- ! 10*bettainf=10*0.09=0.9 -> see below TODO BETTAST for Low-Re
+ ! 10*bettainf=10*0.09=0.9
! High-Re version...............................................................
gen(inp)=min(gen(inp),0.9_dp*den(inp)*te(inp)*ed(inp))
@@ -284,14 +285,16 @@ subroutine calcsc(Fi,dFidxi,ifi)
!=====================================
! UNSTEADY TERM
!=====================================
- if( bdf ) then
- apotime = den(inp)*vol(inp)/timestep
- su(inp) = su(inp) + apotime*teo(inp)
- sp(inp) = sp(inp) + apotime
- elseif( bdf2 ) then
- apotime=den(inp)*vol(inp)/timestep
- su(inp) = su(inp) + apotime*( 2*teo(inp) - 0.5_dp*teoo(inp) )
- sp(inp) = sp(inp) + 1.5_dp*apotime
+ if (ltransient) then
+ if( bdf .or. cn ) then
+ apotime = den(inp)*vol(inp)/timestep
+ su(inp) = su(inp) + apotime*teo(inp)
+ sp(inp) = sp(inp) + apotime
+ elseif( bdf2 ) then
+ apotime=den(inp)*vol(inp)/timestep
+ su(inp) = su(inp) + apotime*( 2*teo(inp) - 0.5_dp*teoo(inp) )
+ sp(inp) = sp(inp) + 1.5_dp*apotime
+ endif
endif
! End of TKE volume source terms
@@ -319,12 +322,15 @@ subroutine calcsc(Fi,dFidxi,ifi)
deddz=dEDdxi(3,inp)
! Find $d_{\omega}^{+}$ d_omega+
- domegapl=max(2*den(inp)/(SIGMOM2*ed(inp)) * (dtedx*deddx+dtedy*deddy+dtedz*deddz),1e-10)
+ domegapl=max(2*den(inp)/(SIGMOM2*ed(inp)) * (dtedx*deddx+dtedy*deddy+dtedz*deddz),1e-20)
! Find ksi
- ksi=min(max(sqrt(te(inp))/(BETTAST*wldist*ed(inp)), &
- (500.0_dp*viscos/den(inp))/(wldist**2*ed(inp))), &
- 4.0_dp*den(inp)*te(inp)/(SIGMOM2*domegapl*wldist**2))
+ ksi=min( max( &
+ sqrt(te(inp))/(BETTAST*wldist*ed(inp)+small), &
+ 500.0_dp*viscos/den(inp)/(wldist**2*ed(inp)+small) &
+ ), &
+ 4.0_dp*den(inp)*te(inp)/(SIGMOM2*domegapl*wldist**2) &
+ )
! Find the SST model blending function f_sst:
fsst(inp) = tanh(ksi**4)
@@ -373,7 +379,7 @@ subroutine calcsc(Fi,dFidxi,ifi)
deddy=dEDdxi(2,inp)
deddz=dEDdxi(3,inp)
- domega = 2*(1.0_dp-fsst(inp))*den(inp)/(SIGMOM2*ed(inp))*(dtedx*deddx+dtedy*deddy+dtedz*deddz)
+ domega = 2*(1.0_dp-fsst(inp))*den(inp)/(SIGMOM2*ed(inp)+small)*(dtedx*deddx+dtedy*deddy+dtedz*deddz)
domega = max(domega,0.0_dp)
su(inp)=su(inp)+domega*vol(inp)
@@ -388,12 +394,19 @@ subroutine calcsc(Fi,dFidxi,ifi)
! ADD SUSTAIN TERMS
! su(inp)=su(inp)+bettasst*edin*edin*den(inp)*vol(inp)
- ! Add destruction term to the lhs:
+
+ ! Add destruction term (-beta*rho*w**2) to the lhs :
sp(inp)=bettasst*den(inp)*ed(inp)*vol(inp)
+ !..or using the destruction term that incorporates Simplified Curvature Correction:
+ ! Multiply destruction by F4 Simplified Curvature Correction term b Hellsten
+ ! to obtain SST-2003RC-Hellsten model
+ ! W_S = Vorticity(inp)/magStrain(inp)
+ ! Ri = W_S*(W_S-one)
+ ! F4 = one/(one + 1.4_dp*Ri)
+ ! sp(inp)=F4*bettasst*den(inp)*ed(inp)*vol(inp)
! Negative value of production moved to lhs.
- sp(inp)=sp(inp)-alphasst*genn*vol(inp) &
- /(vist*ed(inp)+small)
+ sp(inp)=sp(inp)-alphasst*genn*vol(inp)/(vist*ed(inp)+small)
!
!=====================================
@@ -427,14 +440,16 @@ subroutine calcsc(Fi,dFidxi,ifi)
!=====================================
! UNSTEADY TERM
!=====================================
- if( bdf ) then
- apotime = den(inp)*vol(inp)/timestep
- su(inp) = su(inp) + apotime*edo(inp)
- sp(inp) = sp(inp) + apotime
- elseif( bdf2 ) then
- apotime=den(inp)*vol(inp)/timestep
- su(inp) = su(inp) + apotime*( 2*edo(inp) - 0.5_dp*edoo(inp) )
- sp(inp) = sp(inp) + 1.5_dp*apotime
+ if (ltransient) then
+ if( bdf .or. cn ) then
+ apotime = den(inp)*vol(inp)/timestep
+ su(inp) = su(inp) + apotime*edo(inp)
+ sp(inp) = sp(inp) + apotime
+ elseif( bdf2 ) then
+ apotime=den(inp)*vol(inp)/timestep
+ su(inp) = su(inp) + apotime*( 2*edo(inp) - 0.5_dp*edoo(inp) )
+ sp(inp) = sp(inp) + 1.5_dp*apotime
+ endif
endif
! End of Epsilon volume source terms
@@ -463,7 +478,8 @@ subroutine calcsc(Fi,dFidxi,ifi)
call facefluxsc( ijp, ijn, &
xf(i), yf(i), zf(i), arx(i), ary(i), arz(i), &
flmass(i), facint(i), gam, &
- fi, dFidxi, prtr_ijp, prtr_ijn, cap, can, suadd )
+ fi, dFidxi, prtr_ijp, cap, can, suadd )
+ ! fi, dFidxi, prtr_ijp, prtr_ijn, cap, can, suadd )
! > Off-diagonal elements:
@@ -604,6 +620,7 @@ subroutine calcsc(Fi,dFidxi,ifi)
Tau(iWall) = viss*Ut2/dnw(iwall)
gen(ijp)=abs(tau(iWall))*cmu25*sqrt(te(ijp))/(dnw(iwall)*cappa)
+
su(ijp)=su(ijp)+gen(ijp)*vol(ijp)
else
@@ -754,44 +771,45 @@ subroutine modify_mu_eff()
real(dp) :: visold
real(dp) :: nxf,nyf,nzf,are
real(dp) :: Vnp,Vtp,xtp,ytp,ztp
- real(dp) :: Ut2,Utau,viscw
+ real(dp) :: Utau,viscw
real(dp) :: wldist,etha,f2_sst,alphast
- real(dp) :: Utauvis,Utaulog,Ustar,Upl
+ real(dp) :: Utauvis,Utaulog,Upl
+ ! real(dp) :: fimax,fimin
! Loop trough cells
do inp=1,numCells
- ! Store old value
- visold=vis(inp)
+ ! Store old value
+ visold=vis(inp)
- ! Update effective viscosity:
+ ! Update effective viscosity:
- ! Wall distance
- wldist = walldistance(inp)
+ ! Wall distance
+ wldist = walldistance(inp)
- ! find etha:
- etha=max(2*sqrt(te(inp))/(bettast*wldist*ed(inp)), &
- (500*viscos/den(inp))/(wldist**2*ed(inp)))
+ ! find etha:
+ etha=max(2*sqrt(te(inp))/(bettast*wldist*ed(inp)), &
+ (500*viscos/den(inp))/(wldist**2*ed(inp)))
- ! find f2:
- f2_sst = tanh(etha*etha)
+ ! find f2:
+ f2_sst = tanh(etha*etha)
- vis(inp)=viscos+den(inp)*a1*te(inp)/(max(a1*ed(inp), magStrain(inp)*f2_sst))
+ vis(inp)=viscos+den(inp)*a1*te(inp)/(max(a1*ed(inp), magStrain(inp)*f2_sst))
- ! Low-re version..........................................................
- if (LowRe) then !
- ! Let's find alpha* !
- alphast=(0.024_dp+(densit*te(inp))/(6*viscos*ed(inp))) & !
- /(1.0_dp+(densit*te(inp))/(6*viscos*ed(inp))) !
- vis(inp)=viscos+den(inp)*te(inp)/(ed(inp)+small) & !
- *1.0_dp/max(1.0_dp/alphast, magStrain(inp)*f2_sst/(a1*ed(inp))) !
- ! End of low-re version..................................................!
- end if
+ ! Low-re version..........................................................
+ if (LowRe) then !
+ ! Let's find alpha* !
+ alphast=(0.024_dp+(densit*te(inp))/(6*viscos*ed(inp))) & !
+ /(1.0_dp+(densit*te(inp))/(6*viscos*ed(inp))) !
+ vis(inp)=viscos+den(inp)*te(inp)/(ed(inp)+small) & !
+ *1.0_dp/max(1.0_dp/alphast, magStrain(inp)*f2_sst/(a1*ed(inp))) !
+ ! End of low-re version..................................................!
+ end if
- ! Underelaxation
- vis(inp)=urf(ivis)*vis(inp)+(1.0_dp-urf(ivis))*visold
+ ! Underelaxation
+ vis(inp)=urf(ivis)*vis(inp)+(1.0_dp-urf(ivis))*visold
enddo
@@ -873,43 +891,66 @@ subroutine modify_mu_eff()
! Magnitude of tangential velocity component
Vtp = sqrt(xtp*xtp+ytp*ytp+ztp*ztp)
- ! Tangent direction
- xtp = xtp/vtp
- ytp = ytp/vtp
- ztp = ztp/vtp
+ ! ! Tangent direction
+ ! xtp = xtp/vtp
+ ! ytp = ytp/vtp
+ ! ztp = ztp/vtp
- ! projektovanje razlike brzina na pravac tangencijalne brzine u cell centru ijp
- Ut2 = abs( (U(ijb)-U(ijp))*xtp + (V(ijb)-V(ijp))*ytp + (W(ijb)-W(ijp))*ztp )
+ ! ! projektovanje razlike brzina na pravac tangencijalne brzine u cell centru ijp
+ ! Ut2 = abs( (U(ijb)-U(ijp))*xtp + (V(ijb)-V(ijp))*ytp + (W(ijb)-W(ijp))*ztp )
! Tau(iWall) = viscos*Ut2/dnw(iWall)
! Utau = sqrt( Tau(iWall) / den(ijb) )
! ypl(iWall) = den(ijb)*Utau*dnw(iWall)/viscos
! Ima i ova varijanta...ovo je tehnicki receno ystar iliti y* a ne y+
- ypl(iWall) = den(ijp)*cmu25*sqrt(te(ijp))*dnw(iWall)/viscos
+ ! ypl(iWall) = den(ijp)*cmu25*sqrt(te(ijp))*dnw(iWall)/viscos
- !
- ! Automatic wall treatment
- !
- Utauvis=Vtp/ypl(iWall)
- Utaulog=Vtp*cappa/log(Elog*ypl(iWall))
- Utau=sqrt(sqrt(Utauvis**4+Utaulog**4))
- Ustar=sqrt(sqrt( Utauvis**4 + Sqrt(0.31*te(ijp))**4))
-
- ypl(iWall)=den(ijp)*sqrt(utau*ustar)*dnw(iWall)/viscos
+ ! *** Automatic wall treatment ***
+
+ utau = sqrt( viscos*Vtp/(densit*dnw(iWall)) + cmu25*te(ijp) ) ! It's actually u* in original reference...
+
+ ypl(iWall) = den(ijp)*Utau*dnw(iWall)/viscos
- ! Wall shear stress
- ! tau(iwall) = cappa*den(ijp)*Vtp*cmu25*sqrt(te(ijp))/log(Elog*ypl(iWall))
- tau(iWall) = den(ijp)*Utau*Ustar
+ Utauvis=ypl(iWall)
+ Utaulog=1.0/cappa*log(Elog*ypl(iWall))
- ! viscw = zero
- ! if(ypl(iWall) > ctrans) then
- ! viscw = ypl(iWall)*viscos*cappa/log(Elog*ypl(iWall))
- ! endif
+ Upl=sqrt(sqrt(Utauvis**4+Utaulog**4))
+
+ viscw = den(ijp)*utau*dnw(iWall)/Upl
- Upl = Vtp/Utau
- viscw = ypl(iWall)*viscos/Upl
+ ! Blended version of shear stress - probati ovo(!?)
+ ! tau(iWall) = den(ijp) * (Vtp/Uplblend)**2
+
+ ! Varijanta 2, u originalnoj referenci...
+ tau(iWall) = den(ijp) * Vtp*Utau/Upl
+
+ !*** END: Automatic wall treatment ***
+
+ ! ! *** Enhanced wall treatment - Reichardt blending ***
+
+ ! ! Below is a variant where we use Reichardt blending
+ ! ! for whole span of y+ values.
+ ! ! Some authors say that Reichardt function for u+ approximates
+ ! ! the composite u+(y+) curve, better that Kader blending function.
+
+ ! utau = sqrt( viscos*Vtp/(densit*dnw(iWall)) + cmu25*te(ijp) ) ! It's actually u* in original reference...
+
+ ! ypl(iWall) = den(ijp)*Utau*dnw(iWall)/viscos
+
+ ! Uplblend = one/cappa*log(one+cappa*ypl(iWall)) + &
+ ! 7.8_dp*(1.-exp(-ypl(iWall)/11.0_dp)-(ypl(iWall)/11.0_dp)*exp(-ypl(iWall)/3.0_dp))
+
+ ! viscw = den(ijp)*utau*dnw(iWall)/Uplblend
+
+ ! ! Blended version of shear stress - probati ovo(!?)
+ ! ! tau(iWall) = den(ijp) * (Vtp/Uplblend)**2
+
+ ! ! Varijanta 2, u originalnoj referenci...
+ ! tau(iWall) = den(ijp) * Vtp*Utau/Uplblend
+
+ ! !*** END: Enhanced wall treatment - Reichardt blending ***
visw(iWall) = max(viscos,viscw)
vis(ijb) = visw(iWall)
@@ -920,6 +961,11 @@ subroutine modify_mu_eff()
enddo
+ ! fimin = minval(vis/viscos)
+ ! fimax = maxval(vis/viscos)
+
+ ! write(6,'(2x,es11.4,3a,es11.4)') fimin,' <= Viscosity ratio <= ',fimax
+
end subroutine modify_mu_eff
diff --git a/src/finiteVolume/fvEqnDiscretization/TurbulenceModels/spalart_allmaras.f90 b/src/finiteVolume/fvEqnDiscretization/TurbulenceModels/spalart_allmaras.f90
index db4579a..217afba 100644
--- a/src/finiteVolume/fvEqnDiscretization/TurbulenceModels/spalart_allmaras.f90
+++ b/src/finiteVolume/fvEqnDiscretization/TurbulenceModels/spalart_allmaras.f90
@@ -174,7 +174,7 @@ subroutine calcsc(Fi,dFidxi,ifi)
sp(inp) = sp(inp)-genn*vol(inp)/(nu_tilda+small)
! > UNSTEADY TERM
- if( bdf ) then
+ if( bdf .or. cn ) then
apotime = den(inp)*vol(inp)/timestep
su(inp) = su(inp) + apotime*teo(inp)
sp(inp) = sp(inp) + apotime
diff --git a/src/finiteVolume/fvEqnDiscretization/Velocity/calcuvw.f90 b/src/finiteVolume/fvEqnDiscretization/Velocity/calcuvw.f90
index 53bf0ce..385e117 100644
--- a/src/finiteVolume/fvEqnDiscretization/Velocity/calcuvw.f90
+++ b/src/finiteVolume/fvEqnDiscretization/Velocity/calcuvw.f90
@@ -13,6 +13,7 @@ subroutine calcuvw
use gradients, only: grad
use faceflux_velocity
use fieldManipulation, only: calcPressDiv
+ use mhd
implicit none
!
@@ -92,15 +93,14 @@ subroutine calcuvw
endif
-
-
! Velocity gradients:
+ call updateVelocityAtBoundary
call grad(U,dUdxi)
call grad(V,dVdxi)
call grad(W,dWdxi)
-
-
+ ! Update values of Lorentz force vector components in MHD case.
+ if(lcal(iep)) call calculate_Lorentz_force
!----------------------------------------------------------------------------
! CALCULATE SOURCE TERMS INTEGRATED OVER VOLUME
@@ -132,68 +132,81 @@ subroutine calcuvw
endif
!
- ! Unsteady term
- !
- if( bdf ) then
- !
- ! Backward differentiation formula of 1st order.
+ ! MHD: Lorentz force source terms
!
- apotime = den(inp)*vol(inp)/timestep
-
- ! RHS vector contribution
- su(inp) = su(inp) + apotime*uo(inp)
- sv(inp) = sv(inp) + apotime*vo(inp)
- sw(inp) = sw(inp) + apotime*wo(inp)
+ if(lcal(iep)) then
- ! Matrix diagonal element contribution
- spu(inp) = spu(inp) + apotime
- spv(inp) = spv(inp) + apotime
- sp(inp) = sp(inp) + apotime
+ ! Add Lorentz force volume source terms.
+ su(inp) = su(inp) + sigma*florx(inp)*vol(inp)
+ sv(inp) = sv(inp) + sigma*flory(inp)*vol(inp)
+ sw(inp) = sw(inp) + sigma*florz(inp)*vol(inp)
- elseif( bdf2 ) then
- !
- ! Three Level Implicit Time Integration (BDF2) - 2nd order.
- !
- apotime = den(inp)*vol(inp)/timestep
-
- ! RHS vector contribution
- su(inp) = su(inp) + apotime*( 2*uo(inp) - 0.5_dp*uoo(inp) )
- sv(inp) = sv(inp) + apotime*( 2*vo(inp) - 0.5_dp*voo(inp) )
- sw(inp) = sw(inp) + apotime*( 2*wo(inp) - 0.5_dp*woo(inp) )
-
- ! Matrix diagonal element contribution
- spu(inp) = spu(inp) + 1.5_dp*apotime
- spv(inp) = spv(inp) + 1.5_dp*apotime
- sp(inp) = sp(inp) + 1.5_dp*apotime
+ endif
- elseif( bdf3 ) then
!
- ! Three Level Implicit Time Integration (BDF2) - 2nd order.
+ ! Unsteady term
!
- apotime = den(inp)*vol(inp)/timestep
-
- ! RHS vector contribution
- su(inp) = su(inp) + apotime*( 3*uo(inp) - 1.5_dp*uoo(inp) + 1./3.0_dp*uooo(inp) )
- sv(inp) = sv(inp) + apotime*( 3*vo(inp) - 1.5_dp*voo(inp) + 1./3.0_dp*vooo(inp) )
- sw(inp) = sw(inp) + apotime*( 3*wo(inp) - 1.5_dp*woo(inp) + 1./3.0_dp*wooo(inp) )
+ if(ltransient) then
+
+ if( bdf .or. cn ) then
+ !
+ ! Backward differentiation formula of 1st order.
+ !
+ apotime = den(inp)*vol(inp)/timestep
+
+ ! RHS vector contribution
+ su(inp) = su(inp) + apotime*uo(inp)
+ sv(inp) = sv(inp) + apotime*vo(inp)
+ sw(inp) = sw(inp) + apotime*wo(inp)
+
+ ! Matrix diagonal element contribution
+ spu(inp) = spu(inp) + apotime
+ spv(inp) = spv(inp) + apotime
+ sp(inp) = sp(inp) + apotime
+
+ elseif( bdf2 ) then
+ !
+ ! Three Level Implicit Time Integration (BDF2) - 2nd order.
+ !
+ apotime = den(inp)*vol(inp)/timestep
+
+ ! RHS vector contribution
+ su(inp) = su(inp) + apotime*( 2*uo(inp) - 0.5_dp*uoo(inp) )
+ sv(inp) = sv(inp) + apotime*( 2*vo(inp) - 0.5_dp*voo(inp) )
+ sw(inp) = sw(inp) + apotime*( 2*wo(inp) - 0.5_dp*woo(inp) )
+
+ ! Matrix diagonal element contribution
+ spu(inp) = spu(inp) + 1.5_dp*apotime
+ spv(inp) = spv(inp) + 1.5_dp*apotime
+ sp(inp) = sp(inp) + 1.5_dp*apotime
+
+
+ elseif( bdf3 ) then
+ !
+ ! Three Level Implicit Time Integration (BDF2) - 2nd order.
+ !
+ apotime = den(inp)*vol(inp)/timestep
+
+ ! RHS vector contribution
+ su(inp) = su(inp) + apotime*( 3*uo(inp) - 1.5_dp*uoo(inp) + 1./3.0_dp*uooo(inp) )
+ sv(inp) = sv(inp) + apotime*( 3*vo(inp) - 1.5_dp*voo(inp) + 1./3.0_dp*vooo(inp) )
+ sw(inp) = sw(inp) + apotime*( 3*wo(inp) - 1.5_dp*woo(inp) + 1./3.0_dp*wooo(inp) )
+
+ ! Matrix diagonal element contribution
+ spu(inp) = spu(inp) + 11./6.0_dp*apotime
+ spv(inp) = spv(inp) + 11./6.0_dp*apotime
+ sp(inp) = sp(inp) + 11./6.0_dp*apotime
- ! Matrix diagonal element contribution
- spu(inp) = spu(inp) + 11./6.0_dp*apotime
- spv(inp) = spv(inp) + 11./6.0_dp*apotime
- sp(inp) = sp(inp) + 11./6.0_dp*apotime
+ endif
- endif
+ endif ! unsteady term
end do
-
!----------------------------------------------------------------------------
! Calculate Reynols stresses explicitly and additional asm terms:
!----------------------------------------------------------------------------
-
- ! NOTE: Ovo mu treba za neki postprocessing ili a neke druge clanove ali ne znam zasto ga ovde racuna - nema smisla
- ! jer nije osvezio polje brzina...
! if(lturb) then
! call calcstress
! if (lasm) call Additional_algebraic_stress_terms
@@ -345,9 +358,9 @@ subroutine calcuvw
ijb = iBndValueStart(ib) + i
iWall = iWall + 1
- viss = viscos ! viskoznost interpolirana na boundary face
- if(lturb.and.ypl(iWall).gt.ctrans) viss=visw(iWall)
- ! viss=max(viscos,visw(iWall))
+ ! viss = viscos ! viskoznost interpolirana na boundary face
+ ! if(lturb.and.ypl(iWall).gt.ctrans) viss=visw(iWall)
+ viss=max(viscos,visw(iWall))
! Face area
are = sqrt(arx(iface)**2+ary(iface)**2+arz(iface)**2)
diff --git a/src/finiteVolume/fvExplicit/calc_strain_and_vorticity.f90 b/src/finiteVolume/fvExplicit/calc_strain_and_vorticity.f90
index fbed895..43ce95a 100644
--- a/src/finiteVolume/fvExplicit/calc_strain_and_vorticity.f90
+++ b/src/finiteVolume/fvExplicit/calc_strain_and_vorticity.f90
@@ -41,9 +41,9 @@ subroutine calc_strain_and_vorticity
! Find antisymmetric part of velocity gradient tensor
! [om_ij]: |om_ij|=sqrt[2 om_ij om_ij]
- w12=0.5*(dudy - dvdx)
- w13=0.5*(dudz - dwdx)
- w23=0.5*(dvdz - dwdy)
+ w12=(dudy - dvdx)
+ w13=(dudz - dwdx)
+ w23=(dvdz - dwdy)
! Find strain rate s = sqrt (2*sij*sij)
diff --git a/src/finiteVolume/fvExplicit/calcheatflux.f90 b/src/finiteVolume/fvExplicit/calcheatflux.f90
index b3aeb11..5e05dd3 100644
--- a/src/finiteVolume/fvExplicit/calcheatflux.f90
+++ b/src/finiteVolume/fvExplicit/calcheatflux.f90
@@ -127,7 +127,7 @@ subroutine calcheatflux
ut5=sksi*vtt(inp)*dudy
ut6=sksi*wtt(inp)*dudz
ut7=gravx*eta*vart(inp)*beta
- if(.not.boussinesq) ut7 = gravx*eta*vart(inp)/(t(inp)+273.0d0)
+ if(.not.boussinesq) ut7 = gravx*eta*vart(inp)/(t(inp)+small)
vt1=uv(inp)*dtdx
vt2=vv(inp)*dtdy
@@ -136,7 +136,7 @@ subroutine calcheatflux
vt5=sksi*vtt(inp)*dvdy
vt6=sksi*wtt(inp)*dvdz
vt7=gravy*eta*vart(inp)*beta
- if(.not.boussinesq) vt7 = gravy*eta*vart(inp)/(t(inp)+273.0d0)
+ if(.not.boussinesq) vt7 = gravy*eta*vart(inp)/(t(inp)+small)
wt1=uw(inp)*dtdx
wt2=vw(inp)*dtdy
@@ -145,7 +145,7 @@ subroutine calcheatflux
wt5=sksi*vtt(inp)*dwdy
wt6=sksi*wtt(inp)*dwdz
wt7=gravz*eta*vart(inp)*beta
- if(.not.boussinesq) wt7 = gravz*eta*vart(inp)/(t(inp)+273.0d0)
+ if(.not.boussinesq) wt7 = gravz*eta*vart(inp)/(t(inp)+small)
utt(inp) = -phit*tedi*(ut1+ut2+ut3+ut4+ut5+ut6+ut7)
vtt(inp) = -phit*tedi*(vt1+vt2+vt3+vt4+vt5+vt6+vt7)
diff --git a/src/finiteVolume/fvExplicit/calcstress.f90 b/src/finiteVolume/fvExplicit/calcstress.f90
index 7065e92..f29c391 100644
--- a/src/finiteVolume/fvExplicit/calcstress.f90
+++ b/src/finiteVolume/fvExplicit/calcstress.f90
@@ -9,7 +9,7 @@ subroutine calcstress
!
use types
use parameters
- use geometry, only: numCells, vol
+ use geometry, only: numCells
use variables
implicit none
@@ -17,7 +17,6 @@ subroutine calcstress
!***********************************************************************
!
integer :: inp
- real(dp) :: volr ! 1/cellvolume
real(dp) :: vist ! turbulent viscosity
real(dp) :: dudx, dudy, dudz, & ! dudxi - the velocity gradient
dvdx, dvdy, dvdz, & ! dvdxi - the velocity gradient
@@ -30,8 +29,6 @@ subroutine calcstress
do inp=1,numCells
- volr=1.0_dp/vol(inp)
-
vist=(vis(inp)-viscos)/densit
uuold=uu(inp)
diff --git a/src/finiteVolume/fvExplicit/fieldManipulation.f90 b/src/finiteVolume/fvExplicit/fieldManipulation.f90
index 40e358e..4a059c9 100644
--- a/src/finiteVolume/fvExplicit/fieldManipulation.f90
+++ b/src/finiteVolume/fvExplicit/fieldManipulation.f90
@@ -3,11 +3,15 @@ module fieldManipulation
!***********************************************************************
!
use types
- use parameters
use gradients
+ use interpolation, only: face_value_w_option
implicit none
+ ! The inerpolations that we do for e.g. divergence is hardcoded here
+ ! I think it is the best thing to choose the best working thing.
+ ! Recommended are: 'central', 'cds', 'cdscorr'
+ character(len=10), parameter :: scheme = 'cdscorr'
interface explDiv
module procedure explDiv
@@ -57,10 +61,17 @@ pure function volumeWeightedAverage(U) result(wAvgU)
subroutine calcPressDiv
!
!***********************************************************************
-!
-! Calculates -Div(p)
-! ExplDiv(u) = sum_{i=1}^{i=nf} (u)_f*sf or
-! Interpolation to cell face centers done by cds corrected scheme.
+!
+! -(nabla p) is a vector field: -( (nabla p)x . i + (nabla p)y . j + (nabla p)z . k )
+! Instead of computing the Grad(p) vector field in center and integrate volumetricaly
+! simply multiplying it by Vol(ijp), we write it in divergence form.
+! Interpolate to face {-(nabla p),i . e_i}_f * S_f
+! where ',i' is a partial derivative with respect to i, i={x,y,z},
+! '.' is a scalar product of vectors,
+! and {}_f is interpolation to face center.
+! And get {-(nabla p),i}_f * (S_f. e_i) = {-(nabla p),i}_f * S_fi
+! Source(u_i) = sum_over_cell_faces {-(nabla p),i}_f * S_fi
+! Interpolation to cell face centers done by central scheme.
!
!***********************************************************************
!
@@ -75,6 +86,7 @@ subroutine calcPressDiv
!...Local
+ integer, parameter :: nipgrad = 2
integer :: i,ijp,ijn,ijb,iface,istage
real(dp) :: dfxe,dfye,dfze
@@ -122,16 +134,10 @@ subroutine calcPressDiv
!***********************************************************************
!
- function explDiv(u) result(div)
+ function explDiv(u,v,w) result(div)
!
!***********************************************************************
!
-! Calculates explicit divergence of scalar field phi - Div(phi)
-! explDiv(u) = sum_{i=1}^{i=nf} (u)_f*sf or
-! Interpolation to cell face centers done by cds corrected scheme.
-!
-!***********************************************************************
-!
use geometry
implicit none
@@ -143,15 +149,18 @@ function explDiv(u) result(div)
real(dp), dimension(numCells) :: div
!...Input
- real(dp), dimension(numTotal) :: u
+ real(dp), dimension(numTotal) :: u,v,w
!...Local
integer :: i,ijp,ijn,ijb,iface
real(dp) :: dfxe
- real(dp), dimension(3,numCells) :: dUdxi
+ real(dp), dimension(3,numTotal) :: dUdxi,dvdxi,dWdxi
! Calculate cell-centered gradient
+ !call updateBoundary(u,'boundary_region_name', zeroGrad/value/nGrad)
call grad(u,dUdxi)
+ call grad(v,dVdxi)
+ call grad(w,dWdxi)
! Calculate terms integrated over surfaces
@@ -160,7 +169,7 @@ function explDiv(u) result(div)
ijp = owner(i)
ijn = neighbour(i)
call faceDivInner(ijp, ijn, xf(i), yf(i), zf(i), arx(i), ary(i), arz(i), facint(i), &
- u, dUdxi,dfxe)
+ u,v,w, dUdxi,dvdxi,dWdxi, dfxe)
! Accumulate contribution at cell center and neighbour.
div(ijp) = div(ijp)+dfxe
@@ -173,7 +182,11 @@ function explDiv(u) result(div)
iface = numInnerFaces + i
ijp = owner(iface)
ijb = numCells + i
- call faceDivBoundary(arx(iface), ary(iface), arz(iface), u(ijb), dfxe)
+ call faceDivBoundary(arx(iface), ary(iface), arz(iface), u(ijb),v(ijb),w(ijb), dfxe)
+ ! I'm putting minus here, because the face normal is allways facing out
+ ! and if we get positive alignement with that vector we will have a positive contribution
+ ! to divergence, but the thing is in fact opposite since divergence
+ ! grows if something goes into the volume
div(ijp) = div(ijp) + dfxe
enddo
@@ -184,17 +197,10 @@ function explDiv(u) result(div)
!***********************************************************************
!
- function explDivMdot(flmass,u) result(div)
+ function explDivMdot(flmass,u,v,w) result(div)
!
!***********************************************************************
!
-! Calculates explicit divergence of scalar field mdot*phi - Div(mdot,phi)
-! explDiv(u) = sum_{i=1}^{i=nf} mdot*(u)_f*sf or
-! Interpolation to cell face centers done by cds corrected scheme.
-! flmass - is surface field, no need for intepolation.
-!
-!***********************************************************************
-!
use geometry
implicit none
@@ -207,15 +213,18 @@ function explDivMdot(flmass,u) result(div)
!...Input
real(dp), dimension(numTotal) :: flmass
- real(dp), dimension(numTotal) :: u
+ real(dp), dimension(numTotal) :: u,v,w
!...Local
integer :: i,ijp,ijn,ijb,iface
real(dp) :: dfxe
- real(dp), dimension(3,numCells) :: dUdxi
+ real(dp), dimension(3,numTotal) :: dUdxi,dvdxi,dWdxi
! Calculate cell-centered gradient
+ !call updateBoundary(u,'boundary_region_name', zeroGrad/value/nGrad)
call grad(u,dUdxi)
+ call grad(v,dVdxi)
+ call grad(w,dWdxi)
! Calculate terms integrated over surfaces
@@ -224,7 +233,7 @@ function explDivMdot(flmass,u) result(div)
ijp = owner(i)
ijn = neighbour(i)
call faceDivInner(ijp, ijn, xf(i), yf(i), zf(i), arx(i), ary(i), arz(i), facint(i), &
- u, dUdxi,dfxe)
+ u,v,w, dUdxi,dvdxi,dWdxi ,dfxe)
! Accumulate contribution at cell center and neighbour.
div(ijp) = div(ijp) + flmass(i) * dfxe
@@ -238,7 +247,11 @@ function explDivMdot(flmass,u) result(div)
iface = numInnerFaces + i
ijp = owner(iface)
ijb = numCells + i
- call faceDivBoundary(arx(iface), ary(iface), arz(iface), u(ijb), dfxe)
+ call faceDivBoundary(arx(iface), ary(iface), arz(iface), u(ijb),v(ijb),w(ijb), dfxe)
+ ! I'm putting minus here, because the face normal is allways facing out
+ ! and if we get positive alignement with that vector we will have a positive contribution
+ ! to divergence, but the thing is in fact opposite since divergence
+ ! grows if something goes into the volume
div(ijp) = div(ijp) + flmass(iface) * dfxe
enddo
@@ -255,50 +268,31 @@ subroutine presFaceDivInner(ijp,ijn, &
fi,df,dfxe,dfye,dfze)
!
!***********************************************************************
-!
-! This routine calculates contribution to the explicit Divergence
-! of a scalar FI (pressure) arising from an inner cell face.
-!
-!***********************************************************************
!
- use types
- use parameters
- use geometry
+ use geometry, only: numTotal
implicit none
- integer, intent(in) :: ijp,ijn
+ integer, intent(in) :: ijp,ijn
real(dp), intent(in) :: xfc,yfc,zfc
real(dp), intent(in) :: sx,sy,sz
real(dp), intent(in) :: fif
real(dp), dimension(numTotal), intent(in) :: fi
- real(dp), dimension(3,numCells), intent(in) :: df
+ real(dp), dimension(3,numTotal), intent(in) :: df
+ real(dp), intent(out) :: dfxe,dfye,dfze
-
- real(dp) :: xi,yi,zi,dfxi,dfyi,dfzi
- real(dp) :: fie,dfxe,dfye,dfze
- real(dp) :: fxn,fxp
+ real(dp) :: fie
!
!***********************************************************************
!
- fxn = fif
- fxp = 1.0d0-fxn
-
- xi = xc(ijp)*fxp+xc(ijn)*fxn
- yi = yc(ijp)*fxp+yc(ijn)*fxn
- zi = zc(ijp)*fxp+zc(ijn)*fxn
- dfxi = df(ijp,1)*fxp+df(ijn,1)*fxn
- dfyi = df(ijp,2)*fxp+df(ijn,2)*fxn
- dfzi = df(ijp,3)*fxp+df(ijn,3)*fxn
+ ! Value of the variable at cell-face center
+ fie = face_value_w_option( ijp, ijn, xfc, yfc, zfc, fif, fi, df, scheme )
- ! Value of the variable at cell-face center
- fie = fi(ijp)*fxp+fi(ijn)*fxn + dfxi*(xfc-xi)+dfyi*(yfc-yi)+dfzi*(zfc-zi)
-
- ! (interpolated mid-face value)x(area)
- dfxe = fie*sx
- dfye = fie*sy
- dfze = fie*sz
+ ! (interpolated mid-face value)x(area)
+ dfxe = fie*sx
+ dfye = fie*sy
+ dfze = fie*sz
end subroutine
@@ -308,18 +302,11 @@ subroutine presFaceDivInner(ijp,ijn, &
!
subroutine faceDivInner(ijp,ijn, &
xfc,yfc,zfc,sx,sy,sz,fif, &
- fi,df,dfxe)
+ u,v,w,du,dv,dw,dfxe)
!
!***********************************************************************
!
-! This routine calculates contribution to the explicit Divergence
-! of a scalar FI (pressure) arising from an inner cell face.
-!
-!***********************************************************************
-!
- use types
- use parameters
- use geometry
+ use geometry, only: numTotal
implicit none
@@ -327,61 +314,41 @@ subroutine faceDivInner(ijp,ijn, &
real(dp), intent(in) :: xfc,yfc,zfc
real(dp), intent(in) :: sx,sy,sz
real(dp), intent(in) :: fif
- real(dp), dimension(numTotal), intent(in) :: fi
- real(dp), dimension(3,numCells), intent(in) :: df
+ real(dp), dimension(numTotal), intent(in) :: u,v,w
+ real(dp), dimension(3,numTotal), intent(in) :: du,dv,dw
+ real(dp), intent(out) :: dfxe
-
- real(dp) :: xi,yi,zi,dfxi,dfyi,dfzi
- real(dp) :: fie,dfxe
- real(dp) :: fxn,fxp
- real(dp) :: are
+ real(dp) :: uf,vf,wf
!
!***********************************************************************
!
- fxn = fif
- fxp = 1.0d0-fxn
-
- xi = xc(ijp)*fxp+xc(ijn)*fxn
- yi = yc(ijp)*fxp+yc(ijn)*fxn
- zi = zc(ijp)*fxp+zc(ijn)*fxn
- dfxi = df(ijp,1)*fxp+df(ijn,1)*fxn
- dfyi = df(ijp,2)*fxp+df(ijn,2)*fxn
- dfzi = df(ijp,3)*fxp+df(ijn,3)*fxn
+ ! Value of the variable at cell-face center
+ uf = face_value_w_option( ijp, ijn, xfc, yfc, zfc, fif, u, du, scheme )
+ vf = face_value_w_option( ijp, ijn, xfc, yfc, zfc, fif, v, dv, scheme )
+ wf = face_value_w_option( ijp, ijn, xfc, yfc, zfc, fif, w, dw, scheme )
- ! Value of the variable at cell-face center
- fie = fi(ijp)*fxp+fi(ijn)*fxn + dfxi*(xfc-xi)+dfyi*(yfc-yi)+dfzi*(zfc-zi)
-
- ! Face area
- are = sqrt(sx**2+sy**2+sz**2)
-
- ! (interpolated mid-face value)x(area)
- dfxe = fie*are
+ ! (interpolated mid-face value)x(area)
+ dfxe = uf*sx + vf*sy + wf*sz
end subroutine
!***********************************************************************
!
- subroutine faceDivBoundary(sx,sy,sz,fi,dfx)
-!
-!***********************************************************************
-!
-! This routine calculates the contribution of a boundary cell face to
-! explicit Divergence of scalar FI.
+ subroutine faceDivBoundary(sx,sy,sz,uf,vf,wf,dfx)
!
!***********************************************************************
!
-
implicit none
real(dp), intent(in) :: sx,sy,sz
- real(dp), intent(in) :: fi
+ real(dp), intent(in) :: uf,vf,wf
real(dp), intent(out) :: dfx
!
!***********************************************************************
!
- dfx = fi*sqrt(sx**2+sy**2+sz**2)
+ dfx = uf*sx + vf*sy + wf*sz
end subroutine
@@ -391,12 +358,6 @@ subroutine presFaceDivBoundary(sx,sy,sz,fi,dfx,dfy,dfz)
!
!***********************************************************************
!
-! This routine calculates the contribution of a boundary cell face to
-! explicit Divergence of scalar FI.
-!
-!***********************************************************************
-!
-
implicit none
real(dp), intent(in) :: sx,sy,sz
@@ -438,30 +399,29 @@ function average(u) result(aver)
real(dp), dimension(numTotal) :: u
!...Local
- integer :: i,ijp,ijn,iface
- real(dp) :: dfxe
+ integer :: i,ijp,ijn,ijb,iface
+ real(dp) :: ui
real(dp) :: are
- real(dp), dimension(3,numCells) :: dUdxi
+ real(dp), dimension(3,numTotal) :: dUdxi
real(dp), dimension(numCells) :: sumsf
! Calculate cell-centered gradient
call grad(u,dUdxi)
- ! Calculate terms integrated over surfaces
! Inner face
do i=1,numInnerFaces
ijp = owner(i)
ijn = neighbour(i)
- call faceDivInner(ijp, ijn, xf(i), yf(i), zf(i), arx(i), ary(i), arz(i), facint(i), &
- u, dUdxi,dfxe)
- ! Accumulate contribution at cell center and neighbour.
- aver(ijp) = aver(ijp)+dfxe
+ are = sqrt( arx(i)**2 + ary(i)**2 + arz(i)**2 )
- aver(ijn) = aver(ijn)-dfxe
+ ui = face_value_w_option( ijp, ijn, xf(i), yf(i), zf(i), facint(i), u, dUdxi, scheme )
+
+ ! Accumulate contribution at cell center and neighbour.
+ aver(ijp) = aver(ijp)+ui*are
+ aver(ijn) = aver(ijn)-ui*are
- are = sqrt( arx(i)**2 + ary(i)**2 + arz(i)**2 )
sumsf(ijp) = sumsf(ijp) + are
sumsf(ijn) = sumsf(ijn) + are
@@ -471,9 +431,12 @@ function average(u) result(aver)
do i=1,numBoundaryFaces
iface = numInnerFaces + i
ijp = owner(iface)
+ ijb = numCells + i
are = sqrt( arx(iface)**2 + ary(iface)**2 + arz(iface)**2 )
+ aver(ijp) = aver(ijp)+u(ijb)*are
sumsf(ijp) = sumsf(ijp) + are
+
enddo
! Divide by bounding faces total area
@@ -487,7 +450,7 @@ function average(u) result(aver)
!***********************************************************************
!
- function Interpolate(u) result(ui)
+ function field_interpolate(u) result(ui)
!
!***********************************************************************
!
@@ -511,7 +474,7 @@ function Interpolate(u) result(ui)
!...Local
integer :: i,ijp,ijn,ijb,iface
- real(dp), dimension(3,numCells) :: dUdxi
+ real(dp), dimension(3,numTotal) :: dUdxi
! Calculate cell-centered gradient
call grad(u,dUdxi)
@@ -522,9 +485,10 @@ function Interpolate(u) result(ui)
do i=1,numInnerFaces
ijp = owner(i)
ijn = neighbour(i)
- call faceInterpolateCdsCorr( ijp, ijn, xf(i), yf(i), zf(i), facint(i), u, dUdxi, ui(i) )
+ ui(i) = face_value_w_option( ijp, ijn, xf(i), yf(i), zf(i), facint(i), u, dUdxi, scheme )
enddo
+ ! Update boundaries?
! Contribution from boundaries
do i=1,numBoundaryFaces
@@ -533,8 +497,7 @@ function Interpolate(u) result(ui)
ui(iface) = u(ijb)
enddo
- return
- end
+ end function
@@ -560,23 +523,22 @@ function surfaceSum(u) result(ssum)
real(dp), dimension(numCells) :: ssum
!...Input
- real(dp), dimension(numTotal) :: u
+ real(dp), dimension(numTotal), intent(in) :: u
!...Local
integer :: i,ijp,ijn,ijb,if
real(dp) :: ui
- real(dp), dimension(3,numCells) :: dUdxi
+ real(dp), dimension(3,numTotal) :: dUdxi
! Calculate cell-centered gradient
call grad(u,dUdxi)
- ! Calculate terms integrated over surfaces
-
! Inner face
do i=1,numInnerFaces
ijp = owner(i)
ijn = neighbour(i)
- call faceInterpolateCdsCorr( ijp, ijn, xf(i), yf(i), zf(i), facint(i), u, dUdxi, ui )
+
+ ui = face_value_w_option( ijp, ijn, xf(i), yf(i), zf(i), facint(i), u, dUdxi, scheme )
! Accumulate contribution at cell center and neighbour.
ssum(ijp) = ssum(ijp)+ui
@@ -625,7 +587,7 @@ function surfaceIntegrate(u) result(ssum)
!...Local
integer :: i,ijp,ijn,ijb,if
real(dp) :: ui
- real(dp), dimension(3,numCells) :: dUdxi
+ real(dp), dimension(3,numTotal) :: dUdxi
! Calculate cell-centered gradient
call grad(u,dUdxi)
@@ -636,7 +598,8 @@ function surfaceIntegrate(u) result(ssum)
do i=1,numInnerFaces
ijp = owner(i)
ijn = neighbour(i)
- call faceInterpolateCdsCorr( ijp, ijn, xf(i), yf(i), zf(i), facint(i), u, dUdxi, ui )
+
+ ui = face_value_w_option( ijp, ijn, xf(i), yf(i), zf(i), facint(i), u, dUdxi, scheme )
! Accumulate contribution at cell center and neighbour.
ssum(ijp) = ssum(ijp)+ui
@@ -661,55 +624,6 @@ function surfaceIntegrate(u) result(ssum)
end function
-!
-!***********************************************************************
-!
- subroutine faceInterpolateCdsCorr(ijp,ijn, &
- xfc,yfc,zfc,fif, &
- fi,df,fie)
-!
-!***********************************************************************
-!
-! This routine calculates face interpolant using CDS corrected.
-!
-!***********************************************************************
-!
- use types
- use parameters
- use geometry
-
- implicit none
-
- integer, intent(in) :: ijp,ijn
- real(dp), intent(in) :: xfc,yfc,zfc
- real(dp), intent(in) :: fif
- real(dp), dimension(numTotal), intent(in) :: fi
- real(dp), dimension(3,numCells), intent(in) :: df
-
-
- real(dp) :: xi,yi,zi,dfxi,dfyi,dfzi
- real(dp) :: fie
- real(dp) :: fxn,fxp
-!
-!***********************************************************************
-!
- fxn = fif
- fxp = 1.0d0-fxn
-
- xi = xc(ijp)*fxp+xc(ijn)*fxn
- yi = yc(ijp)*fxp+yc(ijn)*fxn
- zi = zc(ijp)*fxp+zc(ijn)*fxn
-
- dfxi = df(ijp,1)*fxp+df(ijn,1)*fxn
- dfyi = df(ijp,2)*fxp+df(ijn,2)*fxn
- dfzi = df(ijp,3)*fxp+df(ijn,3)*fxn
-
- ! Value of the variable at cell-face center
- fie = fi(ijp)*fxp+fi(ijn)*fxn + dfxi*(xfc-xi)+dfyi*(yfc-yi)+dfzi*(zfc-zi)
-
- end subroutine
-
-
!***********************************************************************
!
diff --git a/src/finiteVolume/fvExplicit/fvx.f90 b/src/finiteVolume/fvExplicit/fvx.f90
new file mode 100644
index 0000000..438f98b
--- /dev/null
+++ b/src/finiteVolume/fvExplicit/fvx.f90
@@ -0,0 +1,220 @@
+module fvx
+!
+! Purpose:
+! Module for explicit operations on discrete tensor fields.
+!
+! Description:
+! Module contains procedures for explicit manipulation of discrete tensor fields based on
+! finite volume computations and integral theorems (e.g. Gauss) of vector calculus.
+! Discrete tensor fields are defined on a given finite volume mesh.
+! That means we are expecting discrete volume/surface scalar/vector/tensor fields.
+! Included operations are:
+! fvxIterpolation (volField -> surfaceField)
+! fvxGrad (volField ->volField)
+! fvxDiv (volField ->volField) or (surfaceField ->volField)
+!
+! Author: Nikola Mirkov
+! This is a part of freeCappuccino.
+! The code is licenced under GPL licence.
+!
+
+use types
+use geometry
+use tensor_fields
+use interpolation
+use gradients
+use fieldManipulation, only: explDiv
+
+implicit none
+
+
+
+interface fvxGrad
+ module procedure fvx_grad_volScalarField
+ module procedure fvx_grad_VolVectorField
+end interface
+
+interface fvxInterpolate
+ module procedure fvcInterpolateScalar
+ module procedure fvcInterpolateVector
+end interface
+
+interface fvxDiv
+ module procedure fvx_div_volVectorField
+ module procedure fvx_div_surfaceVectorField
+end interface
+
+interface fvxSurfaceSum
+ module procedure fvcSurfaceSumGivenVolField
+ module procedure fvcSurfaceSumGivenSurfaceField
+end interface
+
+interface fvxSurfaceIntegrate
+ module procedure fvcSurfaceIntegrateGivenVolField
+ module procedure fvcSurfaceIntegrateGivenSurfaceField
+end interface
+
+interface fvxAverage
+ module procedure fvcAverageGivenVolField
+ module procedure fvcAverageGivenSurfaceField
+end interface
+
+
+public
+
+contains
+
+
+function fvx_div_volVectorField(U) result(phi)
+!
+! Description:
+! Divergence of a volume vector field.
+! Usage:
+! [type(volumeScalarField)] phi = fvxDiv( [type(volumeVectorField)] U )
+!
+ use fieldManipulation
+
+ implicit none
+
+ type(volVectorField), intent(in) :: U
+!
+! > Result
+!
+ type(volScalarField) :: phi
+
+!+-----------------------------------------------------------------------------+
+
+ phi = new_volScalarField( numCells )
+
+ phi%field_name = 'divergence_field'
+
+ !phi % mag = explDiv( U%x, U%y, U%z )
+
+
+ ! Calculate cell-centered gradient
+ !call updateBoundary(u,'boundary_region_name', zeroGrad/value/nGrad)
+ call grad(u,dUdxi)
+ call grad(v,dVdxi)
+ call grad(w,dWdxi)
+
+ ! Calculate terms integrated over surfaces
+
+ ! Inner face
+ do i=1,numInnerFaces
+ ijp = owner(i)
+ ijn = neighbour(i)
+ call faceDivInner(ijp, ijn, xf(i), yf(i), zf(i), arx(i), ary(i), arz(i), facint(i), &
+ u,v,w, dUdxi,dvdxi,dWdxi, dfxe)
+ ! Value of the variable at cell-face center
+ uf = face_value_w_option( ijp, ijn, xfc, yfc, zfc, fif, u, du, scheme )
+ vf = face_value_w_option( ijp, ijn, xfc, yfc, zfc, fif, v, dv, scheme )
+ wf = face_value_w_option( ijp, ijn, xfc, yfc, zfc, fif, w, dw, scheme )
+
+ ! (interpolated mid-face value)x(area)
+ dfxe = uf*sx + vf*sy + wf*sz
+
+ ! Accumulate contribution at cell center and neighbour.
+ div(ijp) = div(ijp)+dfxe
+ div(ijn) = div(ijn)-dfxe
+
+ enddo
+
+ ! Contribution from boundaries
+ do i=1,numBoundaryFaces
+ iface = numInnerFaces + i
+ ijp = owner(iface)
+ ijb = numCells + i
+ call faceDivBoundary(arx(iface), ary(iface), arz(iface), u(ijb),v(ijb),w(ijb), dfxe)
+ !
+ dfx = uf*sx + vf*sy + wf*sz
+ ! I'm putting minus here, because the face normal is allways facing out
+ ! and if we get positive alignement with that vector we will have a positive contribution
+ ! to divergence, but the thing is in fact opposite since divergence
+ ! grows if something goes into the volume
+ div(ijp) = div(ijp) - dfxe
+ enddo
+
+end function fvx_div_volVectorField
+
+
+function fvx_div_surfaceVectorField(U) result(phi)
+!
+! Description:
+! Divergence of a surface vector field.
+! Usage:
+! [type(volumeScalarField)] phi = fvxDiv( [type(surfaceVectorField)] U )
+!
+ implicit none
+
+ type(surfaceVectorField), intent(in) :: U
+!
+! > Result
+!
+ type(volScalarField) :: phi
+
+!
+! > Locals
+!
+ integer :: i,iface
+ integer :: icell,jcell
+
+ real(dp) :: sfuf
+
+!
+! > Initialize
+!
+ phi = new_volScalarField( numCells )
+
+ phi%field_name = 'divergence_field'
+
+ phi % mag = 0.0_dp
+
+!
+! > Inner faces contribution
+!
+ inner_face_loop: do iface=1,numInnerFaces
+!+-----------------------------------------------------------------------------+
+
+ icell = owner(iface)
+ jcell = neighbour(iface)
+
+ ! Dot face area vector and interpolated vector to face, Sf.(u)_f
+ sfuf = u%x (iface)*arx(iface) + u%y (iface)*ary(iface) + u%z (iface)*arz(iface)
+
+ ! Contribution to owner and neighbour cell
+ phi%mag (icell) = phi%mag (icell) + sfuf
+ phi%mag (jcell) = phi%mag (jcell) - sfuf
+
+!+-----------------------------------------------------------------------------+
+ enddo inner_face_loop
+
+!
+! > Boundary faces contribution
+!
+
+ boundary_face_loop: do i=1,numBoundaryFaces
+!+-----------------------------------------------------------------------------+
+ iface = numInnerFaces + i
+ icell = owner(iface)
+
+ ! Dot face area vector and interpolated vector to face, Sf.(u)_f
+ sfuf = u%x (iface)*arx(iface) + u%y (iface)*ary(iface) + u%z (iface)*arz(iface)
+
+ ! Contribution to owner
+ ! NOTE:
+ ! I'm putting minus here, because the face normal is allways facing out
+ ! and if we get positive alignement with that vector we will have a positive contribution
+ ! to divergence, but the thing is in fact opposite since divergence
+ ! grows if something goes into the volume
+ phi%mag (icell) = phi%mag (icell) - sfuf
+
+!+-----------------------------------------------------------------------------+
+ enddo boundary_face_loop
+
+
+end function fvx_div_surfaceVectorField
+
+
+
+
+end module
\ No newline at end of file
diff --git a/src/finiteVolume/fvExplicit/fvxDdt.f90 b/src/finiteVolume/fvExplicit/fvxDdt.f90
index e69de29..087b815 100644
--- a/src/finiteVolume/fvExplicit/fvxDdt.f90
+++ b/src/finiteVolume/fvExplicit/fvxDdt.f90
@@ -0,0 +1,183 @@
+module fvxDdt
+!
+! Purpose:
+! Module for explicit operations on discrete tensor fields.
+!
+! Description:
+! Module contains procedures for explicit manipulation of discrete tensor fields based on
+! finite volume computations and integral theorems (e.g. Gauss) of vector calculus.
+! Discrete tensor fields are defined on a given finite volume mesh.
+! That means we are expecting discrete volume/surface scalar/vector/tensor fields.
+! Included operations are:
+! fvxIterpolation (volField -> surfaceField)
+! fvxGrad (volField ->volField)
+! fvxDiv (volField ->volField) or (surfaceField ->volField)
+!
+! Author: Nikola Mirkov
+! This is a part of freeCappuccino.
+! The code is licenced under GPL licence.
+!
+
+use types
+use geometry
+use tensor_fields
+use interpolation
+use gradients
+
+implicit none
+
+
+interface fvxDdt
+ module procedure fvx_ddt_volVectorField
+ module procedure fvx_ddt_volScalarField
+end interface
+
+public
+
+contains
+
+subroutine fvx_ddt_volVectorField
+!
+!******************************************************************************
+!
+! Explicit discretisation of time derivative.
+!
+!******************************************************************************
+!
+! Description:
+! Ddt operator of a volume vector field.
+! Usage:
+! [type(volumeVectorField)] DUDt = fvxDdt( [type(volumeVectorField)] U )
+!
+ use fieldManipulation
+
+ implicit none
+
+ type(volVectorField), intent(in) :: U
+!
+! > Result
+!
+ type(volVectorField) :: DUDt
+
+!+-----------------------------------------------------------------------------+
+
+ DUDt = new_volVectorField( numCells )
+
+ DUDt%field_name = 'DUDt_field'
+
+ do inp=1,numCells
+
+ if (bdf) then
+
+ apotime=den(inp)*vol(inp)/timestep
+
+ DUDt%x(inp) = apotime*( u(inp) - uo(inp) )
+ DUDt%y(inp) = apotime*( v(inp) - vo(inp) )
+ DUDt%z(inp) = apotime*( w(inp) - wo(inp) )
+
+ elseif (bdf2) then
+
+ apotime=den(inp)*vol(inp)/timestep
+
+ DUDt%x(inp) = apotime*( 1.5*u(inp) - 2*uo(inp) + 0.5*uoo(inp) )
+ DUDt%y(inp) = apotime*( 1.5*v(inp) - 2*vo(inp) + 0.5*voo(inp) )
+ DUDt%z(inp) = apotime*( 1.5*w(inp) - 2*wo(inp) + 0.5*woo(inp) )
+
+ endif
+
+ end do
+
+
+end subroutine
+
+
+subroutine fvx_ddt_volScalarField
+!
+!******************************************************************************
+!
+! Explicit discretisation of time derivative.
+!
+!******************************************************************************
+!
+! Description:
+! Ddt operator of a volume scalar field.
+! Usage:
+! [type(volumeScalarField)] DphiDt = fvxDdt( [type(volumeScalarField)] phi )
+!
+ use fieldManipulation
+
+ implicit none
+
+ type(volScalarField), intent(in) :: phi
+!
+! > Result
+!
+ type(volScalarField) :: DphiDt
+
+!+-----------------------------------------------------------------------------+
+
+ DphiDt = new_volScalarField( numCells )
+
+ DphiDt%field_name = 'DUDt_field'
+
+ do inp=1,numCells
+
+ if (bdf) then
+
+ apotime=den(inp)*vol(inp)/timestep
+
+ DphiDt%mag(inp) = apotime*( phi(inp) - phio(inp) )
+
+ elseif (bdf2) then
+
+ apotime=den(inp)*vol(inp)/timestep
+
+ DphiDt%mag(inp) = apotime*( 1.5*phi(inp) - 2*phio(inp) + 0.5*phioo(inp) )
+
+ endif
+
+ end do
+
+
+end subroutine
+
+
+
+subroutine fvx_d2dt2_scalar_field
+!
+!******************************************************************************
+!
+! Description:
+! Second order time differentiation for scalar fields.
+!
+!******************************************************************************
+!
+ use types
+ use parameters
+ use geometry
+ use sparse_matrix
+
+ implicit none
+
+ real(dp) :: apotime
+
+ ! spu(1:numCells) = den(1:numCells)*vol(1:numCells)/timestep**2
+ ! su(1:numCells) = den(1:numCells)*vol(1:numCells)/timestep**2 * (2*uo(1:numCells) - uoo(1:numCells))
+
+
+ do inp=1,numCells
+
+ if(bdf) then
+
+ apotime=den(inp)*vol(inp)/timestep**2
+
+ su(inp) = su(inp) + apotime*(2*uo(inp) - uoo(inp))
+
+ spu(inp) = spu(inp) + apotime
+
+ endif
+
+ end do
+
+
+end subroutine
\ No newline at end of file
diff --git a/src/finiteVolume/fvExplicit/fvxDiv.f90 b/src/finiteVolume/fvExplicit/fvxDiv.f90
deleted file mode 100644
index e69de29..0000000
diff --git a/src/finiteVolume/fvExplicit/fvxDivergence.f90 b/src/finiteVolume/fvExplicit/fvxDivergence.f90
new file mode 100644
index 0000000..a5ce087
--- /dev/null
+++ b/src/finiteVolume/fvExplicit/fvxDivergence.f90
@@ -0,0 +1,178 @@
+module fvxDivergence
+!
+! Purpose:
+! Module for explicit operations on discrete tensor fields.
+!
+! Description:
+! Module contains procedures for explicit manipulation of discrete tensor fields based on
+! finite volume computations and integral theorems (e.g. Gauss) of vector calculus.
+! Discrete tensor fields are defined on a given finite volume mesh.
+! That means we are expecting discrete volume/surface scalar/vector/tensor fields.
+! Included operations are:
+! fvxInterpolation (volField -> surfaceField)
+! fvxGrad (volField ->volField)
+! fvxDiv (volField ->volField) or (surfaceField ->volField)
+!
+! Author: Nikola Mirkov
+! This is a part of freeCappuccino.
+! The code is licenced under GPL licence.
+!
+
+use types
+use geometry
+use tensorFields
+use fvxInterpolation
+use fvxGradient, only : grad
+
+implicit none
+
+interface fvxDiv
+ module procedure fvx_div_volVectorField
+ module procedure fvx_div_surfaceVectorField
+end interface
+
+public
+
+contains
+
+
+function fvx_div_volVectorField(U) result(phi)
+!
+! Description:
+! Divergence of a volume vector field.
+! Usage:
+! [type(volumeScalarField)] phi = fvxDiv( [type(volumeVectorField)] U )
+!
+
+ implicit none
+
+ type(volVectorField), intent(in) :: U
+!
+! > Result
+!
+ type(volScalarField) :: phi
+
+!
+! > Local
+!
+ integer :: i,ijp,ijn,ijb,iface
+ real(dp) :: uf,vf,wf,dfxe
+
+ type(volTensorField) :: D
+
+!+-----------------------------------------------------------------------------+
+
+ phi = new_volScalarField( numCells )
+
+ phi%field_name = 'divergence_field'
+
+ phi%mag = 0.0
+
+ D = Grad( U )
+
+ ! Inner faces
+ do i=1,numInnerFaces
+ ijp = owner(i)
+ ijn = neighbour(i)
+
+ ! Value of the variable at cell-face center
+ uf = face_value( ijp, ijn, xf(i), yf(i), zf(i), facint(i), U%x, D%xx, D%xy, D%xz )
+ vf = face_value( ijp, ijn, xf(i), yf(i), zf(i), facint(i), U%y, D%yx, D%yy, D%yz )
+ wf = face_value( ijp, ijn, xf(i), yf(i), zf(i), facint(i), U%z, D%zx, D%zy, D%zz )
+
+ ! (interpolated mid-face value)x(area)
+ dfxe = uf*arx(i) + vf*ary(i) + wf*arz(i)
+
+ ! Accumulate contribution at cell center and neighbour.
+ phi%mag(ijp) = phi%mag(ijp)+dfxe
+ phi%mag(ijn) = phi%mag(ijn)-dfxe
+
+ enddo
+
+
+ ! Contribution from boundaries
+ do i=1,numBoundaryFaces
+ iface = numInnerFaces + i
+ ijp = owner(iface)
+ ijb = numCells + i
+ dfxe = U%x(ijb)*arx(iface)+ U%y(ijb)*ary(iface) + U%z(ijb)*arz(iface)
+ phi%mag(ijp) = phi%mag(ijp) + dfxe
+ enddo
+
+end function fvx_div_volVectorField
+
+
+function fvx_div_surfaceVectorField(U) result(phi)
+!
+! Description:
+! Divergence of a surface vector field.
+! Usage:
+! [type(volumeScalarField)] phi = fvxDiv( [type(surfaceVectorField)] U )
+!
+ implicit none
+
+ type(surfaceVectorField), intent(in) :: U
+!
+! > Result
+!
+ type(volScalarField) :: phi
+
+!
+! > Locals
+!
+ integer :: i,ijb,iface
+ integer :: icell,jcell
+
+ real(dp) :: sfuf
+
+!
+! > Initialize
+!
+ phi = new_volScalarField( numCells )
+
+ phi%field_name = 'divergence_field'
+
+ phi % mag = 0.0_dp
+
+!
+! > Inner faces contribution
+!
+ inner_face_loop: do iface=1,numInnerFaces
+!+-----------------------------------------------------------------------------+
+
+ icell = owner(iface)
+ jcell = neighbour(iface)
+
+ ! Dot face area vector and interpolated vector to face, Sf.(u)_f
+ sfuf = u%x (iface)*arx(iface) + u%y (iface)*ary(iface) + u%z (iface)*arz(iface)
+
+ ! Contribution to owner and neighbour cell
+ phi%mag (icell) = phi%mag (icell) + sfuf
+ phi%mag (jcell) = phi%mag (jcell) - sfuf
+
+!+-----------------------------------------------------------------------------+
+ enddo inner_face_loop
+
+!
+! > Boundary faces contribution
+!
+
+ boundary_face_loop: do i=1,numBoundaryFaces
+!+-----------------------------------------------------------------------------+
+ iface = numInnerFaces + i
+ icell = owner(iface)
+ ijb = numCells + i
+
+ ! Dot face area vector and interpolated vector to face, Sf.(u)_f
+ sfuf = u%x (ijb)*arx(iface) + u%y (ijb)*ary(iface) + u%z (ijb)*arz(iface)
+
+ phi%mag (icell) = phi%mag (icell) + sfuf
+
+!+-----------------------------------------------------------------------------+
+ enddo boundary_face_loop
+
+
+end function fvx_div_surfaceVectorField
+
+
+end module
\ No newline at end of file
diff --git a/src/finiteVolume/fvExplicit/fvxGrad.f90 b/src/finiteVolume/fvExplicit/fvxGrad.f90
deleted file mode 100644
index e69de29..0000000
diff --git a/src/finiteVolume/fvExplicit/fvxGradient.f90 b/src/finiteVolume/fvExplicit/fvxGradient.f90
new file mode 100644
index 0000000..49f055a
--- /dev/null
+++ b/src/finiteVolume/fvExplicit/fvxGradient.f90
@@ -0,0 +1,2084 @@
+module fvxGradient
+!
+! Purpose:
+! Module for explicit operations on discrete tensor fields - Gradient operator.
+!
+! Description:
+! Module contains procedures for explicit manipulation of discrete tensor fields based on
+! finite volume computations and integral theorems (e.g. Gauss) of vector calculus.
+! Discrete tensor fields are defined on a given finite volume mesh.
+! That means we are expecting discrete volume/surface scalar/vector/tensor fields.
+! Included operations are:
+! fvxGrad (volField ->volField)
+!
+! Author: Nikola Mirkov
+! This is a part of freeCappuccino.
+! The code is licenced under GPL licence.
+!
+use types
+use geometry
+use sparse_matrix, only: ioffset,ja,diag
+use tensorFields
+
+implicit none
+
+! Gradient discretization approach
+logical :: lstsq
+logical :: lstsq_qr
+logical :: lstsq_dm
+logical :: gauss
+
+character(len=20) :: limiter ! Gradient limiter. Options: none, Barth-Jespersen, Venkatakrishnan, mVenkatakrishnan
+
+real(dp),dimension(:,:), allocatable :: Dmat ! d(6,nxyz) - when using bn, or dm version of the subroutine
+real(dp),dimension(:,:,:), allocatable :: D ! when using qr version of the subroutine size(3,6,nxyz)!
+
+real(dp), parameter :: small = 1e-20
+real(dp), parameter :: zero = 0.0_dp
+
+interface grad
+ module procedure grad_volScalarField
+ module procedure grad_volVectorField
+end interface
+
+interface sngrad
+ module procedure sngrad_volScalarField
+ module procedure sngrad_VolVectorField
+end interface
+
+
+private
+
+public :: lstsq, lstsq_qr, lstsq_dm, gauss, limiter, &
+ grad, sngrad, grad_gauss, grad_gauss_corrected, grad_scalar_field_w_option, &
+ create_lsq_grad_matrix
+
+
+contains
+
+
+
+function grad_volScalarField(phi) result(dPhi)
+!
+! Description:
+! Computes cell centered gradients of a scalar field.
+! Usage:
+! [type(volVectorField)] dPhi = Grad( [type(volScalarField)] phi)
+!
+
+ implicit none
+
+ type(volScalarField), intent(in) :: phi
+!
+! > Result
+!
+ type(volVectorField) :: dPhi
+
+!+-----------------------------------------------------------------------------+
+
+ dPhi = new_volVectorField( numTotal )
+
+ dPhi%field_name = 'gradient_field'
+
+ call grad_scalar_field( phi%mag, dPhi%x, dPhi%y, dPhi%z )
+
+
+end function grad_volScalarField
+
+
+function grad_volVectorField(U) result(G)
+!
+! Description:
+! Computes cell centered gradients of a scalar field.
+! Usage:
+! [type(volTensorField)] G = Grad( [type(volVectorField)] U)
+!
+
+ implicit none
+
+ type(volVectorField), intent(in) :: U
+!
+! > Result
+!
+ type(volTensorField) :: G
+
+!+-----------------------------------------------------------------------------+
+
+ G = new_volTensorField( numTotal )
+
+ G%field_name = 'gradient_field'
+
+ ! Go trough every vector component
+
+ call grad_scalar_field( U%x, G%xx, G%xy, G%xz )
+ call grad_scalar_field( U%y, G%yx, G%yy, G%yz )
+ call grad_scalar_field( U%z, G%zx, G%zy, G%zz )
+
+end function grad_volVectorField
+
+
+function sngrad_volScalarField(phi) result(sndPhi)
+!
+! Description:
+! Computes cell centered gradients of a scalar field.
+! Usage:
+! [type(volVectorField)] sndPhi = snGrad( [type(volScalarField)] phi)
+!
+
+ implicit none
+
+ type(volScalarField), intent(in) :: phi
+!
+! > Result
+!
+ type(surfaceVectorField) :: sndPhi
+
+!
+! > Locals
+!
+ integer :: i,ijp,ijn,nrelax
+ character(len=12) :: approach
+ real(dp) :: dfixii, dfiyii, dfizii
+ real(dp) :: dfixi, dfiyi, dfizi
+ type(volVectorField) :: dPhi
+
+!+-----------------------------------------------------------------------------+
+
+ sndPhi = new_surfaceVectorField( numTotal )
+
+ sndPhi%field_name = 'gradient_field'
+
+ dPhi = grad_volScalarField( Phi )
+
+ ! Inner faces:
+ do i=1,numInnerFaces
+ ijp = owner(i)
+ ijn = neighbour(i)
+
+ nrelax = 0
+ approach = 'skewness'
+
+ call sngrad_scalar_field(ijp, ijn, xf(i), yf(i), zf(i), arx(i), ary(i), arz(i), facint(i), &
+ phi%mag, dPhi%x, dPhi%y, dPhi%z, nrelax, approach, &
+ dfixi, dfiyi, dfizi, &
+ dfixii, dfiyii, dfizii)
+
+ sndPhi%x(i) = dfixii
+ sndPhi%y(i) = dfiyii
+ sndPhi%z(i) = dfizii
+
+ enddo
+
+ ! Update boundaries...
+
+
+end function sngrad_volScalarField
+
+
+function sngrad_volVectorField(U) result(G)
+!
+! Description:
+! Computes cell centered gradients of a scalar field.
+! Usage:
+! [type(surfaceTensorField)] snG = snGrad( [type(volVectorField)] U)
+!
+
+ implicit none
+
+ type(volVectorField), intent(in) :: U
+!
+! > Result
+!
+ type(surfaceTensorField) :: snG
+!
+! > Local
+!
+ integer :: i,ijp,ijn,nrelax
+ character(len=12) :: approach
+ real(dp) :: dfixii, dfiyii, dfizii
+ real(dp) :: dfixi, dfiyi, dfizi
+ type(volTensorField) :: G
+!+-----------------------------------------------------------------------------+
+
+ snG = new_surfaceTensorField( numTotal )
+
+ snG%field_name = 'surface_grad_field'
+
+ G = grad_volVectorField( U )
+
+ ! Inner faces:
+ do i=1,numInnerFaces
+ ijp = owner(i)
+ ijn = neighbour(i)
+
+ nrelax = 0
+ approach = 'skewness'
+
+ call sngrad_scalar_field( ijp, ijn, xf(i), yf(i), zf(i), arx(i), ary(i), arz(i), facint(i), &
+ U%x, G%xx, G%xy, G%xz, nrelax, approach, &
+ dfixi, dfiyi, dfizi, &
+ dfixii, dfiyii, dfizii )
+
+ snG%xx(i) = dfixii
+ snG%xy(i) = dfiyii
+ snG%xz(i) = dfizii
+
+ call sngrad_scalar_field( ijp, ijn, xf(i), yf(i), zf(i), arx(i), ary(i), arz(i), facint(i), &
+ U%y, G%yx, G%yy, G%yz, nrelax, approach, &
+ dfixi, dfiyi, dfizi, &
+ dfixii, dfiyii, dfizii )
+
+ snG%yx(i) = dfixii
+ snG%yy(i) = dfiyii
+ snG%yz(i) = dfizii
+
+ call sngrad_scalar_field( ijp, ijn, xf(i), yf(i), zf(i), arx(i), ary(i), arz(i), facint(i), &
+ U%z, G%zx, G%zy, G%zz, nrelax, approach, &
+ dfixi, dfiyi, dfizi, &
+ dfixii, dfiyii, dfizii )
+
+ snG%zx(i) = dfixii
+ snG%zy(i) = dfiyii
+ snG%zz(i) = dfizii
+
+ enddo
+
+ ! Update boundaries...
+
+end function sngrad_volVectorField
+
+
+!***********************************************************************
+!
+subroutine create_lsq_grad_matrix
+!
+!***********************************************************************
+!
+! Discussion:
+! Prepare System Matrix For Least-Squares Gradient Calculation.
+! It is done by setting this --v value to one.
+! call grad_lsq(U,dUdxi,1)
+!
+!***********************************************************************
+!
+
+implicit none
+
+
+ call allocate_lsq_grad_matrix
+
+ if (lstsq) then
+
+ call grad_lsq_matrix
+
+ elseif (lstsq_qr) then
+
+ call grad_lsq_qr_matrix
+
+ elseif (lstsq_dm) then
+
+ call grad_lsq_dm_matrix
+
+ endif
+
+end subroutine
+
+
+!***********************************************************************
+!
+subroutine allocate_lsq_grad_matrix
+!
+!***********************************************************************
+!
+implicit none
+
+ integer :: ierr
+
+ if( lstsq .or. lstsq_dm ) then
+
+ allocate( Dmat(9,numCells), stat=ierr )
+ if(ierr /= 0)write(*,*)"allocation error: Dmat"
+
+ elseif( lstsq_qr ) then
+
+ allocate( D(3,6,numCells), stat=ierr )
+ if(ierr /= 0)write(*,*)"allocation error: D"
+
+ endif
+
+end subroutine
+
+
+!***********************************************************************
+!
+subroutine grad_scalar_field(phi,dPhidx,dPhidy,dPhidz)
+!
+!***********************************************************************
+!
+
+implicit none
+
+ real(dp), dimension(numTotal), intent(in) :: phi
+ real(dp), dimension(numTotal), intent(inout) :: dPhidx,dPhidy,dPhidz
+
+ dPhidx = 0.0_dp
+ dPhidy = 0.0_dp
+ dPhidz = 0.0_dp
+
+ if (lstsq) then
+
+ call grad_lsq(phi,dPhidx,dPhidy,dPhidz)
+
+ elseif (lstsq_qr) then
+
+ call grad_lsq_qr(phi,dPhidx,dPhidy,dPhidz)
+
+ elseif (lstsq_dm) then
+
+ call grad_lsq_dm(phi,dPhidx,dPhidy,dPhidz)
+
+ elseif ( lstsq_dm .and. gauss ) then
+
+ call grad_lsq_dm(phi,dPhidx,dPhidy,dPhidz)
+
+ call grad_gauss_corrected(phi,dPhidx,dPhidy,dPhidz)
+
+ else
+
+ call grad_gauss(phi,dPhidx,dPhidy,dPhidz)
+
+ endif
+
+ !
+ ! Gradient limiter:
+ !
+ if( limiter == 'Barth-Jespersen') then
+
+ call slope_limiter_Barth_Jespersen(phi, dPhidx,dPhidy,dPhidz )
+
+ elseif( limiter == 'Venkatakrishnan') then
+
+ call slope_limiter_Venkatakrishnan(phi, dPhidx,dPhidy,dPhidz )
+
+ elseif( limiter == 'mVenkatakrishnan') then
+
+ call slope_limiter_modified_Venkatakrishnan(phi, dPhidx,dPhidy,dPhidz )
+
+ elseif( limiter == 'MDL') then
+
+ call slope_limiter_multidimensional(phi, dPhidx,dPhidy,dPhidz )
+
+ else
+ ! no-limit
+ endif
+
+end subroutine
+
+
+!***********************************************************************
+!
+subroutine grad_scalar_field_w_option(phi,dPhidx,dPhidy,dPhidz,option,option_limiter)
+!
+!***********************************************************************
+!
+! The main reason why we write this subroutine is to correct velocities
+! in SIMPLE algorithm with conservative gradients, which is possible
+! with Gauss rule.
+! We noticed it is better for calculation precision.
+! But calling gradients with option may be nice anyhow.
+!
+!***********************************************************************
+!
+
+implicit none
+
+ real(dp), dimension(numTotal), intent(in) :: phi
+ real(dp), dimension(numTotal), intent(inout) :: dPhidx,dPhidy,dPhidz
+ character( len=* ), intent(in) :: option
+ character( len=* ), intent(in) :: option_limiter
+
+ dPhidx = 0.0_dp
+ dPhidy = 0.0_dp
+ dPhidz = 0.0_dp
+
+ if ( option == 'lsq' ) then
+
+ call grad_lsq(phi, dPhidx,dPhidy,dPhidz )
+
+ elseif ( option == 'lsq_qr' ) then
+
+ call grad_lsq_qr(phi, dPhidx,dPhidy,dPhidz )
+
+ elseif ( option == 'wlsq' ) then
+
+ call grad_lsq_dm(phi, dPhidx,dPhidy,dPhidz )
+
+ elseif ( option == 'gauss_corrected' ) then
+
+ call grad_gauss_corrected(phi, dPhidx,dPhidy,dPhidz )
+
+ elseif ( option == 'gauss' ) then
+
+ call grad_gauss(phi, dPhidx,dPhidy,dPhidz )
+
+ endif
+
+ !
+ ! Gradient limiter:
+ !
+ if( option_limiter == 'Barth-Jespersen') then
+
+ call slope_limiter_Barth_Jespersen(phi, dPhidx,dPhidy,dPhidz )
+
+ elseif( option_limiter == 'Venkatakrishnan') then
+
+ call slope_limiter_Venkatakrishnan(phi, dPhidx,dPhidy,dPhidz )
+
+ elseif( option_limiter == 'mVenkatakrishnan') then
+
+ call slope_limiter_modified_Venkatakrishnan(phi, dPhidx,dPhidy,dPhidz )
+
+ elseif( option_limiter == 'MDL') then
+
+ call slope_limiter_multidimensional(phi, dPhidx,dPhidy,dPhidz )
+
+ else
+ ! no-limit
+ endif
+
+end subroutine
+
+!***********************************************************************
+!
+subroutine slope_limiter_modified_Venkatakrishnan(phi, dPhidx,dPhidy,dPhidz )
+!
+!***********************************************************************
+!
+! Calculates slope limiter and appiies to scalar gradient:
+! Wang modified Venkatakrishnan slope limiter
+! Ref.: Z. J. Wang. "A Fast Nested Multi-grid Viscous Flow Solver for Adaptive Cartesian/Quad Grids",
+! International Journal for Numerical Methods in Fluids. 33. 657–680. 2000.
+! The same slope limiter is used in Fluent.
+!
+!***********************************************************************
+!
+
+ implicit none
+
+ ! Input
+ real(dp),dimension(numTotal), intent(in) :: phi
+ real(dp),dimension(numTotal), intent(inout) :: dPhidx,dPhidy,dPhidz
+
+
+ ! Locals
+ integer :: inp,ijp,ijn,k
+
+ ! Look at the reference epsprim \in [0.01,0.2]
+ real(dp), parameter :: epsprim = 0.01_dp
+
+ real(dp) :: phi_p
+ real(dp) :: cell_neighbour_value,gradfiXdr,slopelimit
+ real(dp) :: deltam,deltap,epsi
+ real(dp) :: phi_max,phi_min
+ real(dp) :: glomax,glomin
+
+
+ glomin = minval(phi(1:numCells))
+ glomax = maxval(phi(1:numCells))
+
+ do inp = 1, numCells
+
+ ! Values at cell center:
+ phi_p = phi(inp)
+
+ ! max and min values over current cell and neighbors
+ phi_max = phi(ja( ioffset(inp) ))
+ phi_min = phi(ja( ioffset(inp) ))
+
+ do k=ioffset(inp)+1, ioffset(inp+1)-1
+ phi_max = max( phi_max, phi(ja(k)) )
+ phi_min = min( phi_max, phi(ja(k)) )
+ enddo
+
+
+ slopelimit = 1.0_dp
+
+ do k=ioffset(inp), ioffset(inp+1)-1
+
+ if (k == diag(inp)) cycle
+
+ ijp = inp
+ ijn = ja(k)
+
+ gradfiXdr=dPhidx(ijp)*(xc(ijn)-xc(ijp))+dPhidy(ijp)*(yc(ijn)-yc(ijp))+dPhidz(ijp)*(zc(ijn)-zc(ijp))
+
+ ! Find unlimited value:
+ cell_neighbour_value = phi_p + gradfiXdr
+
+
+ deltam = cell_neighbour_value - phi_p
+ if (deltam .gt. 0.0d0) then
+ deltap = phi_max-phi_p
+ else
+ deltap = phi_min-phi_p
+ endif
+
+ ! Wang proposition for epsilon
+ epsi = epsprim*( glomax-glomin )
+ slopelimit = max( &
+ min( &
+ slopelimit, &
+ 1./(deltam+small)*((deltap**2+epsi**2)*deltam+2*deltam**2*deltap) &
+ /(deltap**2+2*deltam**2+deltap*deltam+epsi**2+small) &
+ ), &
+ zero &
+ )
+
+ enddo
+
+ dPhidx(inp) = slopelimit*dPhidx(inp)
+ dPhidy(inp) = slopelimit*dPhidy(inp)
+ dPhidz(inp) = slopelimit*dPhidz(inp)
+
+ enddo
+
+end subroutine
+
+
+
+!***********************************************************************
+!
+subroutine slope_limiter_Barth_Jespersen(phi, dPhidx,dPhidy,dPhidz )
+!
+!***********************************************************************
+!
+! Calculates slope limiter and appiies to scalar gradient:
+! Barth and Jespersen slope limiter:
+!
+! AIAA-89-0366, The design and application of upwind schemes
+! on unstructured meshes, T.J.Barth, D.C.Jespersen, 1989.
+!
+!***********************************************************************
+!
+
+ implicit none
+
+ ! Input
+ real(dp),dimension(numTotal), intent(in) :: phi
+ real(dp),dimension(numTotal), intent(inout) :: dPhidx,dPhidy,dPhidz
+
+
+ ! Locals
+ integer :: inp,ijp,ijn,k
+ real(dp) :: phi_p
+ real(dp) :: slopelimit
+ real(dp) :: delta_face
+ real(dp) :: phi_max,phi_min,r
+ real(dp) :: fimax,fimin,deltamax,deltamin
+
+
+ fimin = minval(phi(1:numCells))
+ fimax = maxval(phi(1:numCells))
+
+ do inp = 1, numCells
+
+ ! Values at cell center:
+ phi_p = phi(inp)
+
+ ! max and min values over current cell and neighbors
+ phi_max = phi(ja( ioffset(inp) ))
+ phi_min = phi(ja( ioffset(inp) ))
+
+ do k=ioffset(inp)+1, ioffset(inp+1)-1
+ phi_max = max( phi_max, phi(ja(k)) )
+ phi_min = min( phi_max, phi(ja(k)) )
+ enddo
+
+
+ deltamax = fimax - phi(inp)
+ deltamin = fimin - phi(inp)
+
+ slopelimit = 1.0_dp
+
+ do k=ioffset(inp), ioffset(inp+1)-1
+
+ if (k == diag(inp)) cycle
+
+ ijp = inp
+ ijn = ja(k)
+
+ delta_face=dPhidx(ijp)*(xc(ijn)-xc(ijp))+dPhidy(ijp)*(yc(ijn)-yc(ijp))+dPhidz(ijp)*(zc(ijn)-zc(ijp))
+
+
+ if( abs(delta_face) < 1.e-6 )then
+ r = 1.0_dp
+ else if( delta_face > 0.0 )then
+ r = deltamax/delta_face
+ else
+ r = deltamin/delta_face
+ endif
+
+ slopelimit = min( slopelimit , r )
+
+ enddo
+
+ dPhidx(inp) = slopelimit*dPhidx(inp)
+ dPhidy(inp) = slopelimit*dPhidy(inp)
+ dPhidz(inp) = slopelimit*dPhidz(inp)
+
+ enddo
+
+end subroutine
+
+
+
+
+!***********************************************************************
+!
+subroutine slope_limiter_Venkatakrishnan(phi, dPhidx,dPhidy,dPhidz )
+!
+!***********************************************************************
+!
+! Calculates slope limiter and appiies to scalar gradient:
+! Venkatakrishnan slope limiter:
+!
+! AIAA-93-0880, On the accuracy of limiters and convergence
+! to steady state solutions, V.Venkatakrishnan, 1993
+!
+!***********************************************************************
+!
+
+ implicit none
+
+ ! Input
+ real(dp),dimension(numTotal), intent(in) :: phi
+ real(dp),dimension(numTotal), intent(inout) :: dPhidx,dPhidy,dPhidz
+
+
+ ! Locals
+ integer :: inp,ijp,ijn,k
+ real(dp) :: phi_p
+ real(dp) :: slopelimit
+ real(dp) :: delta_face
+ real(dp) :: phi_max,phi_min,r
+ real(dp) :: fimax,fimin,deltamax,deltamin
+
+
+ fimin = minval(phi(1:numCells))
+ fimax = maxval(phi(1:numCells))
+
+ do inp = 1, numCells
+
+ ! Values at cell center:
+ phi_p = phi(inp)
+
+ ! max and min values over current cell and neighbors
+ phi_max = phi(ja( ioffset(inp) ))
+ phi_min = phi(ja( ioffset(inp) ))
+
+ do k=ioffset(inp)+1, ioffset(inp+1)-1
+ phi_max = max( phi_max, phi(ja(k)) )
+ phi_min = min( phi_max, phi(ja(k)) )
+ enddo
+
+
+ deltamax = fimax - phi(inp)
+ deltamin = fimin - phi(inp)
+
+ slopelimit = 1.0_dp
+
+ do k=ioffset(inp), ioffset(inp+1)-1
+
+ if (k == diag(inp)) cycle
+
+ ijp = inp
+ ijn = ja(k)
+
+ delta_face=dPhidx(ijp)*(xc(ijn)-xc(ijp))+dPhidy(ijp)*(yc(ijn)-yc(ijp))+dPhidz(ijp)*(zc(ijn)-zc(ijp))
+
+
+ if( abs(delta_face) < 1.e-6 )then
+ r = 1.0_dp
+ else if( delta_face > 0.0 )then
+ r = deltamax/delta_face
+ else
+ r = deltamin/delta_face
+ endif
+
+ slopelimit = min( slopelimit , (r**2+2.0*r)/(r**2+r+2.0) )
+
+ enddo
+
+ dPhidx(inp) = slopelimit*dPhidx(inp)
+ dPhidy(inp) = slopelimit*dPhidy(inp)
+ dPhidz(inp) = slopelimit*dPhidz(inp)
+
+ enddo
+
+end subroutine
+
+
+
+!***********************************************************************
+!
+subroutine slope_limiter_multidimensional(phi, dPhidx,dPhidy,dPhidz )
+!
+!***********************************************************************
+!
+! Calculates slope limiter and applies to scalar gradient:
+! Multidimensional slope limiter
+! Ref.: SE Kim, B Makarov, D Caraeni - A Multi-Dimensional Linear
+! Reconstruction Scheme for Arbitrary Unstructured Meshes, AIAA 2003-3990.
+! The same slope limiter is used in Fluent.
+!
+!***********************************************************************
+!
+
+ implicit none
+
+ ! Input
+ real(dp),dimension(numTotal), intent(in) :: phi
+ real(dp),dimension(numTotal), intent(inout) :: dPhidx,dPhidy,dPhidz
+
+
+ ! Locals
+ integer :: inp,ijp,ijn,k
+ real(dp) :: phi_max,phi_min
+ real(dp) :: dPhi,dPhimax,dPhimin
+ real(dp) :: gx,gy,gz
+ real(dp) :: gtx,gty,gtz
+ real(dp) :: gn
+ real(dp) :: xpn,ypn,zpn,dpn
+ real(dp) :: nx,ny,nz
+
+ ! Find phi_max and phi_min in neighbours of Co, including itself.
+ do inp = 1, numCells
+
+ ! max and min values over current cell and neighbors
+ phi_max = phi(ja( ioffset(inp) ))
+ phi_min = phi(ja( ioffset(inp) ))
+
+ do k=ioffset(inp)+1, ioffset(inp+1)-1
+ phi_max = max( phi_max, phi(ja(k)) )
+ phi_min = min( phi_max, phi(ja(k)) )
+ enddo
+
+ ! Initialize gradient vector with current unlimited value
+ gx = dPhidx(inp)
+ gy = dPhidy(inp)
+ gz = dPhidz(inp)
+
+ ! Loop over neighbours, we access info about neighbours using CSR ioffset array..
+ do k=ioffset(inp), ioffset(inp+1)-1
+
+ ! Skip the cell itself, we need only neighbours
+ if (k == diag(inp)) cycle
+
+ ! Present cell - P
+ ijp = inp
+ ! Neighbour cell - N ( we find its index using CSR column array )
+ ijn = ja(k)
+
+ ! Distance vector between cell centers
+ xpn=xc(ijn)-xc(ijp)
+ ypn=yc(ijn)-yc(ijp)
+ zpn=zc(ijn)-zc(ijp)
+
+ ! Distance from P to neighbor N
+ dpn=sqrt(xpn**2+ypn**2+zpn**2)
+
+ nx = xpn/dpn
+ ny = ypn/dpn
+ nz = zpn/dpn
+
+ gn = gx*nx+gy*ny+gz*nz
+
+ gtx = gx - gn*nx
+ gty = gy - gn*ny
+ gtz = gz - gn*nz
+
+ ! Increment from P cell to N cell
+ dPhi=gx*(xc(ijn)-xc(ijp))+gy*(yc(ijn)-yc(ijp))+gz*(zc(ijn)-zc(ijp))
+
+ dPhimax = phi_max-phi(inp)
+
+ dPhimin = phi_min-phi(inp)
+
+ ! Check for overshoots and undershoots and correct accordingly.
+
+ if ( phi_max > phi(inp) .and. dPhi > dPhimax ) then
+
+ gx = gtx + nx*dPhimax
+ gy = gty + ny*dPhimax
+ gz = gtz + nz*dPhimax
+
+ endif
+
+ if ( phi_min < phi(inp) .and. dPhi < dPhimin ) then
+
+ gx = gtx + nx*dPhimin
+ gy = gty + ny*dPhimin
+ gz = gtz + nz*dPhimin
+
+ endif
+
+
+ enddo
+
+ dPhidx(inp) = gx
+ dPhidy(inp) = gy
+ dPhidz(inp) = gz
+
+ enddo
+
+end subroutine
+
+
+
+! Least square gradients
+subroutine grad_lsq_matrix
+!
+!***********************************************************************
+!
+! Purpose:
+! Calculates COEFFICIENT MATRIX for cell-centered gradients using UNWEIGHTED
+! Least-Squares approach.
+! Coefficient matrix should be calculated only once and stored in memory.
+!
+! Description:
+! Approach taken from PhD thesis of Bojan Niceno, TU Delft, 2000.,
+! also in Muzaferija and Gossman JCP paper from 1995.
+!
+!
+!***********************************************************************
+!
+
+ implicit none
+
+ !
+ ! Locals
+ !
+ integer :: i,ijp,ijn,inp,iface
+ real(dp) :: Dx,Dy,Dz
+ real(dp) :: d11,d12,d13,d21,d22,d23,d31,d32,d33,tmp
+!
+!***********************************************************************
+!
+
+ ! Initialize Dmat matrix:
+ Dmat = 0.0_dp
+
+ ! Inner faces:
+ do i=1,numInnerFaces
+ ijp = owner(i)
+ ijn = neighbour(i)
+
+ Dx = xc(ijn)-xc(ijp)
+ Dy = yc(ijn)-yc(ijp)
+ Dz = zc(ijn)-zc(ijp)
+
+ Dmat(1,ijp) = Dmat(1,ijp) + Dx*Dx
+ Dmat(1,ijn) = Dmat(1,ijn) + Dx*Dx
+
+ Dmat(4,ijp) = Dmat(4,ijp) + Dy*Dy
+ Dmat(4,ijn) = Dmat(4,ijn) + Dy*Dy
+
+ Dmat(6,ijp) = Dmat(6,ijp) + Dz*Dz
+ Dmat(6,ijn) = Dmat(6,ijn) + Dz*Dz
+
+ Dmat(2,ijp) = Dmat(2,ijp) + Dx*Dy
+ Dmat(2,ijn) = Dmat(2,ijn) + Dx*Dy
+
+ Dmat(3,ijp) = Dmat(3,ijp) + Dx*Dz
+ Dmat(3,ijn) = Dmat(3,ijn) + Dx*Dz
+
+ Dmat(5,ijp) = Dmat(5,ijp) + Dy*Dz
+ Dmat(5,ijn) = Dmat(5,ijn) + Dy*Dz
+ enddo
+
+
+
+ ! Boundary faces:
+
+ do i=1,numBoundaryFaces
+ iface = numInnerFaces + i
+ ijp = owner(iface)
+
+ Dx = xf(iface)-xc(ijp)
+ Dy = yf(iface)-yc(ijp)
+ Dz = zf(iface)-zc(ijp)
+
+ Dmat(1,ijp) = Dmat(1,ijp) + Dx*Dx
+ Dmat(4,ijp) = Dmat(4,ijp) + Dy*Dy
+ Dmat(6,ijp) = Dmat(6,ijp) + Dz*Dz
+ Dmat(2,ijp) = Dmat(2,ijp) + Dx*Dy
+ Dmat(3,ijp) = Dmat(3,ijp) + Dx*Dz
+ Dmat(5,ijp) = Dmat(5,ijp) + Dy*Dz
+ end do
+
+
+ ! Prepare for storage:
+ do inp=1,numCells
+
+ ! Copy from Coefficient matrix
+ D11 = Dmat(1,inp)
+ D12 = Dmat(2,inp)
+ D13 = Dmat(3,inp)
+
+ D22 = Dmat(4,inp)
+ D23 = Dmat(5,inp)
+ D33 = Dmat(6,inp)
+
+ ! Symmetric part
+ D21 = D12
+ D31 = D13
+ D32 = D23
+
+ ! Denominator used troughout
+ tmp = 1./(d11*d22*d33 - d11*d23*d32 - d12*d21*d33 + d12*d23*d31 + d13*d21*d32 - d13*d22*d31 + small)
+
+ Dmat(1,inp) = (d22*d33 - d23*d32) * tmp
+ Dmat(2,inp) = (d21*d33 - d23*d31) * tmp
+ Dmat(3,inp) = (d21*d32 - d22*d31) * tmp
+
+ Dmat(4,inp) = (d11*d33 - d13*d31) * tmp
+ Dmat(5,inp) = (d12*d33 - d13*d32) * tmp
+ Dmat(6,inp) = (d11*d32 - d12*d31) * tmp
+
+ Dmat(7,inp) = (d12*d23 - d13*d22) * tmp
+ Dmat(8,inp) = (d11*d23 - d13*d21) * tmp
+ Dmat(9,inp) = (d11*d22 - d12*d21) * tmp
+
+ enddo
+
+end subroutine
+
+
+subroutine grad_lsq( Phi, dPhidx,dPhidy,dPhidz )
+!
+!***********************************************************************
+!
+! Purpose:
+! Calculates cell-centered gradients using UNWEIGHTED Least-Squares approach.
+!
+! Description:
+! Approach taken from PhD thesis of Bojan Niceno, TU Delft, 2000.,
+! also in Muzaferija and Gossman JCP paper from 1995.
+!
+! Arguments:
+!
+! Phi - field variable which gradient we look for.
+! dPhidx,dPhidy,dPhidz - cell centered gradient - a three component gradient vector.
+!
+!***********************************************************************
+!
+
+ implicit none
+
+ real(dp),dimension(numTotal), intent(in) :: Phi
+ real(dp),dimension(numTotal), intent(inout) :: dPhidx,dPhidy,dPhidz
+
+ !
+ ! Locals
+ !
+ integer :: i,ijp,ijn,inp,iface
+ real(dp) :: b1,b2,b3
+ real(dp) :: Dx,Dy,Dz
+
+!
+!***********************************************************************
+!
+
+ !
+ ! *** COMMENT: ***
+ ! We want to save space, so we will reuse dPhidx,dPhidy,dPhidz
+ ! to store rhs vectors. These were, in earlier version, denoted
+ ! with 'b1','b2', 'b3' respectively.
+ ! This way it is maybe hardrer to read code but introduces great savings,
+ ! because each of 'b1','b2', 'b3' should be numCells long!
+ !
+
+ ! Initialize rhs vector
+ dPhidx = 0.0_dp
+ dPhidy = 0.0_dp
+ dPhidz = 0.0_dp
+
+ ! Inner faces:
+
+ do i=1,numInnerFaces
+ ijp = owner(i)
+ ijn = neighbour(i)
+
+ Dx = ( xc(ijn)-xc(ijp) ) * ( Phi(ijn)-Phi(ijp) )
+ Dy = ( yc(ijn)-yc(ijp) ) * ( Phi(ijn)-Phi(ijp) )
+ Dz = ( zc(ijn)-zc(ijp) ) * ( Phi(ijn)-Phi(ijp) )
+
+ dPhidx(ijp) = dPhidx(ijp) + Dx
+ dPhidx(ijn) = dPhidx(ijn) + Dx
+
+ dPhidy(ijp) = dPhidy(ijp) + Dy
+ dPhidy(ijn) = dPhidy(ijn) + Dy
+
+ dPhidz(ijp) = dPhidz(ijp) + Dz
+ dPhidz(ijn) = dPhidz(ijn) + Dz
+
+ enddo
+
+ ! Boundary faces:
+
+ do i=1,numBoundaryFaces
+ iface = numInnerFaces + i
+ ijp = owner(iface)
+ ijn = numCells + i
+
+ Dx = (Phi(ijn)-Phi(ijp))*(xf(iface)-xc(ijp))
+ Dy = (Phi(ijn)-Phi(ijp))*(yf(iface)-yc(ijp))
+ Dz = (Phi(ijn)-Phi(ijp))*(zf(iface)-zc(ijp))
+
+ dPhidx(ijp) = dPhidx(ijp) + Dx
+ dPhidy(ijp) = dPhidy(ijp) + Dy
+ dPhidz(ijp) = dPhidz(ijp) + Dz
+
+ enddo
+
+
+ !
+ ! Solve the system A*X = B.
+ !
+
+ do inp=1,numCells
+
+ b1 = dPhidx(inp)
+ b2 = dPhidy(inp)
+ b3 = dPhidz(inp)
+
+ dPhidx(inp) = b1*Dmat(1,inp) - b2*Dmat(2,inp) + b3*Dmat(3,inp)
+ dPhidy(inp) = b1*Dmat(4,inp) - b2*Dmat(5,inp) - b3*Dmat(6,inp)
+ dPhidz(inp) = b1*Dmat(7,inp) - b2*Dmat(8,inp) + b3*Dmat(9,inp)
+
+ enddo
+
+end subroutine
+
+
+! Least square gradients via QR decomposition
+!***********************************************************************
+!
+subroutine grad_lsq_qr_matrix
+!
+!***********************************************************************
+!
+! Purpose:
+! Calculates COEFFICIENT MATRIX for cell-centered gradients using
+! Least-Squares approach.
+!
+! Description:
+! Uses QR decomposition of system matrix via Householder or via
+! Gramm-Schmidt.
+! QR decomposition is precomputed and R^(-1)*Q^T is stored in
+! D array for every cell.
+!
+! Coefficient matrix - should be calculated only once!
+!
+!***********************************************************************
+!
+ use matrix_module
+
+ implicit none
+
+ integer, parameter :: n=3, m=6 ! m is the number of neighbours, e.g. for structured 3D mesh it's 6
+
+ ! Locals
+ integer :: i,l,k,ijp,ijn,inp,iface
+
+ integer, dimension(numCells) :: neighbour_index
+
+ real(dp), dimension(m,n) :: Dtmp
+ real(dp), dimension(n,m) :: Dtmpt
+
+
+ !REAL(dp), DIMENSION(m,n) :: R
+ !REAL(dp), DIMENSION(m,m) :: Q
+ !REAL(dp), DIMENSION(n,n) :: R1
+ !REAL(dp), DIMENSION(n,m) :: Q1t
+
+ INTEGER :: INFO
+ REAL(dp), DIMENSION(n) :: TAU
+ INTEGER, DIMENSION(n) :: WORK
+ REAL(dp), DIMENSION(m) :: v1,v2,v3
+ REAL(dp), DIMENSION(m,m) :: H1,H2,H3,Ieye
+ REAL(dp), DIMENSION(n,n) :: R
+ REAL(dp), DIMENSION(m,m) :: Q
+
+
+!**************************************************************************************************
+! Coefficient matrix - should be calculated only once
+!**************************************************************************************************
+ Dtmp = 0.0d0
+ neighbour_index = 0
+
+ ! Inner faces:
+ do i=1,numInnerFaces
+ ijp = owner(i)
+ ijn = neighbour(i)
+
+ neighbour_index(ijp) = neighbour_index(ijp) + 1
+ l = neighbour_index(ijp)
+ D(1,l,ijp) = xc(ijn)-xc(ijp)
+ D(2,l,ijp) = yc(ijn)-yc(ijp)
+ D(3,l,ijp) = zc(ijn)-zc(ijp)
+
+ neighbour_index(ijn) = neighbour_index(ijn) + 1
+ l = neighbour_index(ijn)
+ D(1,l,ijn) = xc(ijp)-xc(ijn)
+ D(2,l,ijn) = yc(ijp)-yc(ijn)
+ D(3,l,ijn) = zc(ijp)-zc(ijn)
+
+ enddo
+
+ ! Boundary faces:
+
+ do i=1,numBoundaryFaces
+ iface = numInnerFaces + i
+ ijp = owner(iface)
+ ! ijb = numCells + i
+ neighbour_index(ijp) = neighbour_index(ijp) + 1
+ l = neighbour_index(ijp)
+ D(1,l,ijp) = xf(iface)-xc(ijp)
+ D(2,l,ijp) = yf(iface)-yc(ijp)
+ D(3,l,ijp) = zf(iface)-zc(ijp)
+ end do
+
+ ! Form system matrix using QR decomposition:
+
+ ! Cell loop
+
+ do inp=1,numCells
+
+ l = neighbour_index(inp)
+
+ Dtmpt = D(:,:,inp)
+ Dtmp = transpose(Dtmpt)
+
+ !1 ...Decompose A=QR using Householder
+ ! call householder_qr(Dtmp, m, n, Q, R)
+ !2 ...Decompose A=QR using Gram-Schmidt
+ ! call mgs_qr(Dtmp, m, n, Q, R)
+
+ ! Q = transpose(Q)
+ ! Q1t = Q(1:n,1:m) ! NOTE: A=Q1R1 is so-called 'thin QR factorization' - see Golub & Van Loan
+ ! Here Q1 is actually Q1^T a transpose of Q1(thin Q - Q with m-n column stripped off)
+ ! R1 = R(1:n,1:n) ! our Q1 is thin transpose of original Q.
+ ! R1 = inv(R1) ! inv is a function in matrix_module, now works only for 3x3 matrices.
+ ! Q1t = matmul(R1,Q1t) ! this is actually R^(-1)*Q^T - a matrix of size n x m.
+ ! D(:,:,INP) = Q1t ! Store it for later.
+
+ !3....LAPACK routine DGEQRF
+ CALL DGEQRF( l, N, Dtmp, M, TAU, WORK, N, INFO )
+
+ ! Upper triangular matrix R
+ R(1:n,1:n)=Dtmp(1:n,1:n)
+
+ ! Create reflectors
+ !H(i) = I - TAU * v * v'
+ Ieye=eye(l)
+ !v(1:i-1) = 0. and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i)
+ v1(1) = 1.; v1(2:l)=Dtmp(2:l,1)
+ H1 = rank_one_update(Ieye,l,l,v1,v1,-TAU(1))
+ v2(1) = 0.; v2(2) = 1.; v2(3:l)=Dtmp(3:l,2)
+ H2 = rank_one_update(Ieye,l,l,v2,v2,-TAU(2))
+ v3(1:2) = 0.; v3(3) = 1.; v3(4:l)=Dtmp(4:l,3)
+ H3 = rank_one_update(Ieye,l,l,v3,v3,-TAU(3))
+ ! The matrix Q is represented as a product of elementary reflectors H1, H2, ..., Hn
+ Q=matmul(H1,H2)
+ Q=matmul(Q,H3)
+
+ ! Form R_1^(-1)*Q_1^T explicitely:
+ do k=1,neighbour_index(inp)
+ D(1,k,inp) = q(k,1)/r(1,1) - (r(1,2)*q(k,2))/(r(1,1)*r(2,2)) + (q(k,3)*(r(1,2)*r(2,3) - r(1,3)*r(2,2)))/(r(1,1)*r(2,2)*r(3,3))
+ D(2,k,inp) = q(k,2)/r(2,2) - (r(2,3)*q(k,3))/(r(2,2)*r(3,3))
+ D(3,k,inp) = q(k,3)/r(3,3)
+ enddo
+
+ enddo
+
+end subroutine
+
+!***********************************************************************
+!
+subroutine grad_lsq_qr( Phi, dPhidx,dPhidy,dPhidz )
+!
+!***********************************************************************
+!
+! Purpose:
+! Calculates cell-centered gradients using Least-Squares approach.
+!
+! Description:
+! Uses QR decomposition of system matrix via Householder or via
+! Gramm-Schmidt.
+! QR decomposition is precomputed and R^(-1)*Q^T is stored in
+! D array for every cell.
+!
+! Arguments:
+!
+! Phi - field variable
+! dPhidx,dPhidy,dPhidz - cell centered gradient - a three component gradient vector.
+!
+!***********************************************************************
+!
+
+ implicit none
+
+ real(dp), dimension(numTotal), intent(in) :: phi
+ real(dp), dimension(numTotal), intent(inout) :: dPhidx,dPhidy,dPhidz
+
+ ! Locals
+ integer, parameter :: n=3, m=6 ! m is the number of neighbours, e.g. for structured 3D mesh it's 6
+ integer :: i,l,ijp,ijn,inp,iface
+
+ integer, dimension(:), allocatable :: neighbour_index
+ real(dp), dimension(:,:), allocatable :: b
+
+ allocate( neighbour_index(numCells) )
+ allocate( b(m,numCells) )
+
+ ! RHS vector
+ b = 0.0d0
+ neighbour_index = 0
+
+ ! Inner faces:
+ do i=1,numInnerFaces
+ ijp = owner(i)
+ ijn = neighbour(i)
+
+ neighbour_index(ijp) = neighbour_index(ijp) + 1
+ l = neighbour_index(ijp)
+ b(l,ijp) = Phi(ijn)-Phi(ijp)
+
+ neighbour_index(ijn) = neighbour_index(ijn) + 1
+ l = neighbour_index(ijn)
+ b(l,ijn) = Phi(ijp)-Phi(ijn)
+
+ enddo
+
+ ! Boundary faces:
+
+ do i=1,numBoundaryFaces
+ iface = numInnerFaces + i
+ ijp = owner(iface)
+ ijn = numCells + i
+
+ neighbour_index(ijp) = neighbour_index(ijp) + 1
+ l = neighbour_index(ijp)
+ b(l,ijp) = Phi(ijn)-Phi(ijp)
+
+ enddo
+
+! Solve overdetermined system in least-sqare sense
+
+ ! Cell loop
+ do inp=1,numCells
+
+ l = neighbour_index(inp)
+
+ ! ...using precomputed QR factorization and storing R^(-1)*Q^T in D
+ dPhidx(INP) = sum(D(1,1:l,inp)*b(1:l,inp))
+ dPhidy(INP) = sum(D(2,1:l,inp)*b(1:l,inp))
+ dPhidz(INP) = sum(D(3,1:l,inp)*b(1:l,inp))
+
+ enddo
+
+ deallocate( neighbour_index )
+ deallocate( b )
+
+end subroutine
+
+
+! Weighted least square gradients
+subroutine grad_lsq_dm_matrix
+!
+!***********************************************************************
+!
+! Purpose:
+! Calculates COEFFICIENT MATRIX for cell-centered gradients using UNWEIGHTED
+! Least-Squares approach.
+! Coefficient matrix should be calculated only once and stored in memory.
+!
+! Description:
+! Approach taken from a paper:
+! Dimitry Mavriplis, "Revisiting the Least Squares procedure for Gradient Reconstruction on Unstructured Meshes." NASA/CR-2003-212683.
+! Weights based on inverse cell-centers distance is added to improve conditioning of the system matrix for skewed meshes.
+! Reduces storage requirements compared to QR subroutine.
+! System matrix is symmetric and can be solved efficiently using Cholesky decomposition or by matrix inversion.
+!
+!
+!***********************************************************************
+!
+
+ implicit none
+
+ ! Locals
+ integer :: i,ijp,ijn,inp,iface
+
+ real(dp) :: w
+ real(dp) :: Dx,Dy,Dz
+ real(dp) :: d11,d12,d13,d21,d22,d23,d31,d32,d33
+ real(dp) :: tmp
+
+!
+!***********************************************************************
+!
+
+ ! Coefficient matrix - should be calculated only once
+
+ ! Initialize dmat matrix:
+ Dmat = 0.0d0
+
+ ! Inner faces:
+
+ do i=1,numInnerFaces
+ ijp = owner(i)
+
+ !***------------------------------------
+ ijn = neighbour(i)
+
+ w = 1./((xc(ijn)-xc(ijp))**2+(yc(ijn)-yc(ijp))**2+(zc(ijn)-zc(ijp))**2)
+
+ Dx = xc(ijn)-xc(ijp)
+ Dy = yc(ijn)-yc(ijp)
+ Dz = zc(ijn)-zc(ijp)
+
+ Dmat(1,ijp) = Dmat(1,ijp) + w*Dx*Dx
+ Dmat(1,ijn) = Dmat(1,ijn) + w*Dx*Dx
+
+ Dmat(4,ijp) = Dmat(4,ijp) + w*Dy*Dy
+ Dmat(4,ijn) = Dmat(4,ijn) + w*Dy*Dy
+
+ Dmat(6,ijp) = Dmat(6,ijp) + w*Dz*Dz
+ Dmat(6,ijn) = Dmat(6,ijn) + w*Dz*Dz
+
+ Dmat(2,ijp) = Dmat(2,ijp) + w*Dx*Dy
+ Dmat(2,ijn) = Dmat(2,ijn) + w*Dx*Dy
+
+ Dmat(3,ijp) = Dmat(3,ijp) + w*Dx*Dz
+ Dmat(3,ijn) = Dmat(3,ijn) + w*Dx*Dz
+
+ Dmat(5,ijp) = Dmat(5,ijp) + w*Dy*Dz
+ Dmat(5,ijn) = Dmat(5,ijn) + w*Dy*Dz
+ !***------------------------------------
+
+ ! !
+ ! ! **Extended interpolation molecule: neighbours of neighbours**
+ ! !
+ ! nb_loop: do k = ioffset( neighbour(i) ), ioffset( neighbour(i)+1 )-1
+
+ ! ijn = ja(k)
+
+ ! if (ijn == ijp) cycle nb_loop ! nemoj ownera dirati
+
+ ! ! Paznja kada je ja(k) = diag( neighbour(i) ) ijn ce uzeti samog cell_neighboura,
+ ! ! tako da ovaj loop moze uraditi isto sto i gornji, pa je u toj verziji
+ ! ! racunanja gradijenata ovaj loop gore nepotreban. Eto simplifikacije koda...
+
+ ! w = 1./((xc(ijn)-xc(ijp))**2+(yc(ijn)-yc(ijp))**2+(zc(ijn)-zc(ijp))**2)
+
+ ! Dx = xc(ijn)-xc(ijp)
+ ! Dy = yc(ijn)-yc(ijp)
+ ! Dz = zc(ijn)-zc(ijp)
+
+ ! Dmat(1,ijp) = Dmat(1,ijp) + w*Dx*Dx
+ ! Dmat(1,ijn) = Dmat(1,ijn) + w*Dx*Dx
+
+ ! Dmat(4,ijp) = Dmat(4,ijp) + w*Dy*Dy
+ ! Dmat(4,ijn) = Dmat(4,ijn) + w*Dy*Dy
+
+ ! Dmat(6,ijp) = Dmat(6,ijp) + w*Dz*Dz
+ ! Dmat(6,ijn) = Dmat(6,ijn) + w*Dz*Dz
+
+ ! Dmat(2,ijp) = Dmat(2,ijp) + w*Dx*Dy
+ ! Dmat(2,ijn) = Dmat(2,ijn) + w*Dx*Dy
+
+ ! Dmat(3,ijp) = Dmat(3,ijp) + w*Dx*Dz
+ ! Dmat(3,ijn) = Dmat(3,ijn) + w*Dx*Dz
+
+ ! Dmat(5,ijp) = Dmat(5,ijp) + w*Dy*Dz
+ ! Dmat(5,ijn) = Dmat(5,ijn) + w*Dy*Dz
+
+ ! enddo nb_loop
+
+ enddo
+
+
+ ! Boundary faces:
+
+ do i=1,numBoundaryFaces
+ iface = numInnerFaces + i
+ ijp = owner(iface)
+
+ w = 1.0_dp/((xf(iface)-xc(ijp))**2+(yf(iface)-yc(ijp))**2+(zf(iface)-zc(ijp))**2)
+
+ Dx = xf(iface)-xc(ijp)
+ Dy = yf(iface)-yc(ijp)
+ Dz = zf(iface)-zc(ijp)
+
+ Dmat(1,ijp) = Dmat(1,ijp) + w*Dx*Dx
+ Dmat(4,ijp) = Dmat(4,ijp) + w*Dy*Dy
+ Dmat(6,ijp) = Dmat(6,ijp) + w*Dz*Dz
+ Dmat(2,ijp) = Dmat(2,ijp) + w*Dx*Dy
+ Dmat(3,ijp) = Dmat(3,ijp) + w*Dx*Dz
+ Dmat(5,ijp) = Dmat(5,ijp) + w*Dy*Dz
+ end do
+
+
+ ! Prepare for storage:
+ do inp=1,numCells
+
+ ! Copy from Coefficient matrix
+ D11 = Dmat(1,inp)
+ D12 = Dmat(2,inp)
+ D13 = Dmat(3,inp)
+
+ D22 = Dmat(4,inp)
+ D23 = Dmat(5,inp)
+ D33 = Dmat(6,inp)
+
+ ! Symmetric part
+ D21 = D12
+ D31 = D13
+ D32 = D23
+
+ ! Denominator used troughout
+ tmp = 1./(d11*d22*d33 - d11*d23*d32 - d12*d21*d33 + d12*d23*d31 + d13*d21*d32 - d13*d22*d31 + small)
+
+ Dmat(1,inp) = (d22*d33 - d23*d32) * tmp
+ Dmat(2,inp) = (d21*d33 - d23*d31) * tmp
+ Dmat(3,inp) = (d21*d32 - d22*d31) * tmp
+
+ Dmat(4,inp) = (d11*d33 - d13*d31) * tmp
+ Dmat(5,inp) = (d12*d33 - d13*d32) * tmp
+ Dmat(6,inp) = (d11*d32 - d12*d31) * tmp
+
+ Dmat(7,inp) = (d12*d23 - d13*d22) * tmp
+ Dmat(8,inp) = (d11*d23 - d13*d21) * tmp
+ Dmat(9,inp) = (d11*d22 - d12*d21) * tmp
+
+ enddo
+
+end subroutine
+
+
+subroutine grad_lsq_dm( Phi, dPhidx,dPhidy,dPhidz )
+!
+!***********************************************************************
+!
+! Purpose:
+! Calculates cell-centered gradients using WEIGHTED Least-Squares approach.
+!
+! Description:
+! Approach taken from a paper:
+! Dimitry Mavriplis, "Revisiting the Least Squares procedure for Gradient Reconstruction on Unstructured Meshes." NASA/CR-2003-212683.
+! Weights based on inverse cell-centers distance is added to improve conditioning of the system matrix for skewed meshes.
+! Reduces storage requirements compared to QR subroutine.
+! System matrix is symmetric and can be solved efficiently using Cholesky decomposition or by matrix inversion.
+!
+! Arguments:
+! Phi - field variable which gradient we look for.
+! dPhidx, dPhidy, dPhidz - cell centered gradient - a three component gradient vector.
+!
+!***********************************************************************
+!
+
+
+ implicit none
+
+ real(dp),dimension(numTotal), intent(in) :: Phi
+ real(dp),dimension(numTotal), intent(inout) :: dPhidx,dPhidy,dPhidz
+
+ ! Locals
+ integer :: i,ijp,ijn,inp,iface
+
+ real(dp) :: w
+ real(dp) :: Dx,Dy,Dz
+ real(dp) :: b1,b2,b3
+!
+!***********************************************************************
+!
+ !
+ ! *** COMMENT: ***
+ ! We want to save space, so we will reuse dPhidx,dPhidy,dPhidz
+ ! to store rhs vectors. These were, in earlier version, denoted
+ ! with 'b1','b2', 'b3' respectively.
+ ! This way it is maybe hardrer to read code but introduces great savings,
+ ! because each of 'b1','b2', 'b3' should be numCells long!
+ !
+
+ ! Initialize rhs vector
+ dPhidx = 0.0_dp
+ dPhidy = 0.0_dp
+ dPhidz = 0.0_dp
+
+ ! Inner faces:
+
+ do i=1,numInnerFaces
+ ijp = owner(i)
+
+ !***------------------------------------
+ ijn = neighbour(i)
+
+ w = 1./((xc(ijn)-xc(ijp))**2+(yc(ijn)-yc(ijp))**2+(zc(ijn)-zc(ijp))**2)
+
+ Dx = w * ( xc(ijn)-xc(ijp) ) * ( Phi(ijn)-Phi(ijp) )
+ Dy = w * ( yc(ijn)-yc(ijp) ) * ( Phi(ijn)-Phi(ijp) )
+ Dz = w * ( zc(ijn)-zc(ijp) ) * ( Phi(ijn)-Phi(ijp) )
+
+ dPhidx(ijp) = dPhidx(ijp) + Dx
+ dPhidx(ijn) = dPhidx(ijn) + Dx
+
+ dPhidy(ijp) = dPhidy(ijp) + Dy
+ dPhidy(ijn) = dPhidy(ijn) + Dy
+
+ dPhidz(ijp) = dPhidz(ijp) + Dz
+ dPhidz(ijn) = dPhidz(ijn) + Dz
+
+ !***------------------------------------
+
+ ! !
+ ! ! **Extended interpolation molecule: neighbours of neighbours**
+ ! !
+ ! nb_loop2: do k = ioffset( neighbour(i) ), ioffset( neighbour(i)+1 )-1
+
+ ! ijn = ja(k)
+
+ ! if (ijn == ijp) cycle nb_loop2 ! nemoj ownera dirati
+
+ ! ! Paznja kada je ja(k) = diag( neighbour(i) ) ijn ce uzeti samo cell_neighboura,
+ ! ! tako da ovaj loop moze uraditi isto sto i gornji, pa je u toj verziji
+ ! ! racunanja gradijenata ovaj loop gore nepotreban. Eto simplifikacije koda...
+
+ ! w = 1./((xc(ijn)-xc(ijp))**2+(yc(ijn)-yc(ijp))**2+(zc(ijn)-zc(ijp))**2)
+
+ ! Dx = w * ( xc(ijn)-xc(ijp) ) * ( Phi(ijn)-Phi(ijp) )
+ ! Dy = w * ( yc(ijn)-yc(ijp) ) * ( Phi(ijn)-Phi(ijp) )
+ ! Dz = w * ( zc(ijn)-zc(ijp) ) * ( Phi(ijn)-Phi(ijp) )
+
+ ! dPhidx(ijp) = dPhidx(ijp) + Dx
+ ! dPhidx(ijn) = dPhidx(ijn) + Dx
+
+ ! b2(ijp) = b2(ijp) + Dy
+ ! b2(ijn) = b2(ijn) + Dy
+
+ ! b3(ijp) = b3(ijp) + Dz
+ ! b3(ijn) = b3(ijn) + Dz
+
+ ! enddo nb_loop2
+
+ enddo
+
+
+ ! Boundary faces:
+
+ do i=1,numBoundaryFaces
+ iface = numInnerFaces + i
+ ijp = owner(iface)
+ ijn = numCells+i
+
+ w = 1./((xf(i)-xc(ijp))**2+(yf(i)-yc(ijp))**2+(zf(i)-zc(ijp))**2)
+
+ Dx = w*(Phi(ijn)-Phi(ijp))*(xf(iface)-xc(ijp))
+ Dy = w*(Phi(ijn)-Phi(ijp))*(yf(iface)-yc(ijp))
+ Dz = w*(Phi(ijn)-Phi(ijp))*(zf(iface)-zc(ijp))
+
+ dPhidx(ijp) = dPhidx(ijp) + Dx
+ dPhidy(ijp) = dPhidy(ijp) + Dy
+ dPhidz(ijp) = dPhidz(ijp) + Dz
+
+
+ end do
+
+ ! Calculate gradient
+
+ do inp=1,numCells
+
+ b1 = dPhidx(inp)
+ b2 = dPhidy(inp)
+ b3 = dPhidz(inp)
+
+ dPhidx(inp) = b1*Dmat(1,inp) - b2*Dmat(2,inp) + b3*Dmat(3,inp)
+ dPhidy(inp) = b1*Dmat(4,inp) - b2*Dmat(5,inp) - b3*Dmat(6,inp)
+ dPhidz(inp) = b1*Dmat(7,inp) - b2*Dmat(8,inp) + b3*Dmat(9,inp)
+
+ enddo
+
+
+end subroutine
+
+
+! Gauss gradients
+subroutine grad_gauss(u,dUdx,dUdy,dUdz)
+!
+!***********************************************************************
+!
+! Purpose:
+! Calculates cell centered gradient using Gauss theorem.
+! Parameters:
+! u - field, the gradient of which we are looking for
+! dUdx,dUdy,dUdz - arrays where the gradient components are stored
+!
+! gauss gradient rule:
+! -------> ->
+! grad(u) = 1/vol * sum_{i=1}^{i=nf} (u)_f*sf
+! where:
+! grad(u) - cell centered gradient vector
+! (u)_f - face interpolated value of scalar u
+! vol - cell volume
+! sf - cell face area vector
+! nf - number of faces in a cell
+!
+!***********************************************************************
+!
+
+ implicit none
+
+ ! Arguments
+ real(dp), dimension(numTotal), intent(in) :: u
+ real(dp), dimension(numTotal), intent(inout) :: dUdx,dUdy,dUdz
+
+ ! Local
+ integer :: i,ijp,ijn,ijb,lc,iface
+ real(dp) :: volr,dfxe, dfye, dfze
+ real(dp), dimension(:), allocatable :: dfxo,dfyo,dfzo
+
+
+ allocate( dfxo(numCells) )
+ allocate( dfyo(numCells) )
+ allocate( dfzo(numCells) )
+
+ ! Initialize
+ dfxo = 0.0_dp
+ dfyo = 0.0_dp
+ dfzo = 0.0_dp
+
+
+ ! Start iterative calculation of gradients
+ do lc = 1,2
+
+ ! Initialize new gradient
+ dUdx = 0.0_dp
+ dUdy = 0.0_dp
+ dUdz = 0.0_dp
+
+ ! Calculate terms integrated over surfaces
+
+ ! Inner face
+ do i=1,numInnerFaces
+ ijp = owner(i)
+ ijn = neighbour(i)
+
+ call gradco(ijp, ijn, xf(i), yf(i), zf(i), arx(i), ary(i), arz(i), facint(i), &
+ u, dfxo, dfyo, dfzo, dfxe, dfye, dfze)
+
+ ! Accumulate contribution at cell center and neighbour
+ dudx(ijp) = dudx(ijp) + dfxe
+ dudy(ijp) = dudy(ijp) + dfye
+ dudz(ijp) = dudz(ijp) + dfze
+
+ dudx(ijn) = dudx(ijn) - dfxe
+ dudy(ijn) = dudy(ijn) - dfye
+ dudz(ijn) = dudz(ijn) - dfze
+
+ enddo
+
+ ! Contribution from boundaries
+
+ do i=1,numBoundaryFaces
+ iface = numInnerFaces + i
+ ijp = owner(iface)
+ ijb = numCells + i
+
+ call gradbc( arx(iface), ary(iface), arz(iface), u(ijb), dudx(ijp), dudy(ijp), dudz(ijp) )
+
+ enddo
+
+
+ ! Calculate gradient components at cv-centers
+ do ijp=1,numCells
+
+ volr = 1.0_dp/vol(ijp)
+
+ dudx(ijp) = dudx(ijp)*volr
+ dudy(ijp) = dudy(ijp)*volr
+ dudz(ijp) = dudz(ijp)*volr
+
+ enddo
+
+ ! Set old gradient = new gradient for the next iteration
+ if(lc.lt.2) then
+ dfxo = dudx(1:numCells)
+ dfyo = dudy(1:numCells)
+ dfzo = dudz(1:numCells)
+ endif
+
+ enddo ! lc-loop
+
+ deallocate( dfxo )
+ deallocate( dfyo )
+ deallocate( dfzo )
+
+end subroutine
+
+
+
+! Corrected Gauss gradients
+subroutine grad_gauss_corrected(u,dudx,dudy,dudz)
+!
+!***********************************************************************
+!
+! Purpose:
+! Calculates cell centered gradient using Gauss theorem.
+! Parameters:
+! u - field, the gradient of which we are looking for
+! dudx - arrays where the gradient components are stored
+!
+! Gauss gradient rule:
+! -------> ->
+! grad(u) = 1/vol * sum_{i=1}^{i=nf} (u)_f*sf
+! where:
+! grad(u) - cell centered gradient vector
+! (u)_f - face interpolated value of scalar u
+! vol - cell volume
+! sf - cell face area vector
+! nf - number of faces in a cell
+!
+!***********************************************************************
+!
+ use types
+ use geometry
+
+ implicit none
+
+ ! Arguments
+ real(dp), dimension(numTotal), intent(in) :: u
+ real(dp), dimension(numTotal), intent(inout) :: dudx,dudy,dudz
+
+ ! Local
+ integer :: i,ijp,ijn,ijb,iface
+ real(dp) :: volr,dfxe, dfye, dfze
+ real(dp), dimension(:), allocatable :: dfxo,dfyo,dfzo
+
+
+ allocate( dfxo(numCells) )
+ allocate( dfyo(numCells) )
+ allocate( dfzo(numCells) )
+
+ ! Initialize gradient with lsq gradient
+ dfxo = dudx(1:numCells)
+ dfyo = dudy(1:numCells)
+ dfzo = dudz(1:numCells)
+
+ ! Initialize new gradient
+ dUdx = 0.0_dp
+ dUdy = 0.0_dp
+ dUdz = 0.0_dp
+
+ ! Calculate terms integrated over surfaces
+
+ ! Inner face
+ do i=1,numInnerFaces
+ ijp = owner(i)
+ ijn = neighbour(i)
+
+ call gradco(ijp, ijn, xf(i), yf(i), zf(i), arx(i), ary(i), arz(i), facint(i), &
+ u, dfxo, dfyo, dfzo, dfxe, dfye, dfze)
+
+ ! Accumulate contribution at cell center and neighbour
+ dudx(ijp) = dudx(ijp) + dfxe
+ dudy(ijp) = dudy(ijp) + dfye
+ dudz(ijp) = dudz(ijp) + dfze
+
+ dudx(ijn) = dudx(ijn) - dfxe
+ dudy(ijn) = dudy(ijn) - dfye
+ dudz(ijn) = dudz(ijn) - dfze
+
+ enddo
+
+ ! Contribution from boundaries
+ do i=1,numBoundaryFaces
+ iface = numInnerFaces + i
+ ijp = owner(iface)
+ ijb = numCells + i
+
+ call gradbc( arx(iface), ary(iface), arz(iface), u(ijb), dudx(ijp), dudy(ijp), dudz(ijp) )
+
+ enddo
+
+
+ ! Calculate gradient components at cv-centers
+ do ijp=1,numCells
+
+ volr = 1.0_dp/vol(ijp)
+
+ dudx(ijp) = dudx(ijp)*volr
+ dudy(ijp) = dudy(ijp)*volr
+ dudz(ijp) = dudz(ijp)*volr
+
+ enddo
+
+end subroutine
+
+
+subroutine gradco(ijp,ijn, &
+ xfc,yfc,zfc,sx,sy,sz,fif, &
+ fi,dfxo,dfyo,dfzo,dfxe,dfye,dfze)
+!
+!***********************************************************************
+!
+! This routine calculates contribution to the gradient
+! vector of a scalar FI at the CV center, arising from
+! an inner cell face (cell-face value of FI times the
+! corresponding component of the surface vector).
+!
+!***********************************************************************
+!
+ use types
+ use parameters
+ use geometry
+
+ implicit none
+
+ integer, intent(in) :: ijp,ijn
+ real(dp), intent(in) :: xfc,yfc,zfc
+ real(dp), intent(in) :: sx,sy,sz
+ real(dp), intent(in) :: fif
+ real(dp), dimension(numTotal), intent(in) :: fi
+ real(dp), dimension(numCells), intent(in) :: dfxo,dfyo,dfzo
+ real(dp), intent(out) :: dfxe,dfye,dfze
+
+
+ real(dp) :: xi,yi,zi
+ real(dp) :: dfxi,dfyi,dfzi
+ real(dp) :: fie
+ real(dp) :: fxn,fxp
+
+ !
+ ! Coordinates of point on the line connecting center and neighbor,
+ ! old gradient vector components interpolated for this location.
+
+ fxn = fif
+ fxp = 1.0d0-fxn
+
+ xi = xc(ijp)*fxp+xc(ijn)*fxn
+ yi = yc(ijp)*fxp+yc(ijn)*fxn
+ zi = zc(ijp)*fxp+zc(ijn)*fxn
+
+ dfxi = dfxo(ijp)*fxp+dfxo(ijn)*fxn
+ dfyi = dfyo(ijp)*fxp+dfyo(ijn)*fxn
+ dfzi = dfzo(ijp)*fxp+dfzo(ijn)*fxn
+
+ ! Value of the variable at cell-face center
+ fie = fi(ijp)*fxp+fi(ijn)*fxn + dfxi*(xfc-xi)+dfyi*(yfc-yi)+dfzi*(zfc-zi)
+
+ ! (interpolated mid-face value)x(area)
+ dfxe = fie*sx
+ dfye = fie*sy
+ dfze = fie*sz
+
+end subroutine
+
+subroutine gradbc(sx,sy,sz,fi,dfx,dfy,dfz)
+!***********************************************************************
+!
+! This routine calculates the contribution of a
+! boundary cell face to the gradient at CV-center.
+!
+!***********************************************************************
+ use types
+
+ implicit none
+
+ real(dp), intent(in) :: sx,sy,sz
+ real(dp), intent(in) :: fi
+ real(dp), intent(inout) :: dfx,dfy,dfz
+
+ dfx = dfx + fi*sx
+ dfy = dfy + fi*sy
+ dfz = dfz + fi*sz
+
+end subroutine
+
+
+!******************************************************************************
+!
+subroutine sngrad_scalar_field(ijp, ijn, xf, yf, zf, arx, ary, arz, lambda, &
+ Phi, dPhidx, dPhidy, dPhidz, nrelax, approach, &
+ dfixi, dfiyi, dfizi, &
+ dfixii, dfiyii, dfizii)
+!
+!******************************************************************************
+!
+! Surface normal gradient with non-orthogonal correction done in two
+! possible ways - either by skewness correction of intersection point
+! offset.
+!
+! Check out reference paper:
+! Mirkov, Rasuo, Kenjeres, JCP, Vol. 287, 2015.
+!
+!******************************************************************************
+!
+ implicit none
+
+ integer, intent(in) :: ijp, ijn
+ real(dp), intent(in) :: xf,yf,zf
+ real(dp), intent(in) :: arx, ary, arz
+ real(dp), intent(in) :: lambda
+ real(dp), dimension(numTotal), intent(in) :: Phi
+ real(dp), dimension(numTotal), intent(in) :: dPhidx,dPhidy,dPhidz
+ integer, intent(in) :: nrelax
+ character(len=12) :: approach
+ real(dp), intent(out) :: dfixi, dfiyi, dfizi, dfixii, dfiyii, dfizii
+!
+! Locals
+!
+ real(dp) :: are,vole
+ real(dp) :: xpn,ypn,zpn
+ real(dp) :: nxx,nyy,nzz
+ real(dp) :: ixi1,ixi2,ixi3
+ real(dp) :: dpn,costheta,costn
+
+ real(dp) :: d1x,d1y,d1z
+ real(dp) :: d2x,d2y,d2z
+ real(dp) :: fxp,fxn
+
+ real(dp) :: xpp,ypp,zpp,xep,yep,zep,xpnp,ypnp,zpnp,volep
+ real(dp) :: nablaFIxdnnp,nablaFIxdppp
+
+
+ ! > Geometry:
+
+ ! Face interpolation factor
+ fxn=lambda
+ fxp=1.0_dp-lambda
+
+ ! Distance vector between cell centers
+ xpn=xc(ijn)-xc(ijp)
+ ypn=yc(ijn)-yc(ijp)
+ zpn=zc(ijn)-zc(ijp)
+
+ ! Distance from P to neighbor N
+ dpn=sqrt(xpn**2+ypn**2+zpn**2)
+
+ ! cell face area
+ are=sqrt(arx**2+ary**2+arz**2)
+
+ ! Components of the unit vector i_ksi
+ ixi1=xpn/dpn
+ ixi2=ypn/dpn
+ ixi3=zpn/dpn
+
+ ! Unit vectors of the face normal
+ nxx=arx/are
+ nyy=ary/are
+ nzz=arz/are
+
+ ! Angle between vectorsa n and i_xi - we need cosine
+ costheta=nxx*ixi1+nyy*ixi2+nzz*ixi3
+
+ ! Relaxation factor for higher-order cell face gradient
+ ! In general, nrelax can be any signed integer from some
+ ! reasonable interval [-nrelax,nrelax] (or maybe even real number):
+ !costn = costheta**nrelax
+
+ costn = 1.0_dp
+
+ if(nrelax == 1) then
+ ! Minimal correction: nrelax = +1 :
+ costn = costheta
+ elseif(nrelax == 0) then
+ ! Orthogonal correction: nrelax = 0 :
+ costn = 1.0_dp
+ elseif(nrelax == -1) then
+ ! Over-relaxed approach: nrelax = -1 :
+ costn = 1.0_dp/costheta
+ endif
+
+ ! dpp_j * sf
+ vole=xpn*arx+ypn*ary+zpn*arz
+
+
+ ! Interpolate gradients defined at CV centers to faces
+ dfixi = dPhidx(ijp)*fxp+dPhidx(ijn)*fxn
+ dfiyi = dPhidy(ijp)*fxp+dPhidy(ijn)*fxn
+ dfizi = dPhidz(ijp)*fxp+dPhidz(ijn)*fxn
+
+
+ !-- Skewness correction -->
+ if (adjustl(approach) == 'skewness') then
+
+ ! Overrelaxed correction vector d2, where s=dpn+d2
+ d1x = costn
+ d1y = costn
+ d1z = costn
+
+ d2x = xpn*costn
+ d2y = ypn*costn
+ d2z = zpn*costn
+
+ !.....du/dx_i interpolated at cell face:
+ dfixii = dfixi*d1x + arx/vole*( Phi(ijn)-Phi(ijp)-dfixi*d2x-dfiyi*d2y-dfizi*d2z )
+ dfiyii = dfiyi*d1y + ary/vole*( Phi(ijn)-Phi(ijp)-dfixi*d2x-dfiyi*d2y-dfizi*d2z )
+ dfizii = dfizi*d1z + arz/vole*( Phi(ijn)-Phi(ijp)-dfixi*d2x-dfiyi*d2y-dfizi*d2z )
+
+ ! |-- Intersection point offset and skewness correction -->
+
+
+ elseif (adjustl(approach) == 'offset') then
+
+ ! Find points P' and Pj'
+ xpp=xf-(xf-xc(ijp))*nxx
+ ypp=yf-(yf-yc(ijp))*nyy
+ zpp=zf-(zf-zc(ijp))*nzz
+
+ xep=xf-(xf-xc(ijn))*nxx
+ yep=yf-(yf-yc(ijn))*nyy
+ zep=zf-(zf-zc(ijn))*nzz
+
+ xpnp = xep-xpp
+ ypnp = yep-ypp
+ zpnp = zep-zpp
+
+ volep = arx*xpnp+ary*ypnp+arz*zpnp
+
+ ! Overrelaxed correction vector d2, where S=dpn+d2
+ d1x = costn
+ d1y = costn
+ d1z = costn
+
+ xpnp = xpnp*costn
+ ypnp = ypnp*costn
+ zpnp = zpnp*costn
+
+ ! The cell face interpolated gradient (d phi / dx_i)_j:
+ ! Nonorthogonal corrections: ___
+ ! nablaFIxdnnp =>> dot_product(dFidxi,dNN')
+ ! And: ___
+ ! nablaFIxdnnp =>> dot_product(dFidxi,dPP')
+ nablaFIxdnnp = dPhidx(ijn)*(xep-xc(ijn))+dPhidy(ijn)*(yep-yc(ijn))+dPhidz(ijn)*(zep-zc(ijn))
+ nablaFIxdppp = dPhidx(ijp)*(xpp-xc(ijp))+dPhidy(ijp)*(ypp-yc(ijp))+dPhidz(ijp)*(zpp-zc(ijp))
+
+ dfixii = dfixi*d1x + arx/volep*( Phi(ijn)+nablaFIxdnnp-Phi(ijp)-nablaFixdppp-dfixi*xpnp-dfiyi*ypnp-dfizi*zpnp )
+ dfiyii = dfiyi*d1y + ary/volep*( Phi(ijn)+nablaFIxdnnp-Phi(ijp)-nablaFixdppp-dfixi*xpnp-dfiyi*ypnp-dfizi*zpnp )
+ dfizii = dfizi*d1z + arz/volep*( Phi(ijn)+nablaFIxdnnp-Phi(ijp)-nablaFixdppp-dfixi*xpnp-dfiyi*ypnp-dfizi*zpnp )
+
+ !-- Uncorrected -->
+ elseif (adjustl(approach) == 'uncorrected') then
+
+ dfixii = dfixi
+ dfiyii = dfiyi
+ dfizii = dfizi
+
+ endif
+
+
+end subroutine
+
+
+end module
\ No newline at end of file
diff --git a/src/finiteVolume/fvExplicit/fvxInterpolation.f90 b/src/finiteVolume/fvExplicit/fvxInterpolation.f90
new file mode 100644
index 0000000..ca2724e
--- /dev/null
+++ b/src/finiteVolume/fvExplicit/fvxInterpolation.f90
@@ -0,0 +1,326 @@
+module fvxInterpolation
+!
+! Purpose:
+! Module for explicit operations on discrete tensor fields - Interpolation operator.
+!
+! Description:
+! Module contains procedures for explicit manipulation of discrete tensor fields based on
+! finite volume computations and integral theorems (e.g. Gauss) of vector calculus.
+! Discrete tensor fields are defined on a given finite volume mesh.
+! That means we are expecting discrete volume/surface scalar/vector/tensor fields.
+! Included operations are:
+! fvxInterpolation (volField -> surfaceField)
+!
+! Author: Nikola Mirkov
+! This is a part of freeCappuccino.
+! The code is licenced under GPL licence.
+!
+ use tensorFields
+ use geometry
+ use fvxGradient, only: grad,grad_scalar_field_w_option
+
+ implicit none
+
+ ! The inerpolations that we do for e.g. divergence is hardcoded here
+ ! I think it is the best thing to choose the best working thing.
+ ! Recommended are: 'central', 'cds', 'cdscorr'
+ character(len=10), parameter :: interpolation_scheme = 'cds'
+
+ interface fvxInterpolate
+ module procedure fvxInterpolateScalar
+ module procedure fvxInterpolateVector
+ end interface
+
+ public fvxInterpolate
+
+ contains
+
+function fvxInterpolateScalar(phi) result(psi)
+!
+! Description:
+! Creates surfaceScalarField from volScalarField by linear interpolation.
+! Usage:
+! [type(surfaceScalarField)] psi = fvxInterpolate ( [type(volScalarField)] phi )
+!
+ use fieldManipulation
+
+ implicit none
+
+ type(volScalarField), intent(in) :: phi
+!
+! > Result
+!
+ type(surfaceScalarField) :: psi
+
+!
+! > Local
+!
+ type(volVectorField) :: dU
+
+ integer :: i,ijp,ijn,ijb,iface
+
+!+-----------------------------------------------------------------------------+
+
+ psi = new_surfaceScalarField( numFaces )
+
+ psi%field_name = 'interpolated_field'
+
+ ! Calculate cell-centered gradient
+ dU = Grad( phi )
+
+ ! Interpolate to face
+
+ ! Inner face
+ do i=1,numInnerFaces
+ ijp = owner(i)
+ ijn = neighbour(i)
+ psi%mag (i) = face_value( ijp, ijn, xf(i), yf(i), zf(i), facint(i), phi%mag(i), dU%x, dU%y, dU%z )
+ enddo
+
+ ! Contribution from boundaries
+ do i=1,numBoundaryFaces
+ iface = numInnerFaces + i
+ ijb = numCells + i
+ psi%mag(iface) = phi%mag(ijb)
+ enddo
+
+end function fvxInterpolateScalar
+
+
+
+function fvxInterpolateVector(U) result(psi)
+!
+! Description:
+! Creates surfaceVectorField from volVectorField by linear interpolation.
+! Usage:
+! [type(surfaceVectorField)] psi = fvxInterpolate ( [type(volVectorField)] U )
+!
+ use fieldManipulation
+
+ implicit none
+
+ type(volVectorField), intent(in) :: U
+!
+! > Result
+!
+ type(surfaceVectorField) :: psi
+!
+! > Locals
+!
+ type(volVectorField) :: dU
+
+ integer :: i,ijp,ijn,ijb,iface
+
+!+-----------------------------------------------------------------------------+
+
+ psi = new_surfaceVectorField( numFaces )
+
+ psi%field_name = 'interpolated_field'
+
+ ! Calculate cell-centered gradient
+ dU = new_volVectorField(numTotal)
+
+ ! Calculate gradient
+ call grad_scalar_field_w_option( U%x, dU%x, dU%y, dU%z, 'gauss', 'no-limit' )
+
+ ! Interpolate to face
+
+ ! Inner face
+ do i=1,numInnerFaces
+ ijp = owner(i)
+ ijn = neighbour(i)
+ psi%x (i) = face_value( ijp, ijn, xf(i), yf(i), zf(i), facint(i), U%x, dU%x, dU%y, dU%z )
+ enddo
+
+ ! Contribution from boundaries
+ do i=1,numBoundaryFaces
+ iface = numInnerFaces + i
+ ijb = numCells + i
+ psi%x (iface) = U%x(ijb)
+ enddo
+
+
+ ! Calculate cell-centered gradient
+ call grad_scalar_field_w_option( U%y, dU%x, dU%y, dU%z, 'gauss', 'no-limit' )
+
+ ! Interpolate to face
+
+ ! Inner face
+ do i=1,numInnerFaces
+ ijp = owner(i)
+ ijn = neighbour(i)
+ psi%y (i) = face_value( ijp, ijn, xf(i), yf(i), zf(i), facint(i), U%y, dU%x, dU%y, dU%z )
+ enddo
+
+ ! Contribution from boundaries
+ do i=1,numBoundaryFaces
+ iface = numInnerFaces + i
+ ijb = numCells + i
+ psi%y(iface) = U%y(ijb)
+ enddo
+
+ ! Calculate cell-centered gradient
+ call grad_scalar_field_w_option( U%z, dU%x, dU%y, dU%z, 'gauss', 'no-limit' )
+
+ ! Interpolate to face
+
+ ! Inner face
+ do i=1,numInnerFaces
+ ijp = owner(i)
+ ijn = neighbour(i)
+ psi%z (i) = face_value( ijp, ijn, xf(i), yf(i), zf(i), facint(i), U%z, dU%x, dU%y, dU%z )
+ enddo
+
+ ! Contribution from boundaries
+ do i=1,numBoundaryFaces
+ iface = numInnerFaces + i
+ ijb = numCells + i
+ psi%z(iface) = U%z(ijb)
+ enddo
+
+end function fvxInterpolateVector
+
+
+!***********************************************************************
+!
+function face_value(ijp,ijn,xf,yf,zf,lambda,u,dUdx,dUdy,dUdz) result(ue)
+!
+!***********************************************************************
+!
+ implicit none
+
+ ! Result
+ real(dp) :: ue
+
+ ! Input
+ integer :: ijp, ijn
+ real(dp) :: xf, yf, zf,lambda
+ real(dp), dimension(numTotal) :: u
+ real(dp), dimension(numCells) :: dUdx,dUdy,dUdz
+
+ if (interpolation_scheme == 'cdscorr') then
+ ue = face_value_cds_corrected(ijp, ijn, xf, yf, zf, lambda, u, dUdx,dUdy,dUdz)
+
+ elseif (interpolation_scheme == 'central') then
+ ue = face_value_central(ijp, ijn, xf, yf, zf, u, dUdx,dUdy,dUdz)
+
+ else !if (interpolation_scheme == 'cds') then
+ ue = face_value_cds(ijp,ijn, lambda, u)
+
+ endif
+
+end function
+
+!***********************************************************************
+!
+ function face_value_cds(ijp, ijn, lambda, fi) result(face_value)
+!
+!***********************************************************************
+!
+! Calculates face value using values of variables at neighbour cell-centers.
+!
+!***********************************************************************
+
+ implicit none
+
+ ! Result
+ real(dp) :: face_value
+
+ ! Input
+ integer :: ijp, ijn
+ real(dp) :: lambda
+ real(dp), dimension(numTotal) :: fi
+
+ ! Locals
+ real(dp) :: fxn,fxp
+
+ ! Face interpolation factor
+ fxn=lambda
+ fxp=1.0_dp-lambda
+
+ face_value = fi(ijp)*fxp+fi(ijn)*fxn
+
+ end function
+
+
+
+!***********************************************************************
+!
+ function face_value_cds_corrected(ijp,ijn, xf, yf, zf, lambda, fi, dfidx,dfidy,dfidz) result(face_value)
+!
+!***********************************************************************
+!
+! Calculates face value using values of variables and their gradients
+! at centers of adjecent cells..
+!
+!***********************************************************************
+
+ implicit none
+
+ ! Result
+ real(dp) :: face_value
+
+ ! Input
+ integer :: ijp, ijn
+ real(dp) :: xf, yf, zf, lambda
+ real(dp), dimension(numTotal) :: fi
+ real(dp), dimension(numCells) :: dfidx,dfidy,dfidz
+
+ ! Locals
+ real(dp) :: fxn,fxp,xi,yi,zi,dfixi,dfiyi,dfizi
+
+ ! Face interpolation factor
+ fxn=lambda
+ fxp=1.0_dp-lambda
+
+ ! Coordinates of point j'
+ xi = xc(ijp)*fxp+xc(ijn)*fxn
+ yi = yc(ijp)*fxp+yc(ijn)*fxn
+ zi = zc(ijp)*fxp+zc(ijn)*fxn
+
+ ! Interpolate gradients defined at CV centers to faces
+ dfixi = dFidx(ijp)*fxp+dFidx(ijn)*fxn
+ dfiyi = dFidy(ijp)*fxp+dFidy(ijn)*fxn
+ dfizi = dFidz(ijp)*fxp+dFidz(ijn)*fxn
+
+ ! |________uj'___________|_________________ucorr____________________|
+ face_value = fi(ijp)*fxp+fi(ijn)*fxn+(dfixi*(xf-xi)+dfiyi*(yf-yi)+dfizi*(zf-zi))
+
+ end function
+
+
+!***********************************************************************
+!
+ function face_value_central(inp,inn, xf, yf, zf, fi, dfidx,dfidy,dfidz) result(face_value)
+!
+!***********************************************************************
+!
+! Calculates face value using values of variables and their gradients
+! at centers of adjecent cells..
+!
+!***********************************************************************
+
+ implicit none
+
+ ! Result
+ real(dp) :: face_value
+
+ ! Input
+ integer :: inp, inn
+ real(dp) :: xf, yf, zf
+ real(dp), dimension(numTotal) :: fi
+ real(dp), dimension(numCells) :: dfidx,dfidy,dfidz
+
+ ! Locals
+ real(dp) :: gradfidr
+
+ gradfidr = dfidx(inp)*(xf-xc(inp))+dfidy(inp)*(yf-yc(inp))+dfidz(inp)*(zf-zc(inp)) &
+ + dfidx(inn)*(xf-xc(inn))+dfidy(inn)*(yf-yc(inn))+dfidz(inn)*(zf-zc(inn))
+
+ face_value = 0.5_dp*( fi(inp) + fi(inn) + gradfidr)
+
+ end function
+
+
+
+end module
\ No newline at end of file
diff --git a/src/finiteVolume/fvExplicit/fvxLaplacian.f90 b/src/finiteVolume/fvExplicit/fvxLaplacian.f90
index e69de29..46bea7f 100644
--- a/src/finiteVolume/fvExplicit/fvxLaplacian.f90
+++ b/src/finiteVolume/fvExplicit/fvxLaplacian.f90
@@ -0,0 +1,98 @@
+module fvxLaplacian
+!
+! Purpose:
+! Module for explicit operations on discrete tensor fields - explicit Laplacian.
+!
+! Description:
+! Module contains procedures for explicit manipulation of discrete tensor fields based on
+! finite volume computations and integral theorems (e.g. Gauss) of vector calculus.
+! Discrete tensor fields are defined on a given finite volume mesh.
+! That means we are expecting discrete volume/surface scalar/vector/tensor fields.
+!
+! fvxLaplacian (volField ->volField) or (surfaceField ->volField)
+!
+! Author: Nikola Mirkov
+! This is a part of freeCappuccino.
+! The code is licenced under GPL licence.
+!
+
+use types
+use geometry
+use tensorFields
+use fvxInterpolation
+use gradients
+
+implicit none
+
+interface fvxLaplacian
+ module procedure fvx_Lapl_volScalarField
+ module procedure fvx_Lapl_volVectorField
+ ! module procedure fvx_Lapl_surfaceVectorField
+end interface
+
+public
+
+contains
+
+
+function fvx_Lapl_volScalarField(phi) result(Lapl)
+!
+! Description:
+! Laplacian of a volume scalar field.
+! Usage:
+! [type(volumeScalarField)] Lapl = fvxDiv( fvxGrad ( [type(volumeScalarField)] phi ) )
+!
+
+ implicit none
+
+ type(volScalarField), intent(in) :: phi
+!
+! > Result
+!
+ type(volScalarField) :: Lapl
+
+!+-----------------------------------------------------------------------------+
+
+ Lapl = new_volScalarField( numCells )
+
+ Lapl%field_name = 'Laplacian_field'
+
+ Lapl%mag = 0.0
+
+ Lapl = fvxDiv( fvxGrad( phi ) )
+
+end function
+
+
+function fvx_Lapl_volVectorField(U) result(Lapl)
+!
+! Description:
+! Laplacian of a volume vector field.
+! Usage:
+! [type(volumeVectorField)] Lapl = fvxDiv( fvxGrad ( [type(volumeVectorField)] U ) )
+!
+
+ implicit none
+
+ type(volVectorField), intent(in) :: U
+!
+! > Result
+!
+ type(volVectorField) :: Lapl
+
+!+-----------------------------------------------------------------------------+
+
+ Lapl = new_volVectorField( numCells )
+
+ Lapl%field_name = 'Laplacian_field'
+
+ Lapl%x = 0.0
+ Lapl%y = 0.0
+ Lapl%z = 0.0
+
+ Lapl = fvxDiv( fvxGrad( phi ) )
+
+end function
+
+
+end module
\ No newline at end of file
diff --git a/src/finiteVolume/fvExplicit/gradients-old.f90 b/src/finiteVolume/fvExplicit/gradients-old.f90
new file mode 100644
index 0000000..ae12079
--- /dev/null
+++ b/src/finiteVolume/fvExplicit/gradients-old.f90
@@ -0,0 +1,1868 @@
+module gradients
+!
+! Module for cell center gradients, gradient limiters and surface normal gradients.
+!
+
+use types
+use geometry, only: numCells,numTotal,xc,yc,zc
+use sparse_matrix, only: ioffset,ja,diag
+
+implicit none
+
+logical :: lstsq, lstsq_qr, lstsq_dm, gauss ! Gradient discretization approach
+character(len=20) :: limiter ! Gradient limiter. Options: none, Barth-Jespersen, Venkatakrishnan, mVenkatakrishnan
+
+real(dp),dimension(:,:), allocatable :: dmat ! d(6,nxyz) - when using bn, or dm version of the subroutine
+real(dp),dimension(:,:,:), allocatable :: dmatqr ! when using qr version of the subroutine size(3,6,nxyz)!
+
+real(dp), parameter :: small = 1e-20
+real(dp), parameter :: zero = 0.0_dp
+
+interface grad
+ module procedure grad_scalar_field
+ module procedure grad_vector_field
+ module procedure grad_scalar_field_w_option
+end interface
+
+interface sngrad
+ module procedure sngrad_scalar_field
+ module procedure sngrad_vector_field
+end interface
+
+
+private
+
+public :: lstsq, lstsq_qr, lstsq_dm, gauss,limiter
+public :: grad,grad_gauss,grad_gauss_corrected,sngrad,create_lsq_grad_matrix
+
+
+
+contains
+
+
+!***********************************************************************
+!
+subroutine allocate_lsq_grad_matrix
+!
+!***********************************************************************
+!
+implicit none
+
+ integer :: ierr
+
+ if( lstsq .or. lstsq_dm ) then
+
+ allocate(dmat(9,numCells),stat=ierr)
+ if(ierr /= 0)write(*,*)"allocation error: dmat"
+
+ elseif( lstsq_qr ) then
+
+ allocate(dmatqr(3,6,numCells),stat=ierr)
+ if(ierr /= 0)write(*,*)"allocation error: dmatqr"
+
+ endif
+
+end subroutine
+
+
+!***********************************************************************
+!
+subroutine create_lsq_grad_matrix(phi,dPhidxi)
+!
+!***********************************************************************
+!
+! Discussion:
+! Prepare System Matrix For Least-Squares Gradient Calculation.
+! It is done by setting this --v value to one.
+! call grad_lsq(U,dUdxi,1,D)
+!
+!***********************************************************************
+!
+
+implicit none
+
+ real(dp), dimension(numTotal), intent(in) :: phi
+ real(dp), dimension(3,numTotal), intent(inout) :: dPhidxi
+
+
+ call allocate_lsq_grad_matrix
+
+ if (lstsq) then
+
+ call grad_lsq(phi,dPhidxi,1,dmat)
+
+ elseif (lstsq_qr) then
+
+ call grad_lsq_qr(phi,dPhidxi,1,dmatqr)
+
+ elseif (lstsq_dm) then
+
+ call grad_lsq_dm(phi,dPhidxi,1,dmat)
+
+ endif
+
+end subroutine
+
+
+!***********************************************************************
+!
+subroutine grad_scalar_field(phi,dPhidxi)
+!
+!***********************************************************************
+!
+
+implicit none
+
+ real(dp), dimension(numTotal), intent(in) :: phi
+ real(dp), dimension(3,numTotal), intent(inout) :: dPhidxi
+
+ dPhidxi = 0.0_dp
+
+ if (lstsq) then
+
+ call grad_lsq(phi,dPhidxi,2,dmat)
+
+ elseif (lstsq_qr) then
+
+ call grad_lsq_qr(phi,dPhidxi,2,dmatqr)
+
+ elseif (lstsq_dm) then
+
+ call grad_lsq_dm(phi,dPhidxi,2,dmat)
+
+ elseif ( lstsq_dm .and. gauss ) then
+
+ call grad_lsq_dm(phi,dPhidxi,2,dmat)
+
+ call grad_gauss_corrected(phi,dPhidxi(1,:),dPhidxi(2,:),dPhidxi(3,:))
+
+ else
+
+ call grad_gauss(phi,dPhidxi(1,:),dPhidxi(2,:),dPhidxi(3,:))
+
+ endif
+
+ !
+ ! Gradient limiter:
+ !
+ if(adjustl(limiter) == 'Barth-Jespersen') then
+
+ call slope_limiter_Barth_Jespersen(phi, dPhidxi)
+
+ elseif(adjustl(limiter) == 'Venkatakrishnan') then
+
+ call slope_limiter_Venkatakrishnan(phi, dPhidxi)
+
+ elseif(adjustl(limiter) == 'mVenkatakrishnan') then
+
+ call slope_limiter_modified_Venkatakrishnan(phi, dPhidxi)
+
+ elseif(adjustl(limiter) == 'MDL') then
+
+ call slope_limiter_multidimensional(phi, dPhidxi)
+
+ else
+ ! no-limit
+ endif
+
+end subroutine
+
+
+!***********************************************************************
+!
+subroutine grad_vector_field(U,V,W,dUdxi,dVdxi,dWdxi)
+!
+!***********************************************************************
+!
+
+ implicit none
+
+ real(dp), dimension(numTotal), intent(in) :: U,V,W
+ real(dp), dimension(3,numTotal), intent(inout) :: dUdxi,dVdxi,dWdxi
+
+ dUdxi=0.0_dp
+ dVdxi=0.0_dp
+ dWdxi=0.0_dp
+
+ if (lstsq) then
+ call grad_lsq(U,dUdxi,2,dmat)
+ call grad_lsq(V,dVdxi,2,dmat)
+ call grad_lsq(W,dWdxi,2,dmat)
+ elseif (lstsq_qr) then
+ call grad_lsq_qr(U,dUdxi,2,dmatqr)
+ call grad_lsq_qr(V,dVdxi,2,dmatqr)
+ call grad_lsq_qr(W,dWdxi,2,dmatqr)
+ elseif (lstsq_dm) then
+ call grad_lsq_dm(U,dUdxi,2,dmat)
+ call grad_lsq_dm(V,dVdxi,2,dmat)
+ call grad_lsq_dm(W,dWdxi,2,dmat)
+ elseif ( (lstsq_dm .and. gauss) ) then
+ call grad_lsq_dm(U,dUdxi,2,dmat)
+ call grad_lsq_dm(V,dVdxi,2,dmat)
+ call grad_lsq_dm(W,dWdxi,2,dmat)
+ call grad_gauss_corrected(U,dUdxi(1,:),dUdxi(2,:),dUdxi(3,:))
+ call grad_gauss_corrected(V,dVdxi(1,:),dVdxi(2,:),dVdxi(3,:))
+ call grad_gauss_corrected(W,dWdxi(1,:),dWdxi(2,:),dWdxi(3,:))
+ else
+ call grad_gauss(U,dUdxi(1,:),dUdxi(2,:),dUdxi(3,:))
+ call grad_gauss(V,dVdxi(1,:),dVdxi(2,:),dVdxi(3,:))
+ call grad_gauss(W,dWdxi(1,:),dWdxi(2,:),dWdxi(3,:))
+ endif
+
+end subroutine
+
+
+!***********************************************************************
+!
+subroutine grad_scalar_field_w_option(phi,dPhidxi,option,option_limiter)
+!
+!***********************************************************************
+!
+! The main reason why we write this subroutine is to correct velocities
+! in SIMPLE algorithm with conservative gradients, which is possible
+! with Gauss rule.
+! We noticed it is better for calculation precision.
+! But calling gradients with option may be nice anyhow.
+!
+!***********************************************************************
+!
+
+implicit none
+
+ real(dp), dimension(numTotal), intent(in) :: phi
+ real(dp), dimension(3,numTotal), intent(inout) :: dPhidxi
+ character( len=* ), intent(in) :: option
+ character( len=* ), intent(in) :: option_limiter
+
+ dPhidxi = 0.0_dp
+
+ if ( option == 'lsq' ) then
+
+ call grad_lsq(phi,dPhidxi,2,dmat)
+
+ elseif ( option == 'lsq_qr' ) then
+
+ call grad_lsq_qr(phi,dPhidxi,2,dmatqr)
+
+ elseif ( option == 'wlsq' ) then
+
+ call grad_lsq_dm(phi,dPhidxi,2,dmat)
+
+ elseif ( option == 'gauss_corrected' ) then
+
+ call grad_gauss_corrected(phi,dPhidxi(1,:),dPhidxi(2,:),dPhidxi(3,:))
+
+ elseif ( option == 'gauss' ) then
+
+ call grad_gauss(phi,dPhidxi(1,:),dPhidxi(2,:),dPhidxi(3,:))
+
+ endif
+
+ !
+ ! Gradient limiter:
+ !
+ if(adjustl(option_limiter) == 'Barth-Jespersen') then
+
+ call slope_limiter_Barth_Jespersen(phi, dPhidxi)
+
+ elseif(adjustl(option_limiter) == 'Venkatakrishnan') then
+
+ call slope_limiter_Venkatakrishnan(phi, dPhidxi)
+
+ elseif(adjustl(option_limiter) == 'mVenkatakrishnan') then
+
+ call slope_limiter_modified_Venkatakrishnan(phi, dPhidxi)
+
+ elseif(adjustl(option_limiter) == 'MDL') then
+
+ call slope_limiter_multidimensional(phi, dPhidxi)
+
+ else
+ ! no-limit
+ endif
+
+end subroutine
+
+
+!***********************************************************************
+!
+subroutine slope_limiter_modified_Venkatakrishnan(phi, dPhidxi)
+!
+!***********************************************************************
+!
+! Calculates slope limiter and appiies to scalar gradient:
+! Wang modified Venkatakrishnan slope limiter
+! Ref.: Z. J. Wang. "A Fast Nested Multi-grid Viscous Flow Solver for Adaptive Cartesian/Quad Grids",
+! International Journal for Numerical Methods in Fluids. 33. 657–680. 2000.
+! The same slope limiter is used in Fluent.
+!
+!***********************************************************************
+!
+
+ implicit none
+
+ ! Input
+ real(dp),dimension(numTotal) :: phi
+ real(dp),dimension(3,numTotal) :: dPhidxi
+
+
+ ! Locals
+ integer :: inp,ijp,ijn,k
+
+ ! Look at the reference epsprim \in [0.01,0.2]
+ real(dp), parameter :: epsprim = 0.01_dp
+
+ real(dp) :: phi_p
+ real(dp) :: cell_neighbour_value,gradfiXdr,slopelimit
+ real(dp) :: deltam,deltap,epsi
+ real(dp) :: phi_max,phi_min
+ real(dp) :: glomax,glomin
+
+
+ glomin = minval(phi(1:numCells))
+ glomax = maxval(phi(1:numCells))
+
+ do inp = 1, numCells
+
+ ! Values at cell center:
+ phi_p = phi(inp)
+
+ ! max and min values over current cell and neighbors
+ phi_max = phi(ja( ioffset(inp) ))
+ phi_min = phi(ja( ioffset(inp) ))
+
+ do k=ioffset(inp)+1, ioffset(inp+1)-1
+ phi_max = max( phi_max, phi(ja(k)) )
+ phi_min = min( phi_max, phi(ja(k)) )
+ enddo
+
+
+ slopelimit = 1.0_dp
+
+ do k=ioffset(inp), ioffset(inp+1)-1
+
+ if (k == diag(inp)) cycle
+
+ ijp = inp
+ ijn = ja(k)
+
+ gradfiXdr=dPhidxi(1,ijp)*(xc(ijn)-xc(ijp))+dPhidxi(2,ijp)*(yc(ijn)-yc(ijp))+dPhidxi(3,ijp)*(zc(ijn)-zc(ijp))
+
+ ! Find unlimited value:
+ cell_neighbour_value = phi_p + gradfiXdr
+
+
+ deltam = cell_neighbour_value - phi_p
+ if (deltam .gt. 0.0d0) then
+ deltap = phi_max-phi_p
+ else
+ deltap = phi_min-phi_p
+ endif
+
+ ! Wang proposition for epsilon
+ epsi = epsprim*( glomax-glomin )
+ slopelimit = max( &
+ min( &
+ slopelimit, &
+ 1./(deltam+small)*((deltap**2+epsi**2)*deltam+2*deltam**2*deltap) &
+ /(deltap**2+2*deltam**2+deltap*deltam+epsi**2+small) &
+ ), &
+ zero &
+ )
+
+ enddo
+
+ dPhidxi(:,inp) = slopelimit*dPhidxi(:,inp)
+
+ enddo
+
+end subroutine
+
+
+
+!***********************************************************************
+!
+subroutine slope_limiter_Barth_Jespersen(phi, dPhidxi)
+!
+!***********************************************************************
+!
+! Calculates slope limiter and appiies to scalar gradient:
+! Barth and Jespersen slope limiter:
+!
+! AIAA-89-0366, The design and application of upwind schemes
+! on unstructured meshes, T.J.Barth, D.C.Jespersen, 1989.
+!
+!***********************************************************************
+!
+
+ implicit none
+
+ ! Input
+ real(dp),dimension(numTotal) :: phi
+ real(dp),dimension(3,numTotal) :: dPhidxi
+
+
+ ! Locals
+ integer :: inp,ijp,ijn,k
+ real(dp) :: phi_p
+ real(dp) :: slopelimit
+ real(dp) :: delta_face
+ real(dp) :: phi_max,phi_min,r
+ real(dp) :: fimax,fimin,deltamax,deltamin
+
+
+ fimin = minval(phi(1:numCells))
+ fimax = maxval(phi(1:numCells))
+
+ do inp = 1, numCells
+
+ ! Values at cell center:
+ phi_p = phi(inp)
+
+ ! max and min values over current cell and neighbors
+ phi_max = phi(ja( ioffset(inp) ))
+ phi_min = phi(ja( ioffset(inp) ))
+
+ do k=ioffset(inp)+1, ioffset(inp+1)-1
+ phi_max = max( phi_max, phi(ja(k)) )
+ phi_min = min( phi_max, phi(ja(k)) )
+ enddo
+
+
+ deltamax = fimax - phi(inp)
+ deltamin = fimin - phi(inp)
+
+ slopelimit = 1.0_dp
+
+ do k=ioffset(inp), ioffset(inp+1)-1
+
+ if (k == diag(inp)) cycle
+
+ ijp = inp
+ ijn = ja(k)
+
+ delta_face=dPhidxi(1,ijp)*(xc(ijn)-xc(ijp))+dPhidxi(2,ijp)*(yc(ijn)-yc(ijp))+dPhidxi(3,ijp)*(zc(ijn)-zc(ijp))
+
+
+ if( abs(delta_face) < 1.e-6 )then
+ r = 1.0_dp
+ else if( delta_face > 0.0 )then
+ r = deltamax/delta_face
+ else
+ r = deltamin/delta_face
+ endif
+
+ slopelimit = min( slopelimit , r )
+
+ enddo
+
+ dPhidxi(:,inp) = slopelimit*dPhidxi(:,inp)
+
+ enddo
+
+end subroutine
+
+
+
+
+!***********************************************************************
+!
+subroutine slope_limiter_Venkatakrishnan(phi, dPhidxi)
+!
+!***********************************************************************
+!
+! Calculates slope limiter and appiies to scalar gradient:
+! Venkatakrishnan slope limiter:
+!
+! AIAA-93-0880, On the accuracy of limiters and convergence
+! to steady state solutions, V.Venkatakrishnan, 1993
+!
+!***********************************************************************
+!
+
+ implicit none
+
+ ! Input
+ real(dp),dimension(numTotal) :: phi
+ real(dp),dimension(3,numTotal) :: dPhidxi
+
+
+ ! Locals
+ integer :: inp,ijp,ijn,k
+ real(dp) :: phi_p
+ real(dp) :: slopelimit
+ real(dp) :: delta_face
+ real(dp) :: phi_max,phi_min,r
+ real(dp) :: fimax,fimin,deltamax,deltamin
+
+
+ fimin = minval(phi(1:numCells))
+ fimax = maxval(phi(1:numCells))
+
+ do inp = 1, numCells
+
+ ! Values at cell center:
+ phi_p = phi(inp)
+
+ ! max and min values over current cell and neighbors
+ phi_max = phi(ja( ioffset(inp) ))
+ phi_min = phi(ja( ioffset(inp) ))
+
+ do k=ioffset(inp)+1, ioffset(inp+1)-1
+ phi_max = max( phi_max, phi(ja(k)) )
+ phi_min = min( phi_max, phi(ja(k)) )
+ enddo
+
+
+ deltamax = fimax - phi(inp)
+ deltamin = fimin - phi(inp)
+
+ slopelimit = 1.0_dp
+
+ do k=ioffset(inp), ioffset(inp+1)-1
+
+ if (k == diag(inp)) cycle
+
+ ijp = inp
+ ijn = ja(k)
+
+ delta_face=dPhidxi(1,ijp)*(xc(ijn)-xc(ijp))+dPhidxi(2,ijp)*(yc(ijn)-yc(ijp))+dPhidxi(3,ijp)*(zc(ijn)-zc(ijp))
+
+
+ if( abs(delta_face) < 1.e-6 )then
+ r = 1.0_dp
+ else if( delta_face > 0.0 )then
+ r = deltamax/delta_face
+ else
+ r = deltamin/delta_face
+ endif
+
+ slopelimit = min( slopelimit , (r**2+2.0*r)/(r**2+r+2.0) )
+
+ enddo
+
+ dPhidxi(:,inp) = slopelimit*dPhidxi(:,inp)
+
+ enddo
+
+end subroutine
+
+
+
+!***********************************************************************
+!
+subroutine slope_limiter_multidimensional(phi, dPhidxi)
+!
+!***********************************************************************
+!
+! Calculates slope limiter and applies to scalar gradient:
+! Multidimensional slope limiter
+! Ref.: SE Kim, B Makarov, D Caraeni - A Multi-Dimensional Linear
+! Reconstruction Scheme for Arbitrary Unstructured Meshes, AIAA 2003-3990.
+! The same slope limiter is used in Fluent.
+!
+!***********************************************************************
+!
+
+ implicit none
+
+ ! Input
+ real(dp),dimension(numTotal) :: phi
+ real(dp),dimension(3,numTotal) :: dPhidxi
+
+
+ ! Locals
+ integer :: inp,ijp,ijn,k
+ real(dp) :: phi_max,phi_min
+ real(dp) :: dPhi,dPhimax,dPhimin
+ real(dp) :: gx,gy,gz
+ real(dp) :: gtx,gty,gtz
+ real(dp) :: gn
+ real(dp) :: xpn,ypn,zpn,dpn
+ real(dp) :: nx,ny,nz
+
+ ! Find phi_max and phi_min in neighbours of Co, including itself.
+ do inp = 1, numCells
+
+ ! max and min values over current cell and neighbors
+ phi_max = phi(ja( ioffset(inp) ))
+ phi_min = phi(ja( ioffset(inp) ))
+
+ do k=ioffset(inp)+1, ioffset(inp+1)-1
+ phi_max = max( phi_max, phi(ja(k)) )
+ phi_min = min( phi_max, phi(ja(k)) )
+ enddo
+
+ ! Initialize gradient vector with current unlimited value
+ gx = dPhidxi(1,inp)
+ gy = dPhidxi(2,inp)
+ gz = dPhidxi(3,inp)
+
+ ! Loop over neighbours, we access info about neighbours using CSR ioffset array..
+ do k=ioffset(inp), ioffset(inp+1)-1
+
+ ! Skip the cell itself, we need only neighbours
+ if (k == diag(inp)) cycle
+
+ ! Present cell - P
+ ijp = inp
+ ! Neighbour cell - N ( we find its index using CSR column array )
+ ijn = ja(k)
+
+ ! Distance vector between cell centers
+ xpn=xc(ijn)-xc(ijp)
+ ypn=yc(ijn)-yc(ijp)
+ zpn=zc(ijn)-zc(ijp)
+
+ ! Distance from P to neighbor N
+ dpn=sqrt(xpn**2+ypn**2+zpn**2)
+
+ nx = xpn/dpn
+ ny = ypn/dpn
+ nz = zpn/dpn
+
+ gn = gx*nx+gy*ny+gz*nz
+
+ gtx = gx - gn*nx
+ gty = gy - gn*ny
+ gtz = gz - gn*nz
+
+ ! Increment from P cell to N cell
+ dPhi=gx*(xc(ijn)-xc(ijp))+gy*(yc(ijn)-yc(ijp))+gz*(zc(ijn)-zc(ijp))
+
+ dPhimax = phi_max-phi(inp)
+
+ dPhimin = phi_min-phi(inp)
+
+ ! Check for overshoots and undershoots and correct accordingly.
+
+ if ( phi_max > phi(inp) .and. dPhi > dPhimax ) then
+
+ gx = gtx + nx*dPhimax
+ gy = gty + ny*dPhimax
+ gz = gtz + nz*dPhimax
+
+ endif
+
+ if ( phi_min < phi(inp) .and. dPhi < dPhimin ) then
+
+ gx = gtx + nx*dPhimin
+ gy = gty + ny*dPhimin
+ gz = gtz + nz*dPhimin
+
+ endif
+
+
+ enddo
+
+ dPhidxi(1,inp) = gx
+ dPhidxi(2,inp) = gy
+ dPhidxi(3,inp) = gz
+
+ enddo
+
+end subroutine
+
+
+
+! Least square gradients
+subroutine grad_lsq(fi,dFidxi,istage,dmat)
+!
+!***********************************************************************
+!
+! Purpose:
+! Calculates cell-centered gradients using UNWEIGHTED Least-Squares approach.
+!
+! Description:
+! Approach taken from PhD thesis of Bojan Niceno, TU Delft, 2000.,
+! also in Muzaferija and Gossman JCP paper from 1995.
+!
+! Arguments:
+!
+! FI - field variable which gradient we look for.
+! DFiDXi - cell centered gradient - a three component gradient vector.
+! ISTAGE - integer. If ISTAGE=1 calculates and stores only geometrical
+! parameters - a system matrix for least square problem at every cell.
+! Usually it is called with ISTAGE=1 at the beggining of simulation.
+! If 2 it doesn't calculate system matrix, just RHS and solves system.
+! Dmat - LSQ matrix with geometry data
+!
+! Example call:
+! CALL GRADFI_LSQ(U,DUDXI,2,D)
+!
+!***********************************************************************
+!
+ use types
+ ! use parameters
+ use geometry
+
+ implicit none
+
+ integer, intent(in) :: istage
+ real(dp),dimension(numTotal), intent(in) :: fi
+ real(dp),dimension(3,numTotal), intent(inout) :: dFidxi
+ real(dp),dimension(9,numCells), intent(inout) :: dmat
+
+ !
+ ! Locals
+ !
+ integer :: i,ijp,ijn,inp,iface
+
+ real(dp), dimension(numCells) :: b1,b2,b3
+ real(dp) :: Dx,Dy,Dz
+ real(dp) :: d11,d12,d13,d21,d22,d23,d31,d32,d33,tmp
+!
+!***********************************************************************
+!
+
+ if(istage.eq.1) then
+ ! Coefficient matrix - should be calculated only once
+
+ ! Initialize dmat matrix:
+ dmat = 0.0_dp
+
+ ! Inner faces:
+ do i=1,numInnerFaces
+ ijp = owner(i)
+ ijn = neighbour(i)
+
+ Dx = xc(ijn)-xc(ijp)
+ Dy = yc(ijn)-yc(ijp)
+ Dz = zc(ijn)-zc(ijp)
+
+ Dmat(1,ijp) = Dmat(1,ijp) + Dx*Dx
+ Dmat(1,ijn) = Dmat(1,ijn) + Dx*Dx
+
+ Dmat(4,ijp) = Dmat(4,ijp) + Dy*Dy
+ Dmat(4,ijn) = Dmat(4,ijn) + Dy*Dy
+
+ Dmat(6,ijp) = Dmat(6,ijp) + Dz*Dz
+ Dmat(6,ijn) = Dmat(6,ijn) + Dz*Dz
+
+ Dmat(2,ijp) = Dmat(2,ijp) + Dx*Dy
+ Dmat(2,ijn) = Dmat(2,ijn) + Dx*Dy
+
+ Dmat(3,ijp) = Dmat(3,ijp) + Dx*Dz
+ Dmat(3,ijn) = Dmat(3,ijn) + Dx*Dz
+
+ Dmat(5,ijp) = Dmat(5,ijp) + Dy*Dz
+ Dmat(5,ijn) = Dmat(5,ijn) + Dy*Dz
+ enddo
+
+
+
+ ! Boundary faces:
+
+ do i=1,numBoundaryFaces
+ iface = numInnerFaces + i
+ ijp = owner(iface)
+
+ Dx = xf(iface)-xc(ijp)
+ Dy = yf(iface)-yc(ijp)
+ Dz = zf(iface)-zc(ijp)
+
+ Dmat(1,ijp) = Dmat(1,ijp) + Dx*Dx
+ Dmat(4,ijp) = Dmat(4,ijp) + Dy*Dy
+ Dmat(6,ijp) = Dmat(6,ijp) + Dz*Dz
+ Dmat(2,ijp) = Dmat(2,ijp) + Dx*Dy
+ Dmat(3,ijp) = Dmat(3,ijp) + Dx*Dz
+ Dmat(5,ijp) = Dmat(5,ijp) + Dy*Dz
+ end do
+
+
+ ! Prepare for storage:
+ do inp=1,numCells
+
+ ! Copy from Coefficient matrix
+ D11 = Dmat(1,inp)
+ D12 = Dmat(2,inp)
+ D13 = Dmat(3,inp)
+
+ D22 = Dmat(4,inp)
+ D23 = Dmat(5,inp)
+ D33 = Dmat(6,inp)
+
+ ! Symmetric part
+ D21 = D12
+ D31 = D13
+ D32 = D23
+
+ ! Denominator used troughout
+ tmp = 1./(d11*d22*d33 - d11*d23*d32 - d12*d21*d33 + d12*d23*d31 + d13*d21*d32 - d13*d22*d31 + small)
+
+ Dmat(1,inp) = (d22*d33 - d23*d32) * tmp
+ Dmat(2,inp) = (d21*d33 - d23*d31) * tmp
+ Dmat(3,inp) = (d21*d32 - d22*d31) * tmp
+
+ Dmat(4,inp) = (d11*d33 - d13*d31) * tmp
+ Dmat(5,inp) = (d12*d33 - d13*d32) * tmp
+ Dmat(6,inp) = (d11*d32 - d12*d31) * tmp
+
+ Dmat(7,inp) = (d12*d23 - d13*d22) * tmp
+ Dmat(8,inp) = (d11*d23 - d13*d21) * tmp
+ Dmat(9,inp) = (d11*d22 - d12*d21) * tmp
+
+ enddo
+
+!...
+ elseif(istage.eq.2) then
+!...
+
+ ! Initialize rhs vector
+ b1 = 0.0_dp
+ b2 = 0.0_dp
+ b3 = 0.0_dp
+
+
+ ! Inner faces:
+
+ do i=1,numInnerFaces
+ ijp = owner(i)
+ ijn = neighbour(i)
+
+ Dx = ( xc(ijn)-xc(ijp) ) * ( Fi(ijn)-Fi(ijp) )
+ Dy = ( yc(ijn)-yc(ijp) ) * ( Fi(ijn)-Fi(ijp) )
+ Dz = ( zc(ijn)-zc(ijp) ) * ( Fi(ijn)-Fi(ijp) )
+
+ b1(ijp) = b1(ijp) + Dx
+ b1(ijn) = b1(ijn) + Dx
+
+ b2(ijp) = b2(ijp) + Dy
+ b2(ijn) = b2(ijn) + Dy
+
+ b3(ijp) = b3(ijp) + Dz
+ b3(ijn) = b3(ijn) + Dz
+
+ enddo
+
+ ! Boundary faces:
+
+ do i=1,numBoundaryFaces
+ iface = numInnerFaces + i
+ ijp = owner(iface)
+ ijn = numCells + i
+
+ Dx = (Fi(ijn)-Fi(ijp))*(xf(iface)-xc(ijp))
+ Dy = (Fi(ijn)-Fi(ijp))*(yf(iface)-yc(ijp))
+ Dz = (Fi(ijn)-Fi(ijp))*(zf(iface)-zc(ijp))
+
+ b1(ijp) = b1(ijp) + Dx
+ b2(ijp) = b2(ijp) + Dy
+ b3(ijp) = b3(ijp) + Dz
+
+ enddo
+
+
+ !
+ ! Solve the system A*X = B.
+ !
+
+ do inp=1,numCells
+
+ dFidxi(1,inp) = b1(inp)*Dmat(1,inp) - b2(inp)*Dmat(2,inp) + b3(inp)*Dmat(3,inp)
+ dFidxi(2,inp) = b1(inp)*Dmat(4,inp) - b2(inp)*Dmat(5,inp) - b3(inp)*Dmat(6,inp)
+ dFidxi(3,inp) = b1(inp)*Dmat(7,inp) - b2(inp)*Dmat(8,inp) + b3(inp)*Dmat(9,inp)
+
+ enddo
+
+endif
+
+end subroutine
+
+
+! Least square gradients via QR decomposition
+!***********************************************************************
+!
+subroutine grad_lsq_qr(fi,dfidxi,istage,d)
+!
+!***********************************************************************
+!
+! Purpose:
+! Calculates cell-centered gradients using Least-Squares approach.
+!
+! Description:
+! Uses QR decomposition of system matrix via Householder or via
+! Gramm-Schmidt.
+! QR decomposition is precomputed and R^(-1)*Q^T is stored in
+! D array for every cell.
+!
+! Arguments:
+!
+! FI - dependent field variable
+! dFIdxi - cell centered gradient - a three component gradient vector.
+! ISTAGE - integer. If ISTAGE=1 calculates and stores only geometrical
+! parameters - a system matrix for least square problem at every cell.
+! Usually it is called with ISTAGE=1 at the beggining of simulation.
+! If 2 it doesn't calculate system matrix, just RHS and solves system.
+! D - System matrix - or R^(-1)*Q^T from it's QR factorisation
+! XC,YC,ZC - coordinates of cell centers
+!
+! Example call:
+! CALL dFIdxi_LSTSQ_QR(U,dUdxi,2,D)
+!
+!***********************************************************************
+!
+ use types
+ ! use parameters
+ use geometry!, only:numCells,numInnerFaces,numBoundaryFaces,noc,owner,neighbour,ijl,ijr,xf,yf,zf,xc,yc,zc
+ use matrix_module
+
+ implicit none
+
+ integer, parameter :: n=3, m=6 ! m is the number of neighbours, e.g. for structured 3D mesh it's 6
+
+ integer, intent(in) :: istage
+ real(dp), dimension(numTotal), intent(in) :: fi
+ real(dp), dimension(n,numCells), intent(inout) :: dFidxi
+ real(dp), dimension(n,m,numCells), intent(inout) :: D
+
+ !
+ ! Locals
+ !
+ integer :: i,l,k,ijp,ijn,inp,iface
+
+ integer, dimension(numCells) :: neighbour_index
+
+ real(dp), dimension(m,n) :: Dtmp
+ real(dp), dimension(n,m) :: Dtmpt
+ real(dp), dimension(m,numCells) :: b
+
+
+ !REAL(dp), DIMENSION(m,n) :: R
+ !REAL(dp), DIMENSION(m,m) :: Q
+ !REAL(dp), DIMENSION(n,n) :: R1
+ !REAL(dp), DIMENSION(n,m) :: Q1t
+
+ INTEGER :: INFO
+ REAL(dp), DIMENSION(n) :: TAU
+ INTEGER, DIMENSION(n) :: WORK
+ REAL(dp), DIMENSION(m) :: v1,v2,v3
+ REAL(dp), DIMENSION(m,m) :: H1,H2,H3,Ieye
+ REAL(dp), DIMENSION(n,n) :: R
+ REAL(dp), DIMENSION(m,m) :: Q
+
+
+!**************************************************************************************************
+ if(istage.eq.1) then
+ ! Coefficient matrix - should be calculated only once
+!**************************************************************************************************
+ Dtmp = 0.0d0
+ neighbour_index = 0
+
+ ! Inner faces:
+ do i=1,numInnerFaces
+ ijp = owner(i)
+ ijn = neighbour(i)
+
+ neighbour_index(ijp) = neighbour_index(ijp) + 1
+ l = neighbour_index(ijp)
+ D(1,l,ijp) = xc(ijn)-xc(ijp)
+ D(2,l,ijp) = yc(ijn)-yc(ijp)
+ D(3,l,ijp) = zc(ijn)-zc(ijp)
+
+ neighbour_index(ijn) = neighbour_index(ijn) + 1
+ l = neighbour_index(ijn)
+ D(1,l,ijn) = xc(ijp)-xc(ijn)
+ D(2,l,ijn) = yc(ijp)-yc(ijn)
+ D(3,l,ijn) = zc(ijp)-zc(ijn)
+
+ enddo
+
+ ! Boundary faces:
+
+ do i=1,numBoundaryFaces
+ iface = numInnerFaces + i
+ ijp = owner(iface)
+ ! ijb = numCells + i
+ neighbour_index(ijp) = neighbour_index(ijp) + 1
+ l = neighbour_index(ijp)
+ D(1,l,ijp) = xf(iface)-xc(ijp)
+ D(2,l,ijp) = yf(iface)-yc(ijp)
+ D(3,l,ijp) = zf(iface)-zc(ijp)
+ end do
+
+ ! Form system matrix using QR decomposition:
+
+ ! Cell loop
+
+ do inp=1,numCells
+
+ l = neighbour_index(inp)
+
+ Dtmpt = D(:,:,inp)
+ Dtmp = transpose(Dtmpt)
+
+ !1 ...Decompose A=QR using Householder
+ ! call householder_qr(Dtmp, m, n, Q, R)
+ !2 ...Decompose A=QR using Gram-Schmidt
+ ! call mgs_qr(Dtmp, m, n, Q, R)
+
+ ! Q = transpose(Q)
+ ! Q1t = Q(1:n,1:m) ! NOTE: A=Q1R1 is so-called 'thin QR factorization' - see Golub & Van Loan
+ ! Here Q1 is actually Q1^T a transpose of Q1(thin Q - Q with m-n column stripped off)
+ ! R1 = R(1:n,1:n) ! our Q1 is thin transpose of original Q.
+ ! R1 = inv(R1) ! inv is a function in matrix_module, now works only for 3x3 matrices.
+ ! Q1t = matmul(R1,Q1t) ! this is actually R^(-1)*Q^T - a matrix of size n x m.
+ ! D(:,:,INP) = Q1t ! Store it for later.
+
+ !3....LAPACK routine DGEQRF
+ CALL DGEQRF( l, N, Dtmp, M, TAU, WORK, N, INFO )
+
+ ! Upper triangular matrix R
+ R(1:n,1:n)=Dtmp(1:n,1:n)
+
+ ! Create reflectors
+ !H(i) = I - TAU * v * v'
+ Ieye=eye(l)
+ !v(1:i-1) = 0. and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i)
+ v1(1) = 1.; v1(2:l)=Dtmp(2:l,1)
+ H1 = rank_one_update(Ieye,l,l,v1,v1,-TAU(1))
+ v2(1) = 0.; v2(2) = 1.; v2(3:l)=Dtmp(3:l,2)
+ H2 = rank_one_update(Ieye,l,l,v2,v2,-TAU(2))
+ v3(1:2) = 0.; v3(3) = 1.; v3(4:l)=Dtmp(4:l,3)
+ H3 = rank_one_update(Ieye,l,l,v3,v3,-TAU(3))
+ ! The matrix Q is represented as a product of elementary reflectors H1, H2, ..., Hn
+ Q=matmul(H1,H2)
+ Q=matmul(Q,H3)
+
+ ! Form R_1^(-1)*Q_1^T explicitely:
+ do k=1,neighbour_index(inp)
+ d(1,k,inp) = q(k,1)/r(1,1) - (r(1,2)*q(k,2))/(r(1,1)*r(2,2)) + (q(k,3)*(r(1,2)*r(2,3) - r(1,3)*r(2,2)))/(r(1,1)*r(2,2)*r(3,3))
+ d(2,k,inp) = q(k,2)/r(2,2) - (r(2,3)*q(k,3))/(r(2,2)*r(3,3))
+ d(3,k,inp) = q(k,3)/r(3,3)
+ enddo
+
+ enddo
+
+
+!**************************************************************************************************
+ elseif(istage.eq.2) then
+!**************************************************************************************************
+
+
+ ! RHS vector
+ b=0.0d0
+
+ neighbour_index(:) = 0
+
+ ! Inner faces:
+ do i=1,numInnerFaces
+ ijp = owner(i)
+ ijn = neighbour(i)
+
+ neighbour_index(ijp) = neighbour_index(ijp) + 1
+ l = neighbour_index(ijp)
+ b(l,ijp) = fi(ijn)-fi(ijp)
+
+ neighbour_index(ijn) = neighbour_index(ijn) + 1
+ l = neighbour_index(ijn)
+ b(l,ijn) = fi(ijp)-fi(ijn)
+
+ enddo
+
+ ! Boundary faces:
+
+ do i=1,numBoundaryFaces
+ iface = numInnerFaces + i
+ ijp = owner(iface)
+ ijn = numCells + i
+ neighbour_index(ijp) = neighbour_index(ijp) + 1
+ l = neighbour_index(ijp)
+ b(l,ijp) = fi(ijn)-fi(ijp)
+ enddo
+
+! Solve overdetermined system in least-sqare sense
+
+ ! Cell loop
+ do inp=1,numCells
+
+ l = neighbour_index(inp)
+
+ ! ...using precomputed QR factorization and storing R^(-1)*Q^T in D
+ dFIdxi(1,INP) = sum(D(1,1:l,inp)*b(1:l,inp))
+ dFIdxi(2,INP) = sum(D(2,1:l,inp)*b(1:l,inp))
+ dFIdxi(3,INP) = sum(D(3,1:l,inp)*b(1:l,inp))
+
+ enddo
+
+
+!**************************************************************************************************
+ endif
+
+
+end subroutine
+
+
+! Weighted least square gradients
+subroutine grad_lsq_dm(fi,dFidxi,istage,dmat)
+!
+!***********************************************************************
+!
+! Purpose:
+! Calculates cell-centered gradients using WEIGHTED Least-Squares approach.
+!
+! Description:
+! Approach taken from a paper:
+! Dimitry Mavriplis, "Revisiting the Least Squares procedure for Gradient Reconstruction on Unstructured Meshes." NASA/CR-2003-212683.
+! Weights based on inverse cell-centers distance is added to improve conditioning of the system matrix for skewed meshes.
+! Reduces storage requirements compared to QR subroutine.
+! System matrix is symmetric and can be solved efficiently using Cholesky decomposition or by matrix inversion.
+!
+! Arguments:
+!
+! FI - field variable which gradient we look for.
+! DFIDXi- cell centered gradient - a three component gradient vector.
+! ISTAGE - integer. If ISTAGE=1 calculates and stores only geometrical
+! parameters - a system matrix for least square problem at every cell.
+! Usually it is called with ISTAGE=1 at the beggining of simulation.
+! If 2 it doesn't calculate system matrix, just RHS and solves system.
+! Dmat - LSQ matrix with geometry data
+!
+! Example call:
+! CALL GRADFI_LSQ_DM(U,DUDX,DUDY,DUDZ,2,D)
+!
+!***********************************************************************
+!
+ use types
+ ! use parameters
+ use geometry
+ ! use sparse_matrix, only: ioffset, ja
+
+ implicit none
+
+ integer, intent(in) :: istage
+ real(dp),dimension(numTotal), intent(in) :: fi
+ real(dp),dimension(3,numTotal), intent(inout) :: dFidxi
+ real(dp),dimension(9,numCells), intent(inout) :: dmat
+
+ !
+ ! Locals
+ !
+ integer :: i,ijp,ijn,inp,iface
+
+ real(dp) :: w
+ real(dp) :: Dx,Dy,Dz
+ real(dp) :: d11,d12,d13,d21,d22,d23,d31,d32,d33
+ real(dp) :: tmp
+
+ real(dp), dimension(numCells) :: b1,b2,b3
+!
+!***********************************************************************
+!
+
+ if(istage.eq.1) then
+ ! Coefficient matrix - should be calculated only once
+
+ ! Initialize dmat matrix:
+ dmat = 0.0d0
+
+ ! Inner faces:
+
+ do i=1,numInnerFaces
+ ijp = owner(i)
+
+ !***------------------------------------
+ ijn = neighbour(i)
+
+ w = 1./((xc(ijn)-xc(ijp))**2+(yc(ijn)-yc(ijp))**2+(zc(ijn)-zc(ijp))**2)
+
+ Dx = xc(ijn)-xc(ijp)
+ Dy = yc(ijn)-yc(ijp)
+ Dz = zc(ijn)-zc(ijp)
+
+ Dmat(1,ijp) = Dmat(1,ijp) + w*Dx*Dx
+ Dmat(1,ijn) = Dmat(1,ijn) + w*Dx*Dx
+
+ Dmat(4,ijp) = Dmat(4,ijp) + w*Dy*Dy
+ Dmat(4,ijn) = Dmat(4,ijn) + w*Dy*Dy
+
+ Dmat(6,ijp) = Dmat(6,ijp) + w*Dz*Dz
+ Dmat(6,ijn) = Dmat(6,ijn) + w*Dz*Dz
+
+ Dmat(2,ijp) = Dmat(2,ijp) + w*Dx*Dy
+ Dmat(2,ijn) = Dmat(2,ijn) + w*Dx*Dy
+
+ Dmat(3,ijp) = Dmat(3,ijp) + w*Dx*Dz
+ Dmat(3,ijn) = Dmat(3,ijn) + w*Dx*Dz
+
+ Dmat(5,ijp) = Dmat(5,ijp) + w*Dy*Dz
+ Dmat(5,ijn) = Dmat(5,ijn) + w*Dy*Dz
+ !***------------------------------------
+
+ ! !
+ ! ! **Extended interpolation molecule: neighbours of neighbours**
+ ! !
+ ! nb_loop: do k = ioffset( neighbour(i) ), ioffset( neighbour(i)+1 )-1
+
+ ! ijn = ja(k)
+
+ ! if (ijn == ijp) cycle nb_loop ! nemoj ownera dirati
+
+ ! ! Paznja kada je ja(k) = diag( neighbour(i) ) ijn ce uzeti samog cell_neighboura,
+ ! ! tako da ovaj loop moze uraditi isto sto i gornji, pa je u toj verziji
+ ! ! racunanja gradijenata ovaj loop gore nepotreban. Eto simplifikacije koda...
+
+ ! w = 1./((xc(ijn)-xc(ijp))**2+(yc(ijn)-yc(ijp))**2+(zc(ijn)-zc(ijp))**2)
+
+ ! Dx = xc(ijn)-xc(ijp)
+ ! Dy = yc(ijn)-yc(ijp)
+ ! Dz = zc(ijn)-zc(ijp)
+
+ ! Dmat(1,ijp) = Dmat(1,ijp) + w*Dx*Dx
+ ! Dmat(1,ijn) = Dmat(1,ijn) + w*Dx*Dx
+
+ ! Dmat(4,ijp) = Dmat(4,ijp) + w*Dy*Dy
+ ! Dmat(4,ijn) = Dmat(4,ijn) + w*Dy*Dy
+
+ ! Dmat(6,ijp) = Dmat(6,ijp) + w*Dz*Dz
+ ! Dmat(6,ijn) = Dmat(6,ijn) + w*Dz*Dz
+
+ ! Dmat(2,ijp) = Dmat(2,ijp) + w*Dx*Dy
+ ! Dmat(2,ijn) = Dmat(2,ijn) + w*Dx*Dy
+
+ ! Dmat(3,ijp) = Dmat(3,ijp) + w*Dx*Dz
+ ! Dmat(3,ijn) = Dmat(3,ijn) + w*Dx*Dz
+
+ ! Dmat(5,ijp) = Dmat(5,ijp) + w*Dy*Dz
+ ! Dmat(5,ijn) = Dmat(5,ijn) + w*Dy*Dz
+
+ ! enddo nb_loop
+
+ enddo
+
+
+ ! Boundary faces:
+
+ do i=1,numBoundaryFaces
+ iface = numInnerFaces + i
+ ijp = owner(iface)
+
+ w = 1.0_dp/((xf(iface)-xc(ijp))**2+(yf(iface)-yc(ijp))**2+(zf(iface)-zc(ijp))**2)
+
+ Dx = xf(iface)-xc(ijp)
+ Dy = yf(iface)-yc(ijp)
+ Dz = zf(iface)-zc(ijp)
+
+ Dmat(1,ijp) = Dmat(1,ijp) + w*Dx*Dx
+ Dmat(4,ijp) = Dmat(4,ijp) + w*Dy*Dy
+ Dmat(6,ijp) = Dmat(6,ijp) + w*Dz*Dz
+ Dmat(2,ijp) = Dmat(2,ijp) + w*Dx*Dy
+ Dmat(3,ijp) = Dmat(3,ijp) + w*Dx*Dz
+ Dmat(5,ijp) = Dmat(5,ijp) + w*Dy*Dz
+ end do
+
+
+ ! Prepare for storage:
+ do inp=1,numCells
+
+ ! Copy from Coefficient matrix
+ D11 = Dmat(1,inp)
+ D12 = Dmat(2,inp)
+ D13 = Dmat(3,inp)
+
+ D22 = Dmat(4,inp)
+ D23 = Dmat(5,inp)
+ D33 = Dmat(6,inp)
+
+ ! Symmetric part
+ D21 = D12
+ D31 = D13
+ D32 = D23
+
+ ! Denominator used troughout
+ tmp = 1./(d11*d22*d33 - d11*d23*d32 - d12*d21*d33 + d12*d23*d31 + d13*d21*d32 - d13*d22*d31 + small)
+
+ Dmat(1,inp) = (d22*d33 - d23*d32) * tmp
+ Dmat(2,inp) = (d21*d33 - d23*d31) * tmp
+ Dmat(3,inp) = (d21*d32 - d22*d31) * tmp
+
+ Dmat(4,inp) = (d11*d33 - d13*d31) * tmp
+ Dmat(5,inp) = (d12*d33 - d13*d32) * tmp
+ Dmat(6,inp) = (d11*d32 - d12*d31) * tmp
+
+ Dmat(7,inp) = (d12*d23 - d13*d22) * tmp
+ Dmat(8,inp) = (d11*d23 - d13*d21) * tmp
+ Dmat(9,inp) = (d11*d22 - d12*d21) * tmp
+
+ enddo
+
+
+!**************************************************************************************************
+ elseif(istage.eq.2) then
+!**************************************************************************************************
+
+ ! Initialize rhs vector
+ b1 = 0.0d0
+ b2 = 0.0d0
+ b3 = 0.0d0
+
+ ! Inner faces:
+
+ do i=1,numInnerFaces
+ ijp = owner(i)
+
+ !***------------------------------------
+ ijn = neighbour(i)
+
+ w = 1./((xc(ijn)-xc(ijp))**2+(yc(ijn)-yc(ijp))**2+(zc(ijn)-zc(ijp))**2)
+
+ Dx = w * ( xc(ijn)-xc(ijp) ) * ( Fi(ijn)-Fi(ijp) )
+ Dy = w * ( yc(ijn)-yc(ijp) ) * ( Fi(ijn)-Fi(ijp) )
+ Dz = w * ( zc(ijn)-zc(ijp) ) * ( Fi(ijn)-Fi(ijp) )
+
+ b1(ijp) = b1(ijp) + Dx
+ b1(ijn) = b1(ijn) + Dx
+
+ b2(ijp) = b2(ijp) + Dy
+ b2(ijn) = b2(ijn) + Dy
+
+ b3(ijp) = b3(ijp) + Dz
+ b3(ijn) = b3(ijn) + Dz
+ !***------------------------------------
+
+ ! !
+ ! ! **Extended interpolation molecule: neighbours of neighbours**
+ ! !
+ ! nb_loop2: do k = ioffset( neighbour(i) ), ioffset( neighbour(i)+1 )-1
+
+ ! ijn = ja(k)
+
+ ! if (ijn == ijp) cycle nb_loop2 ! nemoj ownera dirati
+
+ ! ! Paznja kada je ja(k) = diag( neighbour(i) ) ijn ce uzeti samo cell_neighboura,
+ ! ! tako da ovaj loop moze uraditi isto sto i gornji, pa je u toj verziji
+ ! ! racunanja gradijenata ovaj loop gore nepotreban. Eto simplifikacije koda...
+
+ ! w = 1./((xc(ijn)-xc(ijp))**2+(yc(ijn)-yc(ijp))**2+(zc(ijn)-zc(ijp))**2)
+
+ ! Dx = w * ( xc(ijn)-xc(ijp) ) * ( Fi(ijn)-Fi(ijp) )
+ ! Dy = w * ( yc(ijn)-yc(ijp) ) * ( Fi(ijn)-Fi(ijp) )
+ ! Dz = w * ( zc(ijn)-zc(ijp) ) * ( Fi(ijn)-Fi(ijp) )
+
+ ! b1(ijp) = b1(ijp) + Dx
+ ! b1(ijn) = b1(ijn) + Dx
+
+ ! b2(ijp) = b2(ijp) + Dy
+ ! b2(ijn) = b2(ijn) + Dy
+
+ ! b3(ijp) = b3(ijp) + Dz
+ ! b3(ijn) = b3(ijn) + Dz
+
+ ! enddo nb_loop2
+
+ enddo
+
+
+ ! Boundary faces:
+
+ do i=1,numBoundaryFaces
+ iface = numInnerFaces + i
+ ijp = owner(iface)
+ ijn = numCells+i
+
+ w = 1./((xf(i)-xc(ijp))**2+(yf(i)-yc(ijp))**2+(zf(i)-zc(ijp))**2)
+
+ Dx = w*(Fi(ijn)-Fi(ijp))*(xf(iface)-xc(ijp))
+ Dy = w*(Fi(ijn)-Fi(ijp))*(yf(iface)-yc(ijp))
+ Dz = w*(Fi(ijn)-Fi(ijp))*(zf(iface)-zc(ijp))
+
+ b1(ijp) = b1(ijp) + Dx
+ b2(ijp) = b2(ijp) + Dy
+ b3(ijp) = b3(ijp) + Dz
+
+ end do
+
+ ! Calculate gradient
+
+ do inp=1,numCells
+
+ dFidxi(1,inp) = b1(inp)*Dmat(1,inp) - b2(inp)*Dmat(2,inp) + b3(inp)*Dmat(3,inp)
+ dFidxi(2,inp) = b1(inp)*Dmat(4,inp) - b2(inp)*Dmat(5,inp) - b3(inp)*Dmat(6,inp)
+ dFidxi(3,inp) = b1(inp)*Dmat(7,inp) - b2(inp)*Dmat(8,inp) + b3(inp)*Dmat(9,inp)
+
+ enddo
+
+
+ endif
+
+end subroutine
+
+
+
+
+! Gauss gradients
+subroutine grad_gauss(u,dudx,dudy,dudz)
+!
+!***********************************************************************
+!
+! Calculates cell centered gradient using gauss theorem
+! parameters
+! u - field, the gradient of which we are looking for
+! dudx,dudy,dudz - arrays where the gradient components are stored
+!
+! gauss gradient rule:
+! -------> ->
+! grad(u) = 1/vol * sum_{i=1}^{i=nf} (u)_f*sf
+! where:
+! grad(u) - cell centered gradient vector
+! (u)_f - face interpolated value of scalar u
+! vol - cell volume
+! sf - cell face area vector
+! nf - number of faces in a cell
+!
+!***********************************************************************
+!
+ use types
+ use geometry
+
+ implicit none
+
+ ! Arguments
+ real(dp), dimension(numTotal), intent(in) :: u
+ real(dp), dimension(numTotal), intent(inout) :: dudx,dudy,dudz
+
+ ! Local
+ integer :: i,ijp,ijn,ijb,lc,iface
+ real(dp) :: volr
+ real(dp), dimension(numCells) :: dfxo,dfyo,dfzo
+
+ ! Initialize gradient
+ dfxo = 0.0_dp
+ dfyo = 0.0_dp
+ dfzo = 0.0_dp
+
+ ! Start iterative calculation of gradients
+ do lc = 1,1 !nigrad
+
+ ! Initialize new gradient
+ dudx = 0.0_dp
+ dudy = 0.0_dp
+ dudz = 0.0_dp
+
+ ! Calculate terms integrated over surfaces
+
+ ! Inner face
+ do i=1,numInnerFaces
+ ijp = owner(i)
+ ijn = neighbour(i)
+ call gradco(ijp, ijn, xf(i), yf(i), zf(i), arx(i), ary(i), arz(i), facint(i), &
+ u, dfxo, dfyo, dfzo, dudx, dudy, dudz)
+ enddo
+
+ ! Contribution from boundaries
+
+ do i=1,numBoundaryFaces
+ iface = numInnerFaces + i
+ ijp = owner(iface)
+ ijb = numCells + i
+ call gradbc(arx(iface), ary(iface), arz(iface), u(ijb), dudx(ijp), dudy(ijp), dudz(ijp))
+ enddo
+
+
+ ! Calculate gradient components at cv-centers
+ do ijp=1,numCells
+ volr=1.0_dp/vol(ijp)
+ dudx(ijp)=dudx(ijp)*volr
+ dudy(ijp)=dudy(ijp)*volr
+ dudz(ijp)=dudz(ijp)*volr
+ enddo
+
+ ! Set old gradient = new gradient for the next iteration
+ if(lc.ne.2) then
+ dfxo=dudx
+ dfyo=dudy
+ dfzo=dudz
+ endif
+
+ enddo ! lc-loop
+
+end subroutine
+
+
+
+! Corrected Gauss gradients
+subroutine grad_gauss_corrected(u,dudx,dudy,dudz)
+!
+!***********************************************************************
+!
+! Calculates cell centered gradient using gauss theorem
+! parameters
+! u - field, the gradient of which we are looking for
+! dudx,dudy,dudz - arrays where the gradient components are stored
+!
+! gauss gradient rule:
+! -------> ->
+! grad(u) = 1/vol * sum_{i=1}^{i=nf} (u)_f*sf
+! where:
+! grad(u) - cell centered gradient vector
+! (u)_f - face interpolated value of scalar u
+! vol - cell volume
+! sf - cell face area vector
+! nf - number of faces in a cell
+!
+!***********************************************************************
+!
+ use types
+ use geometry
+
+ implicit none
+
+ ! Arguments
+ real(dp), dimension(numTotal), intent(in) :: u
+ real(dp), dimension(numCells), intent(inout) :: dudx,dudy,dudz
+
+ ! Local
+ integer :: i,ijp,ijn,ijb,iface
+ real(dp) :: volr
+ real(dp), dimension(numCells) :: dfxo,dfyo,dfzo
+
+ ! Initialize gradient with lsq gradient
+ dfxo = dudx
+ dfyo = dudy
+ dfzo = dudz
+
+ ! Initialize new gradient
+ dudx = 0.0_dp
+ dudy = 0.0_dp
+ dudz = 0.0_dp
+
+ ! Calculate terms integrated over surfaces
+
+ ! Inner face
+ do i=1,numInnerFaces
+ ijp = owner(i)
+ ijn = neighbour(i)
+ call gradco(ijp, ijn, xf(i), yf(i), zf(i), arx(i), ary(i), arz(i), facint(i), &
+ u, dfxo, dfyo, dfzo, dudx, dudy, dudz)
+ enddo
+
+ ! Contribution from boundaries
+ do i=1,numBoundaryFaces
+ iface = numInnerFaces + i
+ ijp = owner(iface)
+ ijb = numCells + i
+ call gradbc(arx(iface), ary(iface), arz(iface), u(ijb), dudx(ijp), dudy(ijp), dudz(ijp))
+ enddo
+
+
+ ! Calculate gradient components at cv-centers
+ do ijp=1,numCells
+ volr=1.0_dp/vol(ijp)
+ dudx(ijp)=dudx(ijp)*volr
+ dudy(ijp)=dudy(ijp)*volr
+ dudz(ijp)=dudz(ijp)*volr
+ enddo
+
+end subroutine
+
+subroutine gradco(ijp,ijn, &
+ xfc,yfc,zfc,sx,sy,sz,fif, &
+ fi,dfxo,dfyo,dfzo,dfx,dfy,dfz)
+!=======================================================================
+! This routine calculates contribution to the gradient
+! vector of a scalar FI at the CV center, arising from
+! an inner cell face (cell-face value of FI times the
+! corresponding component of the surface vector).
+!=======================================================================
+ use types
+ use parameters
+ use geometry
+
+ implicit none
+
+ integer, intent(in) :: ijp,ijn
+ real(dp), intent(in) :: xfc,yfc,zfc
+ real(dp), intent(in) :: sx,sy,sz
+ real(dp), intent(in) :: fif
+ real(dp), dimension(numTotal), intent(in) :: fi
+ real(dp), dimension(numCells), intent(in) :: dfxo,dfyo,dfzo
+ real(dp), dimension(numCells), intent(inout) :: dfx,dfy,dfz
+
+
+ real(dp) :: xi,yi,zi,dfxi,dfyi,dfzi
+ real(dp) :: fie,dfxe,dfye,dfze
+ real(dp) :: fxn,fxp
+
+ !
+ ! Coordinates of point on the line connecting center and neighbor,
+ ! old gradient vector components interpolated for this location.
+
+ fxn = fif
+ fxp = 1.0d0-fxn
+
+ xi = xc(ijp)*fxp+xc(ijn)*fxn
+ yi = yc(ijp)*fxp+yc(ijn)*fxn
+ zi = zc(ijp)*fxp+zc(ijn)*fxn
+
+ dfxi = dfxo(ijp)*fxp+dfxo(ijn)*fxn
+ dfyi = dfyo(ijp)*fxp+dfyo(ijn)*fxn
+ dfzi = dfzo(ijp)*fxp+dfzo(ijn)*fxn
+
+ ! Value of the variable at cell-face center
+ fie = fi(ijp)*fxp+fi(ijn)*fxn + dfxi*(xfc-xi)+dfyi*(yfc-yi)+dfzi*(zfc-zi)
+
+
+ ! (interpolated mid-face value)x(area)
+ dfxe = fie*sx
+ dfye = fie*sy
+ dfze = fie*sz
+
+ ! Accumulate contribution at cell center and neighbour
+ dfx(ijp) = dfx(ijp)+dfxe
+ dfy(ijp) = dfy(ijp)+dfye
+ dfz(ijp) = dfz(ijp)+dfze
+
+ dfx(ijn) = dfx(ijn)-dfxe
+ dfy(ijn) = dfy(ijn)-dfye
+ dfz(ijn) = dfz(ijn)-dfze
+
+
+end subroutine
+
+subroutine gradbc(sx,sy,sz,fi,dfx,dfy,dfz)
+!=======================================================================
+! This routine calculates the contribution of a
+! boundary cell face to the gradient at CV-center.
+!=======================================================================
+ use types
+
+ implicit none
+
+ real(dp), intent(in) :: sx,sy,sz
+ real(dp), intent(in) :: fi
+ real(dp), intent(inout) :: dfx,dfy,dfz
+
+ dfx = dfx + fi*sx
+ dfy = dfy + fi*sy
+ dfz = dfz + fi*sz
+
+end subroutine
+
+
+!******************************************************************************
+!
+subroutine sngrad_scalar_field(ijp, ijn, xf, yf, zf, arx, ary, arz, lambda, &
+ Fi, dFidxi, nrelax, approach, dfixi, dfiyi, dfizi, &
+ dfixii, dfiyii, dfizii)
+!
+!******************************************************************************
+!
+! Surface normal gradient with non-orthogonal correction done in two
+! possible ways - either by skewness correction of intersection point
+! offset.
+!
+! Check out reference paper:
+! Mirkov, Rasuo, Kenjeres, JCP, Vol. 287, 2015.
+!
+!******************************************************************************
+!
+ implicit none
+!
+!******************************************************************************
+!
+ integer, intent(in) :: ijp, ijn
+ real(dp), intent(in) :: xf,yf,zf
+ real(dp), intent(in) :: arx, ary, arz
+ real(dp), intent(in) :: lambda
+ real(dp), dimension(numTotal), intent(in) :: Fi
+ real(dp), dimension(3,numTotal), intent(in) :: dFidxi
+ integer, intent(in) :: nrelax
+ character(len=12) :: approach
+ real(dp), intent(out) :: dfixi, dfiyi, dfizi, dfixii, dfiyii, dfizii
+!
+! Locals
+!
+ real(dp) :: are,vole
+ real(dp) :: xpn,ypn,zpn
+ real(dp) :: nxx,nyy,nzz
+ real(dp) :: ixi1,ixi2,ixi3
+ real(dp) :: dpn,costheta,costn
+
+ real(dp) :: d1x,d1y,d1z
+ real(dp) :: d2x,d2y,d2z
+ real(dp) :: fxp,fxn
+
+ real(dp) :: xpp,ypp,zpp,xep,yep,zep,xpnp,ypnp,zpnp,volep
+ real(dp) :: nablaFIxdnnp,nablaFIxdppp
+
+!
+!******************************************************************************
+!
+
+ ! > Geometry:
+
+ ! Face interpolation factor
+ fxn=lambda
+ fxp=1.0_dp-lambda
+
+ ! Distance vector between cell centers
+ xpn=xc(ijn)-xc(ijp)
+ ypn=yc(ijn)-yc(ijp)
+ zpn=zc(ijn)-zc(ijp)
+
+ ! Distance from P to neighbor N
+ dpn=sqrt(xpn**2+ypn**2+zpn**2)
+
+ ! cell face area
+ are=sqrt(arx**2+ary**2+arz**2)
+
+ ! Components of the unit vector i_ksi
+ ixi1=xpn/dpn
+ ixi2=ypn/dpn
+ ixi3=zpn/dpn
+
+ ! Unit vectors of the face normal
+ nxx=arx/are
+ nyy=ary/are
+ nzz=arz/are
+
+ ! Angle between vectorsa n and i_xi - we need cosine
+ costheta=nxx*ixi1+nyy*ixi2+nzz*ixi3
+
+ ! Relaxation factor for higher-order cell face gradient
+ ! In general, nrelax can be any signed integer from some
+ ! reasonable interval [-nrelax,nrelax] (or maybe even real number):
+ !costn = costheta**nrelax
+
+ costn = 1.0_dp
+
+ if(nrelax == 1) then
+ ! Minimal correction: nrelax = +1 :
+ costn = costheta
+ elseif(nrelax == 0) then
+ ! Orthogonal correction: nrelax = 0 :
+ costn = 1.0_dp
+ elseif(nrelax == -1) then
+ ! Over-relaxed approach: nrelax = -1 :
+ costn = 1.0_dp/costheta
+ endif
+
+ ! dpp_j * sf
+ vole=xpn*arx+ypn*ary+zpn*arz
+
+
+ ! Interpolate gradients defined at CV centers to faces
+ dfixi = dFidxi(1,ijp)*fxp+dFidxi(1,ijn)*fxn
+ dfiyi = dFidxi(2,ijp)*fxp+dFidxi(2,ijn)*fxn
+ dfizi = dFidxi(3,ijp)*fxp+dFidxi(3,ijn)*fxn
+
+
+ !-- Skewness correction -->
+ if (adjustl(approach) == 'skewness') then
+
+ ! Overrelaxed correction vector d2, where s=dpn+d2
+ d1x = costn
+ d1y = costn
+ d1z = costn
+
+ d2x = xpn*costn
+ d2y = ypn*costn
+ d2z = zpn*costn
+
+ !.....du/dx_i interpolated at cell face:
+ dfixii = dfixi*d1x + arx/vole*( fi(ijn)-fi(ijp)-dfixi*d2x-dfiyi*d2y-dfizi*d2z )
+ dfiyii = dfiyi*d1y + ary/vole*( fi(ijn)-fi(ijp)-dfixi*d2x-dfiyi*d2y-dfizi*d2z )
+ dfizii = dfizi*d1z + arz/vole*( fi(ijn)-fi(ijp)-dfixi*d2x-dfiyi*d2y-dfizi*d2z )
+
+ ! |-- Intersection point offset and skewness correction -->
+
+
+ elseif (adjustl(approach) == 'offset') then
+
+ ! Find points P' and Pj'
+ xpp=xf-(xf-xc(ijp))*nxx
+ ypp=yf-(yf-yc(ijp))*nyy
+ zpp=zf-(zf-zc(ijp))*nzz
+
+ xep=xf-(xf-xc(ijn))*nxx
+ yep=yf-(yf-yc(ijn))*nyy
+ zep=zf-(zf-zc(ijn))*nzz
+
+ xpnp = xep-xpp
+ ypnp = yep-ypp
+ zpnp = zep-zpp
+
+ volep = arx*xpnp+ary*ypnp+arz*zpnp
+
+ ! Overrelaxed correction vector d2, where S=dpn+d2
+ d1x = costn
+ d1y = costn
+ d1z = costn
+
+ xpnp = xpnp*costn
+ ypnp = ypnp*costn
+ zpnp = zpnp*costn
+
+ ! The cell face interpolated gradient (d phi / dx_i)_j:
+ ! Nonorthogonal corrections: ___
+ ! nablaFIxdnnp =>> dot_product(dFidxi,dNN')
+ ! And: ___
+ ! nablaFIxdnnp =>> dot_product(dFidxi,dPP')
+ nablaFIxdnnp = dFidxi(1,ijn)*(xep-xc(ijn))+dFidxi(2,ijn)*(yep-yc(ijn))+dFidxi(3,ijn)*(zep-zc(ijn))
+ nablaFIxdppp = dFidxi(1,ijp)*(xpp-xc(ijp))+dFidxi(2,ijp)*(ypp-yc(ijp))+dFidxi(3,ijp)*(zpp-zc(ijp))
+
+ dfixii = dfixi*d1x + arx/volep*( fi(ijn)+nablaFIxdnnp-fi(ijp)-nablaFixdppp-dfixi*xpnp-dfiyi*ypnp-dfizi*zpnp )
+ dfiyii = dfiyi*d1y + ary/volep*( fi(ijn)+nablaFIxdnnp-fi(ijp)-nablaFixdppp-dfixi*xpnp-dfiyi*ypnp-dfizi*zpnp )
+ dfizii = dfizi*d1z + arz/volep*( fi(ijn)+nablaFIxdnnp-fi(ijp)-nablaFixdppp-dfixi*xpnp-dfiyi*ypnp-dfizi*zpnp )
+
+ !-- Uncorrected -->
+ elseif (adjustl(approach) == 'uncorrected') then
+
+ dfixii = dfixi
+ dfiyii = dfiyi
+ dfizii = dfizi
+
+ endif
+
+
+end subroutine
+
+
+!******************************************************************************
+!
+subroutine sngrad_vector_field(ijp, ijn, xf, yf, zf, arx, ary, arz, lambda, &
+ u,v,w, dudxi,dvdxi,dwdxi, nrelax, approach, &
+ duxi, duyi, duzi, dvxi, dvyi, dvzi, dwxi, dwyi, dwzi, &
+ duxii, dvxii, dwxii, duyii, dvyii, dwyii, duzii, dvzii, dwzii)
+!
+!******************************************************************************
+!
+! Surface normal gradient with non-orthogonal correction done in two
+! possible ways - either by skewness correction of intersection point
+! offset.
+!
+! Check out reference paper:
+! Mirkov, Rasuo, Kenjeres, JCP, Vol. 287, 2015.
+!
+! Note: same as above, just for vector field.
+!
+!******************************************************************************
+!
+ implicit none
+!
+!******************************************************************************
+!
+ integer, intent(in) :: ijp, ijn
+ integer, intent(in) :: nrelax
+ character(len=12) :: approach
+ real(dp), intent(in) :: xf,yf,zf
+ real(dp), intent(in) :: arx, ary, arz
+ real(dp), intent(in) :: lambda
+ real(dp), dimension(numTotal), intent(in) :: u,v,w
+ real(dp), dimension(3,numTotal), intent(in) :: dudxi,dvdxi,dwdxi
+ real(dp), intent(out) :: duxi,duyi,duzi,dvxi,dvyi,dvzi,dwxi,dwyi,dwzi
+ real(dp), intent(out) :: duxii,dvxii,dwxii,duyii,dvyii,dwyii,duzii,dvzii,dwzii
+
+ call sngrad(ijp, ijn, xf, yf, zf, arx, ary, arz, lambda, &
+ u, dudxi, nrelax, approach, duxi, duyi, duzi, duxii, duyii, duzii)
+
+ call sngrad(ijp, ijn, xf, yf, zf, arx, ary, arz, lambda, &
+ v, dvdxi, nrelax, approach, dvxi, dvyi, dvzi, dvxii, dvyii, dvzii)
+
+ call sngrad(ijp, ijn, xf, yf, zf, arx, ary, arz, lambda, &
+ w, dwdxi, nrelax, approach, dwxi, dwyi, dwzi, dwxii, dwyii, dwzii)
+
+end subroutine
+
+
+end module gradients
\ No newline at end of file
diff --git a/src/finiteVolume/fvExplicit/gradients.f90 b/src/finiteVolume/fvExplicit/gradients.f90
index 3ace49f..01883bd 100644
--- a/src/finiteVolume/fvExplicit/gradients.f90
+++ b/src/finiteVolume/fvExplicit/gradients.f90
@@ -4,8 +4,7 @@ module gradients
!
use types
-use parameters
-use geometry, only: numCells,numTotal,xc,yc,zc
+use geometry
use sparse_matrix, only: ioffset,ja,diag
implicit none
@@ -13,14 +12,16 @@ module gradients
logical :: lstsq, lstsq_qr, lstsq_dm, gauss ! Gradient discretization approach
character(len=20) :: limiter ! Gradient limiter. Options: none, Barth-Jespersen, Venkatakrishnan, mVenkatakrishnan
-real(dp),dimension(:,:), allocatable :: dmat ! d(6,nxyz) - when using bn, or dm version of the subroutine
-real(dp),dimension(:,:,:), allocatable :: dmatqr ! when using qr version of the subroutine size(3,6,nxyz)!
+real(dp),dimension(:,:), allocatable :: Dmat ! d(6,nxyz) - when using bn, or dm version of the subroutine
+real(dp),dimension(:,:,:), allocatable :: D ! when using qr version of the subroutine size(3,6,nxyz)!
+real(dp), parameter :: small = 1e-20
+real(dp), parameter :: zero = 0.0_dp
interface grad
module procedure grad_scalar_field
module procedure grad_vector_field
- module procedure grad_scalar_field_w_option
+ module procedure grad_scalar_field_w_option
end interface
interface sngrad
@@ -32,7 +33,7 @@ module gradients
private
public :: lstsq, lstsq_qr, lstsq_dm, gauss,limiter
-public :: grad,sngrad,create_lsq_grad_matrix
+public :: grad,grad_gauss,grad_gauss_corrected,sngrad,create_lsq_grad_matrix
@@ -51,13 +52,13 @@ subroutine allocate_lsq_grad_matrix
if( lstsq .or. lstsq_dm ) then
- allocate(dmat(9,numCells),stat=ierr)
- if(ierr /= 0)write(*,*)"allocation error: dmat"
+ allocate( Dmat(9,numCells), stat=ierr )
+ if(ierr /= 0)write(*,*)"allocation error: Dmat"
elseif( lstsq_qr ) then
- allocate(dmatqr(3,6,numCells),stat=ierr)
- if(ierr /= 0)write(*,*)"allocation error: dmatqr"
+ allocate( D(3,6,numCells), stat=ierr )
+ if(ierr /= 0)write(*,*)"allocation error: D"
endif
@@ -73,7 +74,7 @@ subroutine create_lsq_grad_matrix(phi,dPhidxi)
! Discussion:
! Prepare System Matrix For Least-Squares Gradient Calculation.
! It is done by setting this --v value to one.
-! call grad_lsq(U,dUdxi,1,D)
+! call grad_lsq(U,dUdxi,1)
!
!***********************************************************************
!
@@ -88,15 +89,15 @@ subroutine create_lsq_grad_matrix(phi,dPhidxi)
if (lstsq) then
- call grad_lsq(phi,dPhidxi,1,dmat)
+ call grad_lsq(phi,dPhidxi,1)
elseif (lstsq_qr) then
- call grad_lsq_qr(phi,dPhidxi,1,dmatqr)
+ call grad_lsq_qr(phi,dPhidxi,1)
elseif (lstsq_dm) then
- call grad_lsq_dm(phi,dPhidxi,1,dmat)
+ call grad_lsq_dm(phi,dPhidxi,1)
endif
@@ -119,26 +120,25 @@ subroutine grad_scalar_field(phi,dPhidxi)
if (lstsq) then
- call grad_lsq(phi,dPhidxi,2,dmat)
+ call grad_lsq(phi,dPhidxi,2)
elseif (lstsq_qr) then
- call grad_lsq_qr(phi,dPhidxi,2,dmatqr)
+ call grad_lsq_qr(phi,dPhidxi,2)
elseif (lstsq_dm) then
- call grad_lsq_dm(phi,dPhidxi,2,dmat)
+ call grad_lsq_dm(phi,dPhidxi,2)
- elseif ( (lstsq_qr .and. gauss) .or. (lstsq .and. gauss) ) then
+ elseif ( lstsq_dm .and. gauss ) then
- ! Using the lstsq or lstsq_qr switch the Least-squares gradients are already calculated above
- ! Using these we perform more precise interpolation of our variable to faces and get
- ! conservative gradients using Gauss rule.
- call grad_gauss_corrected(phi,dPhidxi(1,:),dPhidxi(2,:),dPhidxi(3,:))
+ call grad_lsq_dm(phi,dPhidxi,2)
+
+ call grad_gauss_corrected(phi,dPhidxi)
else
- call grad_gauss(phi,dPhidxi(1,:),dPhidxi(2,:),dPhidxi(3,:))
+ call grad_gauss(phi,dPhidxi)
endif
@@ -185,25 +185,28 @@ subroutine grad_vector_field(U,V,W,dUdxi,dVdxi,dWdxi)
dWdxi=0.0_dp
if (lstsq) then
- call grad_lsq(U,dUdxi,2,dmat)
- call grad_lsq(V,dVdxi,2,dmat)
- call grad_lsq(W,dWdxi,2,dmat)
+ call grad_lsq(U,dUdxi,2)
+ call grad_lsq(V,dVdxi,2)
+ call grad_lsq(W,dWdxi,2)
elseif (lstsq_qr) then
- call grad_lsq_qr(U,dUdxi,2,dmatqr)
- call grad_lsq_qr(V,dVdxi,2,dmatqr)
- call grad_lsq_qr(W,dWdxi,2,dmatqr)
+ call grad_lsq_qr(U,dUdxi,2)
+ call grad_lsq_qr(V,dVdxi,2)
+ call grad_lsq_qr(W,dWdxi,2)
elseif (lstsq_dm) then
- call grad_lsq_dm(U,dUdxi,2,dmat)
- call grad_lsq_dm(V,dVdxi,2,dmat)
- call grad_lsq_dm(W,dWdxi,2,dmat)
- elseif ( (lstsq_qr .and. gauss) .or. (lstsq .and. gauss) ) then
- call grad_gauss_corrected(U,dUdxi(1,:),dUdxi(2,:),dUdxi(3,:))
- call grad_gauss_corrected(V,dVdxi(1,:),dVdxi(2,:),dVdxi(3,:))
- call grad_gauss_corrected(W,dWdxi(1,:),dWdxi(2,:),dWdxi(3,:))
+ call grad_lsq_dm(U,dUdxi,2)
+ call grad_lsq_dm(V,dVdxi,2)
+ call grad_lsq_dm(W,dWdxi,2)
+ elseif ( (lstsq_dm .and. gauss) ) then
+ call grad_lsq_dm(U,dUdxi,2)
+ call grad_lsq_dm(V,dVdxi,2)
+ call grad_lsq_dm(W,dWdxi,2)
+ call grad_gauss_corrected(U,dUdxi)
+ call grad_gauss_corrected(V,dVdxi)
+ call grad_gauss_corrected(W,dWdxi)
else
- call grad_gauss(U,dUdxi(1,:),dUdxi(2,:),dUdxi(3,:))
- call grad_gauss(V,dVdxi(1,:),dVdxi(2,:),dVdxi(3,:))
- call grad_gauss(W,dWdxi(1,:),dWdxi(2,:),dWdxi(3,:))
+ call grad_gauss(U,dUdxi)
+ call grad_gauss(V,dVdxi)
+ call grad_gauss(W,dWdxi)
endif
end subroutine
@@ -235,23 +238,23 @@ subroutine grad_scalar_field_w_option(phi,dPhidxi,option,option_limiter)
if ( option == 'lsq' ) then
- call grad_lsq(phi,dPhidxi,2,dmat)
+ call grad_lsq(phi,dPhidxi,2)
elseif ( option == 'lsq_qr' ) then
- call grad_lsq_qr(phi,dPhidxi,2,dmatqr)
+ call grad_lsq_qr(phi,dPhidxi,2)
- elseif ( option == 'weighted_lsq' ) then
+ elseif ( option == 'wlsq' ) then
- call grad_lsq_dm(phi,dPhidxi,2,dmat)
+ call grad_lsq_dm(phi,dPhidxi,2)
elseif ( option == 'gauss_corrected' ) then
- call grad_gauss_corrected(phi,dPhidxi(1,:),dPhidxi(2,:),dPhidxi(3,:))
+ call grad_gauss_corrected(phi,dPhidxi)
elseif ( option == 'gauss' ) then
- call grad_gauss(phi,dPhidxi(1,:),dPhidxi(2,:),dPhidxi(3,:))
+ call grad_gauss(phi,dPhidxi)
endif
@@ -280,6 +283,8 @@ subroutine grad_scalar_field_w_option(phi,dPhidxi,option,option_limiter)
end subroutine
+
+
!***********************************************************************
!
subroutine slope_limiter_modified_Venkatakrishnan(phi, dPhidxi)
@@ -297,12 +302,12 @@ subroutine slope_limiter_modified_Venkatakrishnan(phi, dPhidxi)
implicit none
- ! Input
+ ! Input
real(dp),dimension(numTotal) :: phi
real(dp),dimension(3,numTotal) :: dPhidxi
- ! Locals
+ ! Locals
integer :: inp,ijp,ijn,k
! Look at the reference epsprim \in [0.01,0.2]
@@ -393,12 +398,12 @@ subroutine slope_limiter_Barth_Jespersen(phi, dPhidxi)
implicit none
- ! Input
+ ! Input
real(dp),dimension(numTotal) :: phi
real(dp),dimension(3,numTotal) :: dPhidxi
- ! Locals
+ ! Locals
integer :: inp,ijp,ijn,k
real(dp) :: phi_p
real(dp) :: slopelimit
@@ -451,7 +456,7 @@ subroutine slope_limiter_Barth_Jespersen(phi, dPhidxi)
slopelimit = min( slopelimit , r )
enddo
- !print*,slopelimit
+
dPhidxi(:,inp) = slopelimit*dPhidxi(:,inp)
enddo
@@ -478,12 +483,12 @@ subroutine slope_limiter_Venkatakrishnan(phi, dPhidxi)
implicit none
- ! Input
+ ! Input
real(dp),dimension(numTotal) :: phi
real(dp),dimension(3,numTotal) :: dPhidxi
- ! Locals
+ ! Locals
integer :: inp,ijp,ijn,k
real(dp) :: phi_p
real(dp) :: slopelimit
@@ -551,23 +556,23 @@ subroutine slope_limiter_multidimensional(phi, dPhidxi)
!
!***********************************************************************
!
-! Calculates slope limiter and applies to scalar gradient:
-! Multidimensional slope limiter
-! Ref.: SE Kim, B Makarov, D Caraeni - A Multi-Dimensional Linear
-! Reconstruction Scheme for Arbitrary Unstructured Meshes, AIAA 2003-3990.
-! The same slope limiter is used in Fluent.
+! Calculates slope limiter and applies to scalar gradient:
+! Multidimensional slope limiter
+! Ref.: SE Kim, B Makarov, D Caraeni - A Multi-Dimensional Linear
+! Reconstruction Scheme for Arbitrary Unstructured Meshes, AIAA 2003-3990.
+! The same slope limiter is used in Fluent.
!
!***********************************************************************
!
implicit none
- ! Input
+ ! Input
real(dp),dimension(numTotal) :: phi
real(dp),dimension(3,numTotal) :: dPhidxi
- ! Locals
+ ! Locals
integer :: inp,ijp,ijn,k
real(dp) :: phi_max,phi_min
real(dp) :: dPhi,dPhimax,dPhimin
@@ -662,7 +667,7 @@ subroutine slope_limiter_multidimensional(phi, dPhidxi)
! Least square gradients
-subroutine grad_lsq(fi,dFidxi,istage,dmat)
+subroutine grad_lsq(Phi,dPhidxi,istage)
!
!***********************************************************************
!
@@ -675,36 +680,31 @@ subroutine grad_lsq(fi,dFidxi,istage,dmat)
!
! Arguments:
!
-! FI - field variable which gradient we look for.
-! DFiDXi - cell centered gradient - a three component gradient vector.
+! Phi - field variable which gradient we look for.
+! DPhiDXi - cell centered gradient - a three component gradient vector.
! ISTAGE - integer. If ISTAGE=1 calculates and stores only geometrical
! parameters - a system matrix for least square problem at every cell.
! Usually it is called with ISTAGE=1 at the beggining of simulation.
! If 2 it doesn't calculate system matrix, just RHS and solves system.
-! Dmat - LSQ matrix with geometry data
!
! Example call:
-! CALL GRADFI_LSQ(U,DUDXI,2,D)
+! CALL GRADFI_LSQ(U,DUDXI,2)
!
!***********************************************************************
!
- use types
- use parameters
- use geometry
implicit none
integer, intent(in) :: istage
- real(dp),dimension(numTotal), intent(in) :: fi
- real(dp),dimension(3,numTotal), intent(inout) :: dFidxi
- real(dp),dimension(9,numCells), intent(inout) :: dmat
+ real(dp),dimension(numTotal), intent(in) :: Phi
+ real(dp),dimension(3,numTotal), intent(inout) :: dPhidxi
!
! Locals
!
integer :: i,ijp,ijn,inp,iface
- real(dp), dimension(numCells) :: b1,b2,b3
+ real(dp) :: b1,b2,b3
real(dp) :: Dx,Dy,Dz
real(dp) :: d11,d12,d13,d21,d22,d23,d31,d32,d33,tmp
!
@@ -714,8 +714,8 @@ subroutine grad_lsq(fi,dFidxi,istage,dmat)
if(istage.eq.1) then
! Coefficient matrix - should be calculated only once
- ! Initialize dmat matrix:
- dmat = 0.0_dp
+ ! Initialize Dmat matrix:
+ Dmat = 0.0_dp
! Inner faces:
do i=1,numInnerFaces
@@ -804,11 +804,17 @@ subroutine grad_lsq(fi,dFidxi,istage,dmat)
elseif(istage.eq.2) then
!...
- ! Initialize rhs vector
- b1 = 0.0_dp
- b2 = 0.0_dp
- b3 = 0.0_dp
+ !
+ ! *** COMMENT: ***
+ ! We want to save space, so we will reuse dPhidx,dPhidy,dPhidz
+ ! to store rhs vectors. These were, in earlier version, denoted
+ ! with 'b1','b2', 'b3' respectively.
+ ! This way it is maybe hardrer to read code but introduces great savings,
+ ! because each of 'b1','b2', 'b3' should be numCells long!
+ !
+ ! Initialize rhs vector
+ dPhidxi = 0.0_dp
! Inner faces:
@@ -816,18 +822,17 @@ subroutine grad_lsq(fi,dFidxi,istage,dmat)
ijp = owner(i)
ijn = neighbour(i)
- Dx = ( xc(ijn)-xc(ijp) ) * ( Fi(ijn)-Fi(ijp) )
- Dy = ( yc(ijn)-yc(ijp) ) * ( Fi(ijn)-Fi(ijp) )
- Dz = ( zc(ijn)-zc(ijp) ) * ( Fi(ijn)-Fi(ijp) )
+ Dx = ( xc(ijn)-xc(ijp) ) * ( Phi(ijn)-Phi(ijp) )
+ Dy = ( yc(ijn)-yc(ijp) ) * ( Phi(ijn)-Phi(ijp) )
+ Dz = ( zc(ijn)-zc(ijp) ) * ( Phi(ijn)-Phi(ijp) )
- b1(ijp) = b1(ijp) + Dx
- b1(ijn) = b1(ijn) + Dx
+ dPhidxi(1,ijp) = dPhidxi(1,ijp) + Dx
+ dPhidxi(2,ijp) = dPhidxi(2,ijp) + Dy
+ dPhidxi(3,ijp) = dPhidxi(3,ijp) + Dz
- b2(ijp) = b2(ijp) + Dy
- b2(ijn) = b2(ijn) + Dy
-
- b3(ijp) = b3(ijp) + Dz
- b3(ijn) = b3(ijn) + Dz
+ dPhidxi(1,ijn) = dPhidxi(1,ijn) + Dx
+ dPhidxi(2,ijn) = dPhidxi(2,ijn) + Dy
+ dPhidxi(3,ijn) = dPhidxi(3,ijn) + Dz
enddo
@@ -838,13 +843,13 @@ subroutine grad_lsq(fi,dFidxi,istage,dmat)
ijp = owner(iface)
ijn = numCells + i
- Dx = (Fi(ijn)-Fi(ijp))*(xf(iface)-xc(ijp))
- Dy = (Fi(ijn)-Fi(ijp))*(yf(iface)-yc(ijp))
- Dz = (Fi(ijn)-Fi(ijp))*(zf(iface)-zc(ijp))
+ Dx = (Phi(ijn)-Phi(ijp))*(xf(iface)-xc(ijp))
+ Dy = (Phi(ijn)-Phi(ijp))*(yf(iface)-yc(ijp))
+ Dz = (Phi(ijn)-Phi(ijp))*(zf(iface)-zc(ijp))
- b1(ijp) = b1(ijp) + Dx
- b2(ijp) = b2(ijp) + Dy
- b3(ijp) = b3(ijp) + Dz
+ dPhidxi(1,ijp) = dPhidxi(1,ijp) + Dx
+ dPhidxi(2,ijp) = dPhidxi(2,ijp) + Dy
+ dPhidxi(3,ijp) = dPhidxi(3,ijp) + Dz
enddo
@@ -855,9 +860,13 @@ subroutine grad_lsq(fi,dFidxi,istage,dmat)
do inp=1,numCells
- dFidxi(1,inp) = b1(inp)*Dmat(1,inp) - b2(inp)*Dmat(2,inp) + b3(inp)*Dmat(3,inp)
- dFidxi(2,inp) = b1(inp)*Dmat(4,inp) - b2(inp)*Dmat(5,inp) - b3(inp)*Dmat(6,inp)
- dFidxi(3,inp) = b1(inp)*Dmat(7,inp) - b2(inp)*Dmat(8,inp) + b3(inp)*Dmat(9,inp)
+ b1 = dPhidxi(1,inp)
+ b2 = dPhidxi(2,inp)
+ b3 = dPhidxi(3,inp)
+
+ dPhidxi(1,inp) = b1*Dmat(1,inp) - b2*Dmat(2,inp) + b3*Dmat(3,inp)
+ dPhidxi(2,inp) = b1*Dmat(4,inp) - b2*Dmat(5,inp) - b3*Dmat(6,inp)
+ dPhidxi(3,inp) = b1*Dmat(7,inp) - b2*Dmat(8,inp) + b3*Dmat(9,inp)
enddo
@@ -869,7 +878,7 @@ subroutine grad_lsq(fi,dFidxi,istage,dmat)
! Least square gradients via QR decomposition
!***********************************************************************
!
-subroutine grad_lsq_qr(fi,dfidxi,istage,d)
+subroutine grad_lsq_qr(Phi,dPhidxi,istage)
!
!***********************************************************************
!
@@ -884,8 +893,8 @@ subroutine grad_lsq_qr(fi,dfidxi,istage,d)
!
! Arguments:
!
-! FI - dependent field variable
-! dFIdxi - cell centered gradient - a three component gradient vector.
+! Phi - dependent field variable
+! dPhidxi - cell centered gradient - a three component gradient vector.
! ISTAGE - integer. If ISTAGE=1 calculates and stores only geometrical
! parameters - a system matrix for least square problem at every cell.
! Usually it is called with ISTAGE=1 at the beggining of simulation.
@@ -894,13 +903,11 @@ subroutine grad_lsq_qr(fi,dfidxi,istage,d)
! XC,YC,ZC - coordinates of cell centers
!
! Example call:
-! CALL dFIdxi_LSTSQ_QR(U,dUdxi,2,D)
+! CALL GRAD_LSTSQ_QR(U,dUdxi,2)
!
!***********************************************************************
!
- use types
- use parameters
- use geometry!, only:numCells,numInnerFaces,numBoundaryFaces,noc,owner,neighbour,ijl,ijr,xf,yf,zf,xc,yc,zc
+
use matrix_module
implicit none
@@ -908,9 +915,8 @@ subroutine grad_lsq_qr(fi,dfidxi,istage,d)
integer, parameter :: n=3, m=6 ! m is the number of neighbours, e.g. for structured 3D mesh it's 6
integer, intent(in) :: istage
- real(dp), dimension(numTotal), intent(in) :: fi
- real(dp), dimension(n,numCells), intent(inout) :: dFidxi
- real(dp), dimension(n,m,numCells), intent(inout) :: D
+ real(dp), dimension(numTotal), intent(in) :: Phi
+ real(dp), dimension(n,numCells), intent(inout) :: dPhidxi
!
! Locals
@@ -1048,11 +1054,11 @@ subroutine grad_lsq_qr(fi,dfidxi,istage,d)
neighbour_index(ijp) = neighbour_index(ijp) + 1
l = neighbour_index(ijp)
- b(l,ijp) = fi(ijn)-fi(ijp)
+ b(l,ijp) = Phi(ijn)-Phi(ijp)
neighbour_index(ijn) = neighbour_index(ijn) + 1
l = neighbour_index(ijn)
- b(l,ijn) = fi(ijp)-fi(ijn)
+ b(l,ijn) = Phi(ijp)-Phi(ijn)
enddo
@@ -1064,7 +1070,7 @@ subroutine grad_lsq_qr(fi,dfidxi,istage,d)
ijn = numCells + i
neighbour_index(ijp) = neighbour_index(ijp) + 1
l = neighbour_index(ijp)
- b(l,ijp) = fi(ijn)-fi(ijp)
+ b(l,ijp) = Phi(ijn)-Phi(ijp)
enddo
! Solve overdetermined system in least-sqare sense
@@ -1075,9 +1081,9 @@ subroutine grad_lsq_qr(fi,dfidxi,istage,d)
l = neighbour_index(inp)
! ...using precomputed QR factorization and storing R^(-1)*Q^T in D
- dFIdxi(1,INP) = sum(D(1,1:l,inp)*b(1:l,inp))
- dFIdxi(2,INP) = sum(D(2,1:l,inp)*b(1:l,inp))
- dFIdxi(3,INP) = sum(D(3,1:l,inp)*b(1:l,inp))
+ dPhidxi(1,INP) = sum(D(1,1:l,inp)*b(1:l,inp))
+ dPhidxi(2,INP) = sum(D(2,1:l,inp)*b(1:l,inp))
+ dPhidxi(3,INP) = sum(D(3,1:l,inp)*b(1:l,inp))
enddo
@@ -1090,7 +1096,7 @@ subroutine grad_lsq_qr(fi,dfidxi,istage,d)
! Weighted least square gradients
-subroutine grad_lsq_dm(fi,dFidxi,istage,dmat)
+subroutine grad_lsq_dm(Phi,dPhidxi,istage)
!
!***********************************************************************
!
@@ -1106,8 +1112,8 @@ subroutine grad_lsq_dm(fi,dFidxi,istage,dmat)
!
! Arguments:
!
-! FI - field variable which gradient we look for.
-! DFIDXi- cell centered gradient - a three component gradient vector.
+! Phi - field variable which gradient we look for.
+! dPhidxi- cell centered gradient - a three component gradient vector.
! ISTAGE - integer. If ISTAGE=1 calculates and stores only geometrical
! parameters - a system matrix for least square problem at every cell.
! Usually it is called with ISTAGE=1 at the beggining of simulation.
@@ -1115,20 +1121,16 @@ subroutine grad_lsq_dm(fi,dFidxi,istage,dmat)
! Dmat - LSQ matrix with geometry data
!
! Example call:
-! CALL GRADFI_LSQ_DM(U,DUDX,DUDY,DUDZ,2,D)
+! CALL GRADFI_LSQ_DM(U,DUDXI,2)
!
!***********************************************************************
!
- use types
- use parameters
- use geometry
implicit none
integer, intent(in) :: istage
- real(dp),dimension(numTotal), intent(in) :: fi
- real(dp),dimension(3,numTotal), intent(inout) :: dFidxi
- real(dp),dimension(9,numCells), intent(inout) :: dmat
+ real(dp),dimension(numTotal), intent(in) :: Phi
+ real(dp),dimension(3,numTotal), intent(inout) :: dPhidxi
!
! Locals
@@ -1140,7 +1142,7 @@ subroutine grad_lsq_dm(fi,dFidxi,istage,dmat)
real(dp) :: d11,d12,d13,d21,d22,d23,d31,d32,d33
real(dp) :: tmp
- real(dp), dimension(numCells) :: b1,b2,b3
+ real(dp) :: b1,b2,b3
!
!***********************************************************************
!
@@ -1149,40 +1151,83 @@ subroutine grad_lsq_dm(fi,dFidxi,istage,dmat)
! Coefficient matrix - should be calculated only once
! Initialize dmat matrix:
- dmat = 0.0d0
+ Dmat = 0.0d0
! Inner faces:
do i=1,numInnerFaces
- ijp = owner(i)
- ijn = neighbour(i)
+ ijp = owner(i)
- w = 1./((xc(ijn)-xc(ijp))**2+(yc(ijn)-yc(ijp))**2+(zc(ijn)-zc(ijp))**2)
+ !***------------------------------------
+ ijn = neighbour(i)
- Dx = xc(ijn)-xc(ijp)
- Dy = yc(ijn)-yc(ijp)
- Dz = zc(ijn)-zc(ijp)
+ w = 1./((xc(ijn)-xc(ijp))**2+(yc(ijn)-yc(ijp))**2+(zc(ijn)-zc(ijp))**2)
+
+ Dx = xc(ijn)-xc(ijp)
+ Dy = yc(ijn)-yc(ijp)
+ Dz = zc(ijn)-zc(ijp)
- Dmat(1,ijp) = Dmat(1,ijp) + w*Dx*Dx
- Dmat(1,ijn) = Dmat(1,ijn) + w*Dx*Dx
+ Dmat(1,ijp) = Dmat(1,ijp) + w*Dx*Dx
+ Dmat(1,ijn) = Dmat(1,ijn) + w*Dx*Dx
+
+ Dmat(4,ijp) = Dmat(4,ijp) + w*Dy*Dy
+ Dmat(4,ijn) = Dmat(4,ijn) + w*Dy*Dy
- Dmat(4,ijp) = Dmat(4,ijp) + w*Dy*Dy
- Dmat(4,ijn) = Dmat(4,ijn) + w*Dy*Dy
+ Dmat(6,ijp) = Dmat(6,ijp) + w*Dz*Dz
+ Dmat(6,ijn) = Dmat(6,ijn) + w*Dz*Dz
- Dmat(6,ijp) = Dmat(6,ijp) + w*Dz*Dz
- Dmat(6,ijn) = Dmat(6,ijn) + w*Dz*Dz
+ Dmat(2,ijp) = Dmat(2,ijp) + w*Dx*Dy
+ Dmat(2,ijn) = Dmat(2,ijn) + w*Dx*Dy
- Dmat(2,ijp) = Dmat(2,ijp) + w*Dx*Dy
- Dmat(2,ijn) = Dmat(2,ijn) + w*Dx*Dy
+ Dmat(3,ijp) = Dmat(3,ijp) + w*Dx*Dz
+ Dmat(3,ijn) = Dmat(3,ijn) + w*Dx*Dz
- Dmat(3,ijp) = Dmat(3,ijp) + w*Dx*Dz
- Dmat(3,ijn) = Dmat(3,ijn) + w*Dx*Dz
-
- Dmat(5,ijp) = Dmat(5,ijp) + w*Dy*Dz
- Dmat(5,ijn) = Dmat(5,ijn) + w*Dy*Dz
+ Dmat(5,ijp) = Dmat(5,ijp) + w*Dy*Dz
+ Dmat(5,ijn) = Dmat(5,ijn) + w*Dy*Dz
+ !***------------------------------------
+
+ ! !
+ ! ! **Extended interpolation molecule: neighbours of neighbours**
+ ! !
+ ! nb_loop: do k = ioffset( neighbour(i) ), ioffset( neighbour(i)+1 )-1
+
+ ! ijn = ja(k)
+
+ ! if (ijn == ijp) cycle nb_loop ! nemoj ownera dirati
+
+ ! ! Paznja kada je ja(k) = diag( neighbour(i) ) ijn ce uzeti samog cell_neighboura,
+ ! ! tako da ovaj loop moze uraditi isto sto i gornji, pa je u toj verziji
+ ! ! racunanja gradijenata ovaj loop gore nepotreban. Eto simplifikacije koda...
+
+ ! w = 1./((xc(ijn)-xc(ijp))**2+(yc(ijn)-yc(ijp))**2+(zc(ijn)-zc(ijp))**2)
+
+ ! Dx = xc(ijn)-xc(ijp)
+ ! Dy = yc(ijn)-yc(ijp)
+ ! Dz = zc(ijn)-zc(ijp)
+
+ ! Dmat(1,ijp) = Dmat(1,ijp) + w*Dx*Dx
+ ! Dmat(1,ijn) = Dmat(1,ijn) + w*Dx*Dx
+
+ ! Dmat(4,ijp) = Dmat(4,ijp) + w*Dy*Dy
+ ! Dmat(4,ijn) = Dmat(4,ijn) + w*Dy*Dy
+
+ ! Dmat(6,ijp) = Dmat(6,ijp) + w*Dz*Dz
+ ! Dmat(6,ijn) = Dmat(6,ijn) + w*Dz*Dz
+
+ ! Dmat(2,ijp) = Dmat(2,ijp) + w*Dx*Dy
+ ! Dmat(2,ijn) = Dmat(2,ijn) + w*Dx*Dy
+
+ ! Dmat(3,ijp) = Dmat(3,ijp) + w*Dx*Dz
+ ! Dmat(3,ijn) = Dmat(3,ijn) + w*Dx*Dz
+
+ ! Dmat(5,ijp) = Dmat(5,ijp) + w*Dy*Dz
+ ! Dmat(5,ijn) = Dmat(5,ijn) + w*Dy*Dz
+
+ ! enddo nb_loop
enddo
+
! Boundary faces:
do i=1,numBoundaryFaces
@@ -1243,31 +1288,69 @@ subroutine grad_lsq_dm(fi,dFidxi,istage,dmat)
elseif(istage.eq.2) then
!**************************************************************************************************
+ !
+ ! *** COMMENT: ***
+ ! We want to save space, so we will reuse dPhidx,dPhidy,dPhidz
+ ! to store rhs vectors. These were, in earlier version, denoted
+ ! with 'b1','b2', 'b3' respectively.
+ ! This way it is maybe hardrer to read code but introduces great savings,
+ ! because each of 'b1','b2', 'b3' should be numCells long!
+ !
+
! Initialize rhs vector
- b1 = 0.0d0
- b2 = 0.0d0
- b3 = 0.0d0
+ dPhidxi = 0.0_dp
! Inner faces:
do i=1,numInnerFaces
ijp = owner(i)
+
+ !***------------------------------------
ijn = neighbour(i)
w = 1./((xc(ijn)-xc(ijp))**2+(yc(ijn)-yc(ijp))**2+(zc(ijn)-zc(ijp))**2)
- Dx = w * ( xc(ijn)-xc(ijp) ) * ( Fi(ijn)-Fi(ijp) )
- Dy = w * ( yc(ijn)-yc(ijp) ) * ( Fi(ijn)-Fi(ijp) )
- Dz = w * ( zc(ijn)-zc(ijp) ) * ( Fi(ijn)-Fi(ijp) )
+ Dx = w * ( xc(ijn)-xc(ijp) ) * ( Phi(ijn)-Phi(ijp) )
+ Dy = w * ( yc(ijn)-yc(ijp) ) * ( Phi(ijn)-Phi(ijp) )
+ Dz = w * ( zc(ijn)-zc(ijp) ) * ( Phi(ijn)-Phi(ijp) )
+
+ dPhidxi(1,ijp) = dPhidxi(1,ijp) + Dx
+ dPhidxi(2,ijp) = dPhidxi(2,ijp) + Dy
+ dPhidxi(3,ijp) = dPhidxi(3,ijp) + Dz
+
+ dPhidxi(1,ijn) = dPhidxi(1,ijn) + Dx
+ dPhidxi(2,ijn) = dPhidxi(2,ijn) + Dy
+ dPhidxi(3,ijn) = dPhidxi(3,ijn) + Dz
+ !***------------------------------------
+
+ ! !
+ ! ! **Extended interpolation molecule: neighbours of neighbours**
+ ! !
+ ! nb_loop2: do k = ioffset( neighbour(i) ), ioffset( neighbour(i)+1 )-1
+
+ ! ijn = ja(k)
+
+ ! if (ijn == ijp) cycle nb_loop2 ! nemoj ownera dirati
- b1(ijp) = b1(ijp) + Dx
- b1(ijn) = b1(ijn) + Dx
+ ! ! Paznja kada je ja(k) = diag( neighbour(i) ) ijn ce uzeti samo cell_neighboura,
+ ! ! tako da ovaj loop moze uraditi isto sto i gornji, pa je u toj verziji
+ ! ! racunanja gradijenata ovaj loop gore nepotreban. Eto simplifikacije koda...
- b2(ijp) = b2(ijp) + Dy
- b2(ijn) = b2(ijn) + Dy
+ ! w = 1./((xc(ijn)-xc(ijp))**2+(yc(ijn)-yc(ijp))**2+(zc(ijn)-zc(ijp))**2)
- b3(ijp) = b3(ijp) + Dz
- b3(ijn) = b3(ijn) + Dz
+ ! Dx = w * ( xc(ijn)-xc(ijp) ) * ( Phi(ijn)-Phi(ijp) )
+ ! Dy = w * ( yc(ijn)-yc(ijp) ) * ( Phi(ijn)-Phi(ijp) )
+ ! Dz = w * ( zc(ijn)-zc(ijp) ) * ( Phi(ijn)-Phi(ijp) )
+
+ ! dPhidxi(1,ijp) = dPhidxi(1,ijp) + Dx
+ ! dPhidxi(2,ijp) = dPhidxi(2,ijp) + Dy
+ ! dPhidxi(3,ijp) = dPhidxi(3,ijp) + Dz
+
+ ! dPhidxi(1,ijn) = dPhidxi(1,ijn) + Dx
+ ! dPhidxi(2,ijn) = dPhidxi(2,ijn) + Dy
+ ! dPhidxi(3,ijn) = dPhidxi(3,ijn) + Dz
+
+ ! enddo nb_loop2
enddo
@@ -1281,13 +1364,13 @@ subroutine grad_lsq_dm(fi,dFidxi,istage,dmat)
w = 1./((xf(i)-xc(ijp))**2+(yf(i)-yc(ijp))**2+(zf(i)-zc(ijp))**2)
- Dx = w*(Fi(ijn)-Fi(ijp))*(xf(iface)-xc(ijp))
- Dy = w*(Fi(ijn)-Fi(ijp))*(yf(iface)-yc(ijp))
- Dz = w*(Fi(ijn)-Fi(ijp))*(zf(iface)-zc(ijp))
+ Dx = w*(Phi(ijn)-Phi(ijp))*(xf(iface)-xc(ijp))
+ Dy = w*(Phi(ijn)-Phi(ijp))*(yf(iface)-yc(ijp))
+ Dz = w*(Phi(ijn)-Phi(ijp))*(zf(iface)-zc(ijp))
- b1(ijp) = b1(ijp) + Dx
- b2(ijp) = b2(ijp) + Dy
- b3(ijp) = b3(ijp) + Dz
+ dPhidxi(1,ijp) = dPhidxi(1,ijp) + Dx
+ dPhidxi(2,ijp) = dPhidxi(2,ijp) + Dy
+ dPhidxi(3,ijp) = dPhidxi(3,ijp) + Dz
end do
@@ -1295,9 +1378,13 @@ subroutine grad_lsq_dm(fi,dFidxi,istage,dmat)
do inp=1,numCells
- dFidxi(1,inp) = b1(inp)*Dmat(1,inp) - b2(inp)*Dmat(2,inp) + b3(inp)*Dmat(3,inp)
- dFidxi(2,inp) = b1(inp)*Dmat(4,inp) - b2(inp)*Dmat(5,inp) - b3(inp)*Dmat(6,inp)
- dFidxi(3,inp) = b1(inp)*Dmat(7,inp) - b2(inp)*Dmat(8,inp) + b3(inp)*Dmat(9,inp)
+ b1 = dPhidxi(1,inp)
+ b2 = dPhidxi(2,inp)
+ b3 = dPhidxi(3,inp)
+
+ dPhidxi(1,inp) = b1*Dmat(1,inp) - b2*Dmat(2,inp) + b3*Dmat(3,inp)
+ dPhidxi(2,inp) = b1*Dmat(4,inp) - b2*Dmat(5,inp) - b3*Dmat(6,inp)
+ dPhidxi(3,inp) = b1*Dmat(7,inp) - b2*Dmat(8,inp) + b3*Dmat(9,inp)
enddo
@@ -1310,14 +1397,15 @@ subroutine grad_lsq_dm(fi,dFidxi,istage,dmat)
! Gauss gradients
-subroutine grad_gauss(u,dudx,dudy,dudz)
+subroutine grad_gauss(u,dudxi)
!
!***********************************************************************
!
-! Calculates cell centered gradient using gauss theorem
-! parameters
+! Purpose:
+! Calculates cell centered gradient using Gauss theorem.
+! Parameters:
! u - field, the gradient of which we are looking for
-! dudx,dudy,dudz - arrays where the gradient components are stored
+! dudxi - array where the gradient components are stored
!
! gauss gradient rule:
! -------> ->
@@ -1331,33 +1419,35 @@ subroutine grad_gauss(u,dudx,dudy,dudz)
!
!***********************************************************************
!
- use types
- use parameters
- use geometry
+ use parameters, only: nigrad
implicit none
! Arguments
real(dp), dimension(numTotal), intent(in) :: u
- real(dp), dimension(numCells), intent(inout) :: dudx,dudy,dudz
+ real(dp), dimension(3,numTotal), intent(inout) :: dudxi
! Local
integer :: i,ijp,ijn,ijb,lc,iface
- real(dp) :: volr
- real(dp), dimension(numCells) :: dfxo,dfyo,dfzo
+ real(dp) :: volr,dfxe, dfye, dfze
+ real(dp), dimension(:), allocatable :: dfxo,dfyo,dfzo
+
+
+ allocate( dfxo(numCells) )
+ allocate( dfyo(numCells) )
+ allocate( dfzo(numCells) )
- ! Initialize gradient
+ ! Initialize
dfxo = 0.0_dp
dfyo = 0.0_dp
dfzo = 0.0_dp
+
! Start iterative calculation of gradients
do lc = 1,nigrad
! Initialize new gradient
- dudx = 0.0_dp
- dudy = 0.0_dp
- dudz = 0.0_dp
+ dudxi = 0.0_dp
! Calculate terms integrated over surfaces
@@ -1365,8 +1455,19 @@ subroutine grad_gauss(u,dudx,dudy,dudz)
do i=1,numInnerFaces
ijp = owner(i)
ijn = neighbour(i)
+
call gradco(ijp, ijn, xf(i), yf(i), zf(i), arx(i), ary(i), arz(i), facint(i), &
- u, dfxo, dfyo, dfzo, dudx, dudy, dudz)
+ u, dfxo, dfyo, dfzo, dfxe, dfye, dfze)
+
+ ! Accumulate contribution at cell center and neighbour
+ dudxi(1,ijp) = dudxi(1,ijp) + dfxe
+ dudxi(2,ijp) = dudxi(2,ijp) + dfye
+ dudxi(3,ijp) = dudxi(3,ijp) + dfze
+
+ dudxi(1,ijn) = dudxi(1,ijn) - dfxe
+ dudxi(2,ijn) = dudxi(2,ijn) - dfye
+ dudxi(3,ijn) = dudxi(3,ijn) - dfze
+
enddo
! Contribution from boundaries
@@ -1375,107 +1476,50 @@ subroutine grad_gauss(u,dudx,dudy,dudz)
iface = numInnerFaces + i
ijp = owner(iface)
ijb = numCells + i
- call gradbc(arx(iface), ary(iface), arz(iface), u(ijb), dudx(ijp), dudy(ijp), dudz(ijp))
+
+ call gradbc( arx(iface), ary(iface), arz(iface), u(ijb), dudxi(1,ijp), dudxi(2,ijp), dudxi(3,ijp) )
+
enddo
! Calculate gradient components at cv-centers
do ijp=1,numCells
- volr=1.0_dp/vol(ijp)
- dudx(ijp)=dudx(ijp)*volr
- dudy(ijp)=dudy(ijp)*volr
- dudz(ijp)=dudz(ijp)*volr
+
+ volr = 1.0_dp/vol(ijp)
+
+ dudxi(:,ijp) = dudxi(:,ijp)*volr
+
enddo
! Set old gradient = new gradient for the next iteration
- if(lc.ne.nigrad) then
- dfxo=dudx
- dfyo=dudy
- dfzo=dudz
+ if(lc.le.nigrad) then
+ dfxo = dudxi(1,1:numCells)
+ dfyo = dudxi(2,1:numCells)
+ dfzo = dudxi(3,1:numCells)
endif
enddo ! lc-loop
-end subroutine
-
-
-
-subroutine gradco(ijp,ijn, &
- xfc,yfc,zfc,sx,sy,sz,fif, &
- fi,dfxo,dfyo,dfzo,dfx,dfy,dfz)
-!=======================================================================
-! This routine calculates contribution to the gradient
-! vector of a scalar FI at the CV center, arising from
-! an inner cell face (cell-face value of FI times the
-! corresponding component of the surface vector).
-!=======================================================================
- use types
- use parameters
- use geometry
-
- implicit none
-
- integer, intent(in) :: ijp,ijn
- real(dp), intent(in) :: xfc,yfc,zfc
- real(dp), intent(in) :: sx,sy,sz
- real(dp), intent(in) :: fif
- real(dp), dimension(numTotal), intent(in) :: fi
- real(dp), dimension(numCells), intent(in) :: dfxo,dfyo,dfzo
- real(dp), dimension(numCells), intent(inout) :: dfx,dfy,dfz
-
-
- real(dp) :: xi,yi,zi,dfxi,dfyi,dfzi
- real(dp) :: fie,dfxe,dfye,dfze
- real(dp) :: fxn,fxp
-
- !
- ! Coordinates of point on the line connecting center and neighbor,
- ! old gradient vector components interpolated for this location.
-
- fxn = fif
- fxp = 1.0d0-fxn
-
- xi = xc(ijp)*fxp+xc(ijn)*fxn
- yi = yc(ijp)*fxp+yc(ijn)*fxn
- zi = zc(ijp)*fxp+zc(ijn)*fxn
-
- dfxi = dfxo(ijp)*fxp+dfxo(ijn)*fxn
- dfyi = dfyo(ijp)*fxp+dfyo(ijn)*fxn
- dfzi = dfzo(ijp)*fxp+dfzo(ijn)*fxn
-
- ! Value of the variable at cell-face center
- fie = fi(ijp)*fxp+fi(ijn)*fxn + dfxi*(xfc-xi)+dfyi*(yfc-yi)+dfzi*(zfc-zi)
-
-
- ! (interpolated mid-face value)x(area)
- dfxe = fie*sx
- dfye = fie*sy
- dfze = fie*sz
-
- ! Accumulate contribution at cell center and neighbour
- dfx(ijp) = dfx(ijp)+dfxe
- dfy(ijp) = dfy(ijp)+dfye
- dfz(ijp) = dfz(ijp)+dfze
-
- dfx(ijn) = dfx(ijn)-dfxe
- dfy(ijn) = dfy(ijn)-dfye
- dfz(ijn) = dfz(ijn)-dfze
-
+ deallocate( dfxo )
+ deallocate( dfyo )
+ deallocate( dfzo )
end subroutine
+
! Corrected Gauss gradients
-subroutine grad_gauss_corrected(u,dudx,dudy,dudz)
+subroutine grad_gauss_corrected(u,dudxi)
!
!***********************************************************************
!
-! Calculates cell centered gradient using gauss theorem
-! parameters
+! Purpose:
+! Calculates cell centered gradient using Gauss theorem.
+! Parameters:
! u - field, the gradient of which we are looking for
-! dudx,dudy,dudz - arrays where the gradient components are stored
+! dudxi - array where the gradient components are stored
!
-! gauss gradient rule:
+! Gauss gradient rule:
! -------> ->
! grad(u) = 1/vol * sum_{i=1}^{i=nf} (u)_f*sf
! where:
@@ -1488,29 +1532,31 @@ subroutine grad_gauss_corrected(u,dudx,dudy,dudz)
!***********************************************************************
!
use types
- use parameters
use geometry
implicit none
! Arguments
real(dp), dimension(numTotal), intent(in) :: u
- real(dp), dimension(numCells), intent(inout) :: dudx,dudy,dudz
+ real(dp), dimension(3,numTotal), intent(inout) :: dudxi
! Local
integer :: i,ijp,ijn,ijb,iface
- real(dp) :: volr
- real(dp), dimension(numCells) :: dfxo,dfyo,dfzo
+ real(dp) :: volr, dfxe, dfye, dfze
+ real(dp), dimension(:), allocatable :: dfxo,dfyo,dfzo
+
+
+ allocate( dfxo(numCells) )
+ allocate( dfyo(numCells) )
+ allocate( dfzo(numCells) )
! Initialize gradient with lsq gradient
- dfxo = dudx
- dfyo = dudy
- dfzo = dudz
+ dfxo = dudxi(1,1:numCells)
+ dfyo = dudxi(2,1:numCells)
+ dfzo = dudxi(3,1:numCells)
! Initialize new gradient
- dudx = 0.0_dp
- dudy = 0.0_dp
- dudz = 0.0_dp
+ dudxi = 0.0_dp
! Calculate terms integrated over surfaces
@@ -1518,8 +1564,19 @@ subroutine grad_gauss_corrected(u,dudx,dudy,dudz)
do i=1,numInnerFaces
ijp = owner(i)
ijn = neighbour(i)
+
call gradco(ijp, ijn, xf(i), yf(i), zf(i), arx(i), ary(i), arz(i), facint(i), &
- u, dfxo, dfyo, dfzo, dudx, dudy, dudz)
+ u, dfxo, dfyo, dfzo, dfxe, dfye, dfze)
+
+ ! Accumulate contribution at cell center and neighbour
+ dudxi(1,ijp) = dudxi(1,ijp) + dfxe
+ dudxi(2,ijp) = dudxi(2,ijp) + dfye
+ dudxi(3,ijp) = dudxi(3,ijp) + dfze
+
+ dudxi(1,ijn) = dudxi(1,ijn) - dfxe
+ dudxi(2,ijn) = dudxi(2,ijn) - dfye
+ dudxi(3,ijn) = dudxi(3,ijn) - dfze
+
enddo
! Contribution from boundaries
@@ -1527,26 +1584,89 @@ subroutine grad_gauss_corrected(u,dudx,dudy,dudz)
iface = numInnerFaces + i
ijp = owner(iface)
ijb = numCells + i
- call gradbc(arx(iface), ary(iface), arz(iface), u(ijb), dudx(ijp), dudy(ijp), dudz(ijp))
+
+ call gradbc( arx(iface), ary(iface), arz(iface), u(ijb), dudxi(1,ijp), dudxi(2,ijp), dudxi(3,ijp) )
+
enddo
! Calculate gradient components at cv-centers
do ijp=1,numCells
- volr=1.0_dp/vol(ijp)
- dudx(ijp)=dudx(ijp)*volr
- dudy(ijp)=dudy(ijp)*volr
- dudz(ijp)=dudz(ijp)*volr
+
+ volr = 1.0_dp/vol(ijp)
+
+ dudxi(:,ijp) = dudxi(:,ijp)*volr
+
enddo
end subroutine
+subroutine gradco(ijp,ijn, &
+ xfc,yfc,zfc,sx,sy,sz,fif, &
+ fi,dfxo,dfyo,dfzo,dfxe,dfye,dfze)
+!
+!***********************************************************************
+!
+! This routine calculates contribution to the gradient
+! vector of a scalar FI at the CV center, arising from
+! an inner cell face (cell-face value of FI times the
+! corresponding component of the surface vector).
+!
+!***********************************************************************
+!
+ use types
+ use parameters
+ use geometry
+
+ implicit none
+
+ integer, intent(in) :: ijp,ijn
+ real(dp), intent(in) :: xfc,yfc,zfc
+ real(dp), intent(in) :: sx,sy,sz
+ real(dp), intent(in) :: fif
+ real(dp), dimension(numTotal), intent(in) :: fi
+ real(dp), dimension(numCells), intent(in) :: dfxo,dfyo,dfzo
+ real(dp), intent(out) :: dfxe,dfye,dfze
+
+
+ real(dp) :: xi,yi,zi
+ real(dp) :: dfxi,dfyi,dfzi
+ real(dp) :: fie
+ real(dp) :: fxn,fxp
+
+ !
+ ! Coordinates of point on the line connecting center and neighbor,
+ ! old gradient vector components interpolated for this location.
+
+ fxn = fif
+ fxp = 1.0d0-fxn
+
+ xi = xc(ijp)*fxp+xc(ijn)*fxn
+ yi = yc(ijp)*fxp+yc(ijn)*fxn
+ zi = zc(ijp)*fxp+zc(ijn)*fxn
+
+ dfxi = dfxo(ijp)*fxp+dfxo(ijn)*fxn
+ dfyi = dfyo(ijp)*fxp+dfyo(ijn)*fxn
+ dfzi = dfzo(ijp)*fxp+dfzo(ijn)*fxn
+
+ ! Value of the variable at cell-face center
+ fie = fi(ijp)*fxp+fi(ijn)*fxn + dfxi*(xfc-xi)+dfyi*(yfc-yi)+dfzi*(zfc-zi)
+
+ ! (interpolated mid-face value)x(area)
+ dfxe = fie*sx
+ dfye = fie*sy
+ dfze = fie*sz
+
+end subroutine
+
subroutine gradbc(sx,sy,sz,fi,dfx,dfy,dfz)
-!=======================================================================
-! This routine calculates the contribution of a
-! boundary cell face to the gradient at CV-center.
-!=======================================================================
+!***********************************************************************
+!
+! This routine calculates the contribution of a
+! boundary cell face to the gradient at CV-center.
+!
+!***********************************************************************
use types
implicit none
@@ -1565,7 +1685,7 @@ subroutine gradbc(sx,sy,sz,fi,dfx,dfy,dfz)
!******************************************************************************
!
subroutine sngrad_scalar_field(ijp, ijn, xf, yf, zf, arx, ary, arz, lambda, &
- Fi, dFidxi, nrelax, approach, dfixi, dfiyi, dfizi, &
+ Phi, dPhidxi, nrelax, approach, dfixi, dfiyi, dfizi, &
dfixii, dfiyii, dfizii)
!
!******************************************************************************
@@ -1580,15 +1700,13 @@ subroutine sngrad_scalar_field(ijp, ijn, xf, yf, zf, arx, ary, arz, lambda, &
!******************************************************************************
!
implicit none
-!
-!******************************************************************************
-!
+
integer, intent(in) :: ijp, ijn
real(dp), intent(in) :: xf,yf,zf
real(dp), intent(in) :: arx, ary, arz
real(dp), intent(in) :: lambda
- real(dp), dimension(numTotal), intent(in) :: Fi
- real(dp), dimension(3,numTotal), intent(in) :: dFidxi
+ real(dp), dimension(numTotal), intent(in) :: Phi
+ real(dp), dimension(3,numTotal), intent(in) :: dPhidxi
integer, intent(in) :: nrelax
character(len=12) :: approach
real(dp), intent(out) :: dfixi, dfiyi, dfizi, dfixii, dfiyii, dfizii
@@ -1608,9 +1726,6 @@ subroutine sngrad_scalar_field(ijp, ijn, xf, yf, zf, arx, ary, arz, lambda, &
real(dp) :: xpp,ypp,zpp,xep,yep,zep,xpnp,ypnp,zpnp,volep
real(dp) :: nablaFIxdnnp,nablaFIxdppp
-!
-!******************************************************************************
-!
! > Geometry:
@@ -1665,9 +1780,9 @@ subroutine sngrad_scalar_field(ijp, ijn, xf, yf, zf, arx, ary, arz, lambda, &
! Interpolate gradients defined at CV centers to faces
- dfixi = dFidxi(1,ijp)*fxp+dFidxi(1,ijn)*fxn
- dfiyi = dFidxi(2,ijp)*fxp+dFidxi(2,ijn)*fxn
- dfizi = dFidxi(3,ijp)*fxp+dFidxi(3,ijn)*fxn
+ dfixi = dPhidxi(1,ijp)*fxp+dPhidxi(1,ijn)*fxn
+ dfiyi = dPhidxi(2,ijp)*fxp+dPhidxi(2,ijn)*fxn
+ dfizi = dPhidxi(3,ijp)*fxp+dPhidxi(3,ijn)*fxn
!-- Skewness correction -->
@@ -1683,9 +1798,9 @@ subroutine sngrad_scalar_field(ijp, ijn, xf, yf, zf, arx, ary, arz, lambda, &
d2z = zpn*costn
!.....du/dx_i interpolated at cell face:
- dfixii = dfixi*d1x + arx/vole*( fi(ijn)-fi(ijp)-dfixi*d2x-dfiyi*d2y-dfizi*d2z )
- dfiyii = dfiyi*d1y + ary/vole*( fi(ijn)-fi(ijp)-dfixi*d2x-dfiyi*d2y-dfizi*d2z )
- dfizii = dfizi*d1z + arz/vole*( fi(ijn)-fi(ijp)-dfixi*d2x-dfiyi*d2y-dfizi*d2z )
+ dfixii = dfixi*d1x + arx/vole*( Phi(ijn)-Phi(ijp)-dfixi*d2x-dfiyi*d2y-dfizi*d2z )
+ dfiyii = dfiyi*d1y + ary/vole*( Phi(ijn)-Phi(ijp)-dfixi*d2x-dfiyi*d2y-dfizi*d2z )
+ dfizii = dfizi*d1z + arz/vole*( Phi(ijn)-Phi(ijp)-dfixi*d2x-dfiyi*d2y-dfizi*d2z )
! |-- Intersection point offset and skewness correction -->
@@ -1717,16 +1832,16 @@ subroutine sngrad_scalar_field(ijp, ijn, xf, yf, zf, arx, ary, arz, lambda, &
zpnp = zpnp*costn
! The cell face interpolated gradient (d phi / dx_i)_j:
- ! Nonorthogonal corrections: ___
- ! nablaFIxdnnp =>> dot_product(dFidxi,dNN')
- ! And: ___
- ! nablaFIxdnnp =>> dot_product(dFidxi,dPP')
- nablaFIxdnnp = dFidxi(1,ijn)*(xep-xc(ijn))+dFidxi(2,ijn)*(yep-yc(ijn))+dFidxi(3,ijn)*(zep-zc(ijn))
- nablaFIxdppp = dFidxi(1,ijp)*(xpp-xc(ijp))+dFidxi(2,ijp)*(ypp-yc(ijp))+dFidxi(3,ijp)*(zpp-zc(ijp))
-
- dfixii = dfixi*d1x + arx/volep*( fi(ijn)+nablaFIxdnnp-fi(ijp)-nablaFixdppp-dfixi*xpnp-dfiyi*ypnp-dfizi*zpnp )
- dfiyii = dfiyi*d1y + ary/volep*( fi(ijn)+nablaFIxdnnp-fi(ijp)-nablaFixdppp-dfixi*xpnp-dfiyi*ypnp-dfizi*zpnp )
- dfizii = dfizi*d1z + arz/volep*( fi(ijn)+nablaFIxdnnp-fi(ijp)-nablaFixdppp-dfixi*xpnp-dfiyi*ypnp-dfizi*zpnp )
+ ! Nonorthogonal corrections: ___
+ ! nablaFIxdnnp =>> dot_product(dPhidxi,dNN')
+ ! And: ___
+ ! nablaFIxdnnp =>> dot_product(dPhidxi,dPP')
+ nablaFIxdnnp = dPhidxi(1,ijn)*(xep-xc(ijn))+dPhidxi(2,ijn)*(yep-yc(ijn))+dPhidxi(3,ijn)*(zep-zc(ijn))
+ nablaFIxdppp = dPhidxi(1,ijp)*(xpp-xc(ijp))+dPhidxi(2,ijp)*(ypp-yc(ijp))+dPhidxi(3,ijp)*(zpp-zc(ijp))
+
+ dfixii = dfixi*d1x + arx/volep*( Phi(ijn)+nablaFIxdnnp-Phi(ijp)-nablaFixdppp-dfixi*xpnp-dfiyi*ypnp-dfizi*zpnp )
+ dfiyii = dfiyi*d1y + ary/volep*( Phi(ijn)+nablaFIxdnnp-Phi(ijp)-nablaFixdppp-dfixi*xpnp-dfiyi*ypnp-dfizi*zpnp )
+ dfizii = dfizi*d1z + arz/volep*( Phi(ijn)+nablaFIxdnnp-Phi(ijp)-nablaFixdppp-dfixi*xpnp-dfiyi*ypnp-dfizi*zpnp )
!-- Uncorrected -->
elseif (adjustl(approach) == 'uncorrected') then
@@ -1762,9 +1877,7 @@ subroutine sngrad_vector_field(ijp, ijn, xf, yf, zf, arx, ary, arz, lambda, &
!******************************************************************************
!
implicit none
-!
-!******************************************************************************
-!
+
integer, intent(in) :: ijp, ijn
integer, intent(in) :: nrelax
character(len=12) :: approach
diff --git a/src/finiteVolume/fvExplicit/vortexIdentification.f90 b/src/finiteVolume/fvExplicit/vortexIdentification.f90
new file mode 100644
index 0000000..192318a
--- /dev/null
+++ b/src/finiteVolume/fvExplicit/vortexIdentification.f90
@@ -0,0 +1,211 @@
+module vortexIdentification
+!
+! Purpose:
+! Module contains functions for extracting coherent vortex structures in the flow.
+! Description:
+! We include several well known methods such as identification using Q-critera,
+! $\lambda_2$ (Jeong&Hussain JFM 1995), and other.
+!
+! Author: Nikola Mirkov
+! Email: nikolamirkov@yahoo.com
+!
+! Modified:
+! Apr 10, 2020.
+!
+! This is a part of freeCappuccino.
+! The code is licenced under GPL licence.
+!
+use types
+use geometry
+use variables, only: dUdxi,dVdxi,dWdxi
+
+implicit none
+
+real(dp), dimension(:), allocatable :: Qvortex
+real(dp), dimension(:), allocatable :: lambda2
+
+public
+
+contains
+
+subroutine setQvortex
+!
+! Calculates so called Q criteria field, defined by Q = 1/2 * (S^2 - Omega^2).
+! If Q > 0, vortical motion exists.
+! Iso-surfaces of this field define coherent structures that approximate vortices in the flow field.
+!
+ implicit none
+
+ integer :: inp
+ real(dp) :: dudx,dudy,dudz,dvdx,dvdy,dvdz,dwdx,dwdy,dwdz
+ real(dp) :: s11,s12,s13,s22,s23,s33,w12,w13,w23
+ real(dp) :: magVorticitySq,magStrainSq
+
+ if( .not.allocated( Qvortex ) ) then
+ allocate( Qvortex(numCells) )
+ endif
+
+ do inp=1,numCells
+
+ dudx = dudxi(1,inp)
+ dudy = dudxi(2,inp)
+ dudz = dudxi(3,inp)
+
+ dvdx = dvdxi(1,inp)
+ dvdy = dvdxi(2,inp)
+ dvdz = dvdxi(3,inp)
+
+ dwdx = dwdxi(1,inp)
+ dwdy = dwdxi(2,inp)
+ dwdz = dwdxi(3,inp)
+
+ ! Find strain rate tensor
+ ! [s_ij]: |s_ij|=sqrt[2s_ij s_ij]
+ s11=dudx
+ s12=0.5*(dudy+dvdx)
+ s13=0.5*(dudz+dwdx)
+ s22=dvdy
+ s23=0.5*(dvdz+dwdy)
+ s33=dwdz
+
+ ! Find antisymmetric part of velocity gradient tensor
+ ! [om_ij]: |om_ij|=sqrt[2 om_ij om_ij]
+ w12=(dudy - dvdx)
+ w13=(dudz - dwdx)
+ w23=(dvdz - dwdy)
+
+
+ ! Find strain rate squared s^2 = 2*sij*sij
+ magStrainSq = 2*(s11**2+s22**2+s33**2 + 2*(s12**2+s13**2+s23**2))
+
+ ! Find Vorticity mag squared Om^2 = 2*wij*wij
+ magVorticitySq = (w12**2 + w23**2 + w13**2)
+
+ Qvortex(inp) = 0.5_dp*( magVorticitySq - magStrainSq )
+
+ enddo
+
+end subroutine
+
+
+subroutine setLambda2
+!
+! Compute second largest eigenvalue of (Sik*Skj + Wik*Wkj) tensor.
+! Return the array of -$\lambda_2$ values.
+! Iso-surfaces of this field define coherent structures that approximate vortices in the flow field.
+!
+! See Jeong and Hussain "On the identification of a vortex", JFM, 1995.
+!
+! This subroutine is based on Fluent UDF found on CFD-online forum:
+! https://www.cfd-online.com/Forums/main/99674-lambda-2-criterion.html
+!
+
+ implicit none
+
+ integer :: inp
+ real(dp) :: dudx,dudy,dudz,dvdx,dvdy,dvdz,dwdx,dwdy,dwdz
+ real(dp) :: s11,s12,s13,s22,s23,s33,w12,w13,w23
+ real(dp) :: a,b,c,d,i,j,k,m,n,p
+ real(dp) :: x,y,z,tmp
+ real(dp) :: P11,P12,P13,P22,P23,P33
+ real(dp) :: lambda(3)
+
+ if( .not.allocated( lambda2 ) ) then
+ allocate( lambda2(numCells) )
+ endif
+
+
+ do inp=1,numCells
+
+ dudx = dudxi(1,inp)
+ dudy = dudxi(2,inp)
+ dudz = dudxi(3,inp)
+
+ dvdx = dvdxi(1,inp)
+ dvdy = dvdxi(2,inp)
+ dvdz = dvdxi(3,inp)
+
+ dwdx = dwdxi(1,inp)
+ dwdy = dwdxi(2,inp)
+ dwdz = dwdxi(3,inp)
+
+ ! Find strain rate tensor
+ ! [s_ij]: |s_ij|=sqrt[2s_ij s_ij]
+ s11=dudx
+ s12=0.5*(dudy+dvdx)
+ s13=0.5*(dudz+dwdx)
+ s22=dvdy
+ s23=0.5*(dvdz+dwdy)
+ s33=dwdz
+
+ ! Find antisymmetric part of velocity gradient tensor
+ ! [om_ij]: |om_ij|=sqrt[2 om_ij om_ij]
+ w12=0.5*(dudy - dvdx)
+ w13=0.5*(dudz - dwdx)
+ w23=0.5*(dvdz - dwdy)
+
+
+ P11=S11*S11+S12*S12+S13*S13-W12*W12-W13*W13
+ P12=S12*(S11+S22)+S13*S23-W13*W23
+ P13=S13*(S11+S33)+S12*S23+W12*W23
+ P22=S12*S12+S22*S22+S23*S23-W12*W12-W23*W23
+ P23=S23*(S22+S33)+S12*S13-W12*W13
+ P33=S13*S13+S23*S23+S33*S33-W13*W13-W23*W23
+
+ ! Coefficients of the characteristic polynomial
+
+ ! a*lambda^3 + b*lambda^2 + c*lambda + d = 0
+
+ a=-1.0
+ b=P11+P22+P33
+ c=P12*P12+P13*P13+P23*P23-P11*P22-P11*P33-P22*P33
+ d=P11*P22*P33+2.0*P12*P13*P23-P12*P12*P33-P13*P13*P22-P23*P23*P11
+
+ ! Resolution of the cubic equation, eigenvalues assumed to be real
+
+ x=((3.0*c/a)-b*b/(a*a))/3.0
+ y=(2.0*b*b*b/(a*a*a)-9.0*b*c/(a*a)+27.0*d/a)/27.0
+ z=y*y/4.0+x*x*x/27.0
+
+ i=sqrt(y*y/4.0-z)
+ j=-i**(1.0/3.0)
+ k=acos(-(y/(2.0*i)))
+ m=cos(k/3.0)
+ n=sqrt(3.0)*sin(k/3.0)
+ p=b/(3.0*a)
+
+ lambda(1)=2.0*j*m+p
+ lambda(2)=-j*(m+n)+p
+ lambda(3)=-j*(m-n)+p
+
+ ! Ordering of the eigenvalues
+
+ if(lambda(2)>lambda(1)) then
+ tmp=lambda(2)
+ lambda(2)=lambda(1)
+ lambda(1)=tmp
+ endif
+
+ if(lambda(3)>lambda(2)) then
+
+ tmp=lambda(3)
+ lambda(3)=lambda(2)
+ lambda(2)=tmp
+
+ if(lambda(2)>lambda(1)) then
+ tmp=lambda(2)
+ lambda(2)=lambda(1)
+ lambda(1)=tmp
+ endif
+
+ endif
+
+ ! Retrieval of the second eigenvalue
+
+ lambda2(inp) = lambda(2)
+
+ enddo
+
+end subroutine
+
+end module
\ No newline at end of file
diff --git a/src/finiteVolume/fvExplicit/wallSurfaceFields.f90 b/src/finiteVolume/fvExplicit/wallSurfaceFields.f90
new file mode 100644
index 0000000..9c98ae3
--- /dev/null
+++ b/src/finiteVolume/fvExplicit/wallSurfaceFields.f90
@@ -0,0 +1,93 @@
+module wallSurfaceFields
+!
+! Purpose:
+! Module contains functions for calculating flow quantities pertinent to wall boundaries.
+! Description:
+!
+! Author: Nikola Mirkov
+! Email: nikolamirkov@yahoo.com
+!
+! Modified:
+! Apr 10, 2020.
+!
+! This is a part of freeCappuccino.
+! The code is licenced under GPL licence.
+!
+use types
+use parameters
+use geometry
+use variables
+use gradients
+
+implicit none
+
+
+public
+
+contains
+
+
+subroutine forcesAtWall(fshearx,fsheary,fshearz,fprx,fpry,fprz)
+!
+! Purpose:
+! Computes friction and pressure forces imposed on wall boundaries by fluid flow.
+!
+
+ implicit none
+
+ ! Input
+ real(dp), dimension(*), intent(inout) :: fshearx,fsheary,fshearz,fprx,fpry,fprz
+
+ ! Local variables
+ integer :: i,ib,iface,ijp,ijb,iWall
+ real(dp) :: viss,are,nxf,nyf,nzf,vsol,upb,vpb,wpb
+
+
+ iWall = 0
+
+ do ib=1,numBoundaries
+
+ if ( bctype(ib) == 'wall') then
+
+ do i=1,nfaces(ib)
+
+ iface = startFace(ib) + i
+ ijp = owner(iface)
+ ijb = iBndValueStart(ib) + i
+ iWall = iWall + 1
+
+ viss=max(viscos,visw(iWall))
+
+ ! Face area
+ are = sqrt(arx(iface)**2+ary(iface)**2+arz(iface)**2)
+
+ ! Face normals
+ nxf = arx(iface)/are
+ nyf = ary(iface)/are
+ nzf = arz(iface)/are
+
+ ! Diffusion coef.
+ vsol = viss*srdw(iWall)
+
+ ! Velocity difference vector components
+ upb = u(ijp)-u(ijb)
+ vpb = v(ijp)-v(ijb)
+ wpb = w(ijp)-w(ijb)
+
+ ! Shear forces at wall in x, y and z direction.
+ fshearx(iWall) = vsol*( (u(ijb)-u(ijp))*(1.-nxf**2) + vpb*nyf*nxf + wpb*nzf*nxf )
+ fsheary(iWall) = vsol*( upb*nxf*nyf + (v(ijb)-v(ijp))*(1.-nyf**2) + wpb*nzf*nyf )
+ fahearz(iWall) = vsol*( upb*nxf*nzf + vpb*nyf*nzf + (w(ijb)-w(ijp)*(1.-nzf**2) )
+
+ ! Pressure forces ( NOTE: we assume that boundary face normals point outwards ,away from the fluid region)
+ fprx(iWall) = p(ijb)*arx(iface)
+ fpry(iWall) = p(ijb)*ary(iface)
+ fprz(iWall) = p(ijb)*arz(iface)
+
+ enddo
+
+ endif
+
+ enddo
+
+end subroutine
\ No newline at end of file
diff --git a/src/finiteVolume/fvImplicit/fvEquation.f90 b/src/finiteVolume/fvImplicit/fvEquation.f90
index d9fd1d9..520d2f7 100644
--- a/src/finiteVolume/fvImplicit/fvEquation.f90
+++ b/src/finiteVolume/fvImplicit/fvEquation.f90
@@ -5,7 +5,7 @@ module fvEquation
use types
use geometry
use sparse_matrix
-use tensor_fields
+use tensorFields
use linear_solver, only: spsolve
implicit none
@@ -15,12 +15,7 @@ module fvEquation
!
type, extends(csrMatrix) :: fvEquation
- ! Field related
- ! type(volScalarField) :: phi
- real(dp), dimension(:), allocatable :: x ! Solution vector
- real(dp), dimension(:), allocatable :: o ! Past time values of solution vector field
- real(dp), dimension(:), allocatable :: oo ! Second level past times for BDF2 time differencing scheme
- real(dp), dimension(:), allocatable :: su ! right hand side vector (vector of sources)
+ real(dp), dimension(:), allocatable :: su ! right hand side vector (vector of sources)
real(dp), dimension(:), allocatable :: sp ! vector of sources that goes into main matrix diagonal (vector of sources)
real(dp), dimension(:), allocatable :: res ! Residual vector for linear solvers
@@ -29,6 +24,7 @@ module fvEquation
integer :: itr_max ! Max no. of iterations
integer :: tol_abs ! Absolute tolerance level to be reached before exiting iterations.
integer :: tol_rel ! Relative tolerance level to be reached before exiting iterations.
+ real(dp) :: resor ! Residual norm - e.g. L1 norm of initial residual
end type fvEquation
@@ -60,7 +56,7 @@ module fvEquation
real(dp), dimension(:), allocatable :: sv
real(dp), dimension(:), allocatable :: sw
- real(dp), dimension(:), allocatable :: res ! Residula vector
+ real(dp), dimension(:), allocatable :: res ! Residual vector
! Linear solution control parameters
character( len = 20 ) :: solver ! Name of designated solver like 'iccg', etc.
@@ -72,15 +68,15 @@ module fvEquation
interface operator(==)
- module procedure add_source_to_fvEquation
- module procedure add_volVectorFieldSource_to_fvVectorEquation
- module procedure add_fvEquations
- module procedure add_fvVectorEquations
+ module procedure subtract_source_from_fvEquation
+ module procedure subtract_volVectorFieldSource_from_fvVectorEquation
+ module procedure subtract_fvEquations
+ module procedure subtract_fvVectorEquations
end interface
! Overload summation to be able to add fvEquation and volScalarField
-! This enables to have fvm_... routines which usually return FvEquation on rhs of == sign
+! This enables to have fvi... routines which usually return fvEquation on rhs of == sign
interface operator(+)
module procedure add_source_to_fvEquation
module procedure add_volVectorFieldSource_to_fvVectorEquation
@@ -90,10 +86,10 @@ module fvEquation
interface operator(-)
- module procedure substract_source_from_fvEquation
- module procedure substract_volVectorFieldSource_from_fvVectorEquation
- module procedure substract_fvEquations
- module procedure substract_fvVectorEquations
+ module procedure subtract_source_from_fvEquation
+ module procedure subtract_volVectorFieldSource_from_fvVectorEquation
+ module procedure subtract_fvEquations
+ module procedure subtract_fvVectorEquations
end interface
public
@@ -111,7 +107,7 @@ function new_fvEquation( ) result(fvEqn)
allocate(fvEqn % ja ( nnz ))
allocate(fvEqn % a ( nnz ))
- allocate(fvEqn % s ( numCells ))
+ allocate(fvEqn % su ( numCells ))
allocate(fvEqn % sp ( numCells ))
allocate(fvEqn % res ( numCells ))
@@ -138,7 +134,7 @@ function new_fvVectorEquation( ) result(fvEqn)
allocate(fvEqn % ioffset ( numCells+1 ))
allocate(fvEqn % ja ( nnz ))
- allocate(fvEqn % coef ( nnz ))
+ allocate(fvEqn % a ( nnz ))
allocate(fvEqn % su ( numCells ))
allocate(fvEqn % sv ( numCells ))
@@ -173,7 +169,6 @@ end function new_fvVectorEquation
-
function add_source_to_fvEquation(fvEqnIn,source) result( fvEqnOut )
!
! Adds source to eqn. system rhs vector.
@@ -202,7 +197,6 @@ end function add_source_to_fvEquation
-
function add_volVectorFieldSource_to_fvVectorEquation(fvEqnIn,vecSource) result( fvEqnOut )
!
! Adds source to eqn. system rhs vector.
@@ -233,7 +227,7 @@ end function add_volVectorFieldSource_to_fvVectorEquation
-function substract_source_from_fvEquation(fvEqnIn,source) result( fvEqnOut )
+function subtract_source_from_fvEquation(fvEqnIn,source) result( fvEqnOut )
!
! Adds source to eqn. system rhs vector.
!
@@ -254,15 +248,15 @@ function substract_source_from_fvEquation(fvEqnIn,source) result( fvEqnOut )
fvEqnOut = new_fvEquation()
do i=1,numCells
- fvEqnOut % source(i) = fvEqnIn % source(i) - source % mag(i)
+ fvEqnOut%source( i ) = fvEqnIn%source( i ) - source%mag( i )
enddo
-end function substract_source_from_fvEquation
+end function subtract_source_from_fvEquation
-function substract_volVectorFieldSource_from_fvVectorEquation(fvEqn,vecSource) result( fvEqn_new )
+function subtract_volVectorFieldSource_from_fvVectorEquation(fvEqn,vecSource) result( fvEqn_new )
!
! Adds source to eqn. system rhs vector.
!
@@ -288,7 +282,7 @@ function substract_volVectorFieldSource_from_fvVectorEquation(fvEqn,vecSource) r
fvEqn_new % sw(i) = fvEqn % sw(i) - vecSource % z(i)
enddo
-end function substract_volVectorFieldSource_from_fvVectorEquation
+end function subtract_volVectorFieldSource_from_fvVectorEquation
function add_fvEquations(fvEqn1,fvEqn2) result( fvEqn_new )
@@ -357,7 +351,7 @@ function add_fvVectorEquations(fvEqn1,fvEqn2) result( fvEqn_new )
end function add_fvVectorEquations
-function substract_fvEquations(fvEqn1,fvEqn2) result( fvEqn_new )
+function subtract_fvEquations(fvEqn1,fvEqn2) result( fvEqn_new )
!
! Substracts two objects of type(fvEquation).
!
@@ -384,10 +378,10 @@ function substract_fvEquations(fvEqn1,fvEqn2) result( fvEqn_new )
fvEqn_new % coef(i) = fvEqn1 % coef(i) - fvEqn2 % coef(i)
enddo
-end function substract_fvEquations
+end function subtract_fvEquations
-function substract_fvVectorEquations(fvEqn1,fvEqn2) result( fvEqn )
+function subtract_fvVectorEquations(fvEqn1,fvEqn2) result( fvEqn )
!
! Substracts two objects of type(fvVectorEquation).
!
@@ -408,19 +402,19 @@ function substract_fvVectorEquations(fvEqn1,fvEqn2) result( fvEqn )
fvEqn = new_fvVectorEquation()
do i=1,numCells
- fvEqn % su(i) = fvEqn1 % su(i) - fvEqn2 % su(i)
- fvEqn % sv(i) = fvEqn1 % sv(i) - fvEqn2 % sv(i)
- fvEqn % sw(i) = fvEqn1 % sw(i) - fvEqn2 % sw(i)
+ fvEqn%su(i) = fvEqn1%su(i) - fvEqn2%su(i)
+ fvEqn%sv(i) = fvEqn1%sv(i) - fvEqn2%sv(i)
+ fvEqn%sw(i) = fvEqn1%sw(i) - fvEqn2%sw(i)
- fvEqn % spu(i) = fvEqn1 % spu(i) - fvEqn2 % spu(i)
- fvEqn % spv(i) = fvEqn1 % spv(i) - fvEqn2 % spv(i)
- fvEqn % spw(i) = fvEqn1 % spw(i) - fvEqn2 % spw(i)
+ fvEqn%spu(i) = fvEqn1%spu(i) - fvEqn2%spu(i)
+ fvEqn%spv(i) = fvEqn1%spv(i) - fvEqn2%spv(i)
+ fvEqn%spw(i) = fvEqn1%spw(i) - fvEqn2%spw(i)
enddo
do i=1,nnz
- fvEqn % coef(i) = fvEqn1 % coef(i) - fvEqn2 % coef(i)
+ fvEqn%coef(i) = fvEqn1%coef(i) - fvEqn2%coef(i)
enddo
-end function substract_fvVectorEquations
+end function subtract_fvVectorEquations
subroutine solve_fvEqn( fvEqn )
diff --git a/src/finiteVolume/fvImplicit/fvField.f90 b/src/finiteVolume/fvImplicit/fvField.f90
new file mode 100644
index 0000000..bf1da23
--- /dev/null
+++ b/src/finiteVolume/fvImplicit/fvField.f90
@@ -0,0 +1,82 @@
+module fvField
+!
+! Definition of a datatype - a finite volume field, which is a composite type
+! formed of discrete tensor field and a finite volume equation, along with
+! various parameters pertinent to equation discretization and solution.
+! fvField is usually a tensor field for which we need to write and solve
+! finite volume discretization of governing equation to obtain its solution.
+!
+use types
+use geometry
+use sparse_matrix
+use tensorFields
+
+implicit none
+
+public
+
+contains
+
+!
+! The fvEquation derived data type (all objects from fvImplicit belong to this type.)
+!
+type, extends(volScalarField) :: fvField
+ real(dp), dimension(:,:), allocatable :: Grad ! Gradient field, eg. phi%Grad(1,inp)
+ real(dp), dimension(:), allocatable :: o ! n-1 (previous) timestep value, eg. phi%o(inp)
+ real(dp), dimension(:), allocatable :: oo ! n-2 timestep value, eg. phi%oo(inp)
+ real(dp), dimension(:), allocatable :: aver ! Average value, eg. phi%aver(inp)
+
+ type(fvEquation) :: Eqn ! eg. phi%Eqn; phi%Eqn%res(inp)
+ real(dp) :: urf ! Underrelaxation factor eg. phi%urf
+ real(dp) :: gds ! Gamma blending factor [0,1] for deffered correction
+ character( len = 20 ) :: gradient_scheme
+ character( len = 20 ) :: gradient_limiter
+ character( len = 20 ) :: convection_scheme
+ character( len = 20 ) :: diffusion_scheme
+
+! Funkcije:
+! -funkcija za alokaciju ili to moze u mainu...
+! -func za init gde se inicijalnizuje polje i gde se podesava tip BC i inicijalne vrednosti boundary fejsova
+! -func sa diskretizovanom jedn. koja se zove calc pa nesto, recimo calcScalar
+! -func za flukseve koju poziva calcScalar
+! -fun za eksplicitnu korekciju granicnih uslova posle solve, ali to mozda moze globalno?
+
+end type fvField
+
+type, extends(volScalarField) :: fvVectorField
+ real(dp), dimension(:,:), allocatable :: xGrad ! Gradient field, eg. U%xGrad(1,inp)
+ real(dp), dimension(:,:), allocatable :: yGrad ! Gradient field, eg. U%yGrad(1,inp)
+ real(dp), dimension(:,:), allocatable :: zGrad ! Gradient field, eg. U%zGrad(1,inp)
+ real(dp), dimension(:), allocatable :: xo ! n-1 (previous) timestep value, eg.U%xo(icell)
+ real(dp), dimension(:), allocatable :: yo ! n-1 (previous) timestep value
+ real(dp), dimension(:), allocatable :: zo ! n-1 (previous) timestep value
+ real(dp), dimension(:), allocatable :: xoo ! n-2 timestep value
+ real(dp), dimension(:), allocatable :: yoo ! n-2 timestep value
+ real(dp), dimension(:), allocatable :: zoo ! n-2 timestep value
+ real(dp), dimension(:), allocatable :: xaver ! Average value, eg. U%xAver(inp)
+ real(dp), dimension(:), allocatable :: yaver ! Average value, eg. U%yAver(inp)
+ real(dp), dimension(:), allocatable :: zaver ! Average value, eg. U%zAver(inp)
+
+ ! Finite volume equation and realted parameters
+ type(fvEquation) :: Eqn ! eg. phi%Eqn%res(inp)
+ real(dp) :: urf ! Underrelaxation factor
+ real(dp) :: gds ! Gamma blending factor [0,1] for deffered correction
+ ! FVM Discretisation parameters
+ character( len = 20 ) :: gradient_scheme
+ character( len = 20 ) :: gradient_limiter
+ character( len = 20 ) :: convection_scheme
+ character( len = 20 ) :: diffusion_scheme
+
+
+ ! integer :: n_sample ! broj semplovanih vrednosti za statitiku, eg. U%n_sample
+
+! Funkcije:
+! -funkcija za alokaciju ili to moze u mainu...
+! -func za init gde se inicijalnizuje polje i gde se podesava tip BC i inicijalne vrednosti boundary fejsova
+! -func sa diskretizovanom jedn. koja se zove calc pa nesto, recimo calcScalar
+! -func za flukseve koju poziva calcScalar
+! -fun za eksplicitnu korekciju granicnih uslova posle solve.
+
+end type fvField
+
+end module
\ No newline at end of file
diff --git a/src/finiteVolume/fvImplicit/fviDdt.f90 b/src/finiteVolume/fvImplicit/fviDdt.f90
new file mode 100644
index 0000000..4632162
--- /dev/null
+++ b/src/finiteVolume/fvImplicit/fviDdt.f90
@@ -0,0 +1,281 @@
+module fviDdt
+!
+! Purpose:
+! Module for IMPLICIT operations on discrete tensor fields: The Laplacian operator.
+!
+! Description:
+! Module contains procedures for IMPLICIT manipulation of discrete tensor fields based on
+! finite volume computations and integral theorems (e.g. Gauss) of vector calculus.
+! Discrete tensor fields are defined on a given finite volume mesh.
+! That means we are expecting discrete volume/surface scalar/vector/tensor fields.
+! Included operations are:
+! fviLaplacian (volField -> type(fvEquation)/type(fvVectorEquation))
+!
+! Author: Nikola Mirkov
+! This is a part of freeCappuccino.
+! The code is licenced under GPL licence.
+!
+
+use types
+use geometry
+use tensorFields
+use fvEquation
+
+implicit none
+
+ real(dp), parameter :: small = 1e-30
+ real(dp), parameter :: zero = 0.0_dp
+
+ interface fviDdt
+ module procedure fvi_ddt_volScalarField
+ module procedure fvi_ddt_volVectorField
+ module procedure fvi_ddt_surfaceVectorField
+ end interface
+
+ interface fviD2dt2
+ module procedure fvi_d2dt2_scalar_field
+ end interface
+
+public :: fviDdt,fviD2dt2
+
+contains
+
+function fvi_ddt_vector_field(den,U) result(fvEqn)
+!
+!******************************************************************************
+!
+! Finds source and matrix coefficients representing FVM discretization
+! of time derivative operator: \partial / \partial t.
+!
+! System of linear equations is written as:
+! $ a_p^{(i)}*\phi_p^(i)-\sum_{j=1}^{nb} a_j^{(i)}*\phi_j^(i) = b_p{(i)}, i=1,ncells $
+!
+!******************************************************************************
+!
+
+ implicit none
+
+ type(volVectorField), intent(in), optional :: den
+ type(volVectorField), intent(in) :: U
+
+!
+! > Result
+!
+ type(fvVectorEquation) :: fvEqn
+
+ integer :: icell
+ real(dp) :: apotime
+
+!
+! > Shift in time
+!
+ ! fvEqn%xoo(:) = fvEqn%xo(:)
+ ! fvEqn%yoo(:) = fvEqn%yo(:)
+ ! fvEqn%zoo(:) = fvEqn%zo(:)
+
+ ! fvEqn%xo(:) = U%x(:)
+ ! fvEqn%yo(:) = U%y(:)
+ ! fvEqn%zo(:) = U%z(:)
+
+
+ do icell =1,numCells
+
+ if( present(den) ) then
+ apotime = den( icell )*vol( icell )/timestep
+ else
+ apotime = vol( icell )/timestep
+ endif
+
+ if( bdf .or. cn ) then
+ !
+ ! Backward differentiation formula of 1st order or Crank-Nicolson.
+ !
+
+ ! RHS vector contribution
+ fvEqn%su( icell ) = fvEqn%su( icell ) + apotime*uo( icell )
+ fvEqn%sv( icell ) = fvEqn%sv( icell ) + apotime*vo( icell )
+ fvEqn%sw( icell ) = fvEqn%sw( icell ) + apotime*wo( icell )
+
+ ! Matrix diagonal element contribution
+ fvEqn%spu( icell ) = fvEqn%spu( icell ) + apotime
+ fvEqn%spv( icell ) = fvEqn%spv( icell ) + apotime
+ fvEqn%spw( icell ) = fvEqn%spw( icell ) + apotime
+
+ elseif( bdf2 ) then
+ !
+ ! Backward Differentiation (BDF2) - 2nd order.
+ !
+
+ ! RHS vector contribution
+ fvEqn%su( icell ) = fvEqn%su( icell ) + apotime*( 2*uo( icell ) - 0.5_dp*uoo( icell ) )
+ fvEqn%sv( icell ) = fvEqn%sv( icell ) + apotime*( 2*vo( icell ) - 0.5_dp*voo( icell ) )
+ fvEqn%sw( icell ) = fvEqn%sw( icell ) + apotime*( 2*wo( icell ) - 0.5_dp*woo( icell ) )
+
+ ! Matrix diagonal element contribution
+ fvEqn%spu( icell ) = fvEqn%spu( icell ) + 1.5_dp*apotime
+ fvEqn%spv( icell ) = fvEqn%spv( icell ) + 1.5_dp*apotime
+ fvEqn%spw( icell ) = fvEqn%spw( icell ) + 1.5_dp*apotime
+
+
+ elseif( bdf3 ) then
+ !
+ ! Backward Differentiation (BDF3) - 3nd order.
+ !
+
+ ! RHS vector contribution
+ fvEqn%su( icell ) = fvEqn%su( icell ) + apotime*( 3*uo( icell ) - 1.5_dp*uoo( icell ) + 1./3.0_dp*uooo( icell ) )
+ fvEqn%sv( icell ) = fvEqn%sv( icell ) + apotime*( 3*vo( icell ) - 1.5_dp*voo( icell ) + 1./3.0_dp*vooo( icell ) )
+ fvEqn%sw( icell ) = fvEqn%sw( icell ) + apotime*( 3*wo( icell ) - 1.5_dp*woo( icell ) + 1./3.0_dp*wooo( icell ) )
+
+ ! Matrix diagonal element contribution
+ fvEqn%spu( icell ) = fvEqn%spu( icell ) + 11./6.0_dp*apotime
+ fvEqn%spv( icell ) = fvEqn%spv( icell ) + 11./6.0_dp*apotime
+ fvEqn%spw( icell ) = fvEqn%spw( icell ) + 11./6.0_dp*apotime
+
+ endif
+
+ end do
+
+end function
+
+
+function fvi_ddt_scalar_field(den, psi) result(fvEqn)
+!
+!******************************************************************************
+!
+! Finds source and matrix coefficients representing FVM discretization
+! of time derivative operator: \partial / \partial t.
+!
+! System of linear equations is written as:
+! $ a_p^{(i)}*\phi_p^(i)-\sum_{j=1}^{nb} a_j^{(i)}*\phi_j^(i) = b_p{(i)}, i=1,ncells $
+!
+!******************************************************************************
+!
+ use parameters
+
+ implicit none
+
+ type(volScalarField), intent(in), optional :: den
+ type(volScalarField), intent(in) :: U
+
+!
+! > Result
+!
+ type(fvEquation) :: fvEqn
+
+!
+! > Local
+!
+ integer :: icell
+ real(dp) :: apotime, sut
+
+!
+! > Shift in time
+!
+ ! fvEqn%oo(:) = fvEqn%o(:)
+ ! fvEqn%o(:) = phi%mag(:)
+
+ do icell = 1,numCells
+
+ if( present(den) ) then
+ apotime = den( icell )*vol( icell )/timestep
+ else
+ apotime = vol( icell )/timestep
+ endif
+
+ if( bdf .or. cn ) then
+ !
+ ! Backward differentiation formula of 1st order.
+ !
+
+ ! RHS vector contribution
+ fvEqn%su( icell ) = fvEqn%su( icell ) + apotime*uo( icell )
+
+ ! Matrix diagonal element contribution
+ fvEqn%sp( icell ) = fvEqn%sp( icell ) + apotime
+
+ elseif( bdf2 ) then
+ !
+ ! Backward Differentiation (BDF2) - 2nd order.
+ !
+
+ ! RHS vector contribution
+ fvEqn%su( icell ) = fvEqn%su( icell ) + apotime*( 2*uo( icell ) - 0.5_dp*uoo( icell ) )
+
+ ! Matrix diagonal element contribution
+ fvEqn%sp( icell ) = fvEqn%sp( icell ) + 1.5_dp*apotime
+
+
+ elseif( bdf3 ) then
+ !
+ ! Backward Differentiation (BDF3) - 3nd order.
+ !
+
+ ! RHS vector contribution
+ fvEqn%su( icell ) = fvEqn%su( icell ) + apotime*( 3*uo( icell ) - 1.5_dp*uoo( icell ) + 1./3.0_dp*uooo( icell ) )
+
+ ! Matrix diagonal element contribution
+ fvEqn%sp( icell ) = fvEqn%sp( icell ) + 11./6.0_dp*apotime
+
+ endif
+
+ end do
+
+
+end function
+
+
+
+function fvi_d2dt2_scalar_field( den, U ) result(fvEqn)
+!
+!******************************************************************************
+!
+! Description:
+! Second order time differentiation for scalar fields.
+!
+! Finds source and matrix coefficients representing FVM discretization
+! of scnd. order time derivative operator: \partial^2 / \partial t^2.
+!
+! System of linear equations is written as:
+! $ a_p^{(i)}*\phi_p^(i)-\sum_{j=1}^{nb} a_j^{(i)}*\phi_j^(i) = b_p{(i)}, i=1,ncells $
+!
+!******************************************************************************
+!
+
+ use parameters
+
+ implicit none
+
+ type(volScalarField), intent(in), optional :: den
+ type(volScalarField), intent(in) :: U
+!
+! > Result
+!
+ type(fvEquation) :: fvEqn
+!
+! > Locals
+!
+ integer :: icell
+ real(dp) :: apotime
+!
+! > Shift in time
+!
+ ! fvEqn%oo(:) = fvEqn%o(:)
+ ! fvEqn%o(:) = phi%mag(:)
+
+ do icell = 1,numCells
+
+ if( present(den) ) then
+ apotime = den( icell )*vol( icell )/timestep**2
+ else
+ apotime = vol( icell )/timestep**2
+ endif
+
+ fvEqn%su( icell ) = fvEqn%su( icell ) + apotime*(2*uo( icell ) - uoo( icell ))
+
+ fvEqn%sp( icell ) = fvEqn%sp( icell ) + apotime
+
+ end do
+
+
+end function
\ No newline at end of file
diff --git a/src/finiteVolume/fvImplicit/fviDivergence.f90 b/src/finiteVolume/fvImplicit/fviDivergence.f90
new file mode 100644
index 0000000..e5032e2
--- /dev/null
+++ b/src/finiteVolume/fvImplicit/fviDivergence.f90
@@ -0,0 +1,432 @@
+module fviDivergence
+!
+! Purpose:
+! Module for IMPLICIT operations on discrete tensor fields: The Divergence oeprator.
+!
+! Description:
+! Module contains procedures for IMPLICIT manipulation of discrete tensor fields based on
+! finite volume computations and integral theorems (e.g. Gauss) of vector calculus.
+! Discrete tensor fields are defined on a given finite volume mesh.
+! That means we are expecting discrete volume/surface scalar/vector/tensor fields.
+! Included operations are:
+! fviDiv (volField -> type(fvEquation)/type(fvVectorEquation))
+!
+! Author: Nikola Mirkov
+! This is a part of freeCappuccino.
+! The code is licenced under GPL licence.
+!
+
+use types
+use geometry
+use tensorFields
+use fvxInterpolation
+use gradients
+
+implicit none
+
+interface fviDiv
+ module procedure fvi_div_volScalarField
+ module procedure fvi_div_volVectorField
+ module procedure fvi_div_surfaceVectorField
+end interface
+
+public
+
+contains
+
+
+
+function fvi_div_volScalarField(fm,phi) result(fvEq)
+!
+! Description:
+! Implicit FVM discretization of divergence operator.
+! Usage:
+! [type(fvEquation)] fvEq = fviDiv( [type(surfaceScalarField)] fm, [type(volumeScalarField)] phi )
+!
+
+ implicit none
+
+ type(surfaceScalarField), intent(in) :: fm
+ type(volScalarField), intent(in) :: phi
+!
+! > Result
+!
+ type(fvVectorEquation) :: fvEq
+
+!
+! > Local
+!
+ integer :: i, k, ijp, ijn, ijb, iface
+ real(dp) :: cap, can
+ real(dp) :: are,dpw
+ real(dp) :: gam
+ real(dp) :: suadd
+
+
+ ! Initialize matrix array and rhs vector
+ fvEq%a = 0.0_dp
+ fvEq%su = 0.0_dp
+
+ ! > Assemble Laplacian system matrix
+
+ ! Internal faces:
+ do i = 1,numInnerFaces
+
+ ijp = owner(i)
+ ijn = neighbour(i)
+
+ call facefluxdiv(ijp, ijn, xf(i), yf(i), zf(i), fm%mag(i), facint(i), gam, phi, dPhidxi, cap, can, suadd)
+
+ ! > Off-diagonal elements:
+
+ ! (icell,jcell) matrix element:
+ k = icell_jcell_csr_index(i)
+ fvEq%a(k) = can
+
+ ! (jcell,icell) matrix element:
+ k = jcell_icell_csr_index(i)
+ fvEq%a(k) = cap
+
+ ! > Elements on main diagonal:
+
+ ! (icell,icell) main diagonal element
+ k = diag(ijp)
+ fvEq%a(k) = fvEq%a(k) - can
+
+ ! (jcell,jcell) main diagonal element
+ k = diag(ijn)
+ fvEq%a(k) = fvEq%a(k) - cap
+
+ ! > Sources:
+
+ fvEq%su(ijp) = fvEq%su(ijp) + suadd
+ fvEq%su(ijn) = fvEq%su(ijn) - suadd
+
+ end do
+
+
+ ! > Boundary conditions
+
+ do ib=1,numBoundaries
+
+ if ( bctype(ib) == 'inlet' .or. bctype(ib) == 'outlet' ) then
+ do i=1,nfaces(ib)
+ if = startFace(ib) + i
+ ijp = owner(if)
+ ijb = iBndValueStart(ib) + i
+
+ call facefluxsc( ijp, ijb, &
+ xf(if), yf(if), zf(if), &
+ fm(if), 0.0, 1.0, &
+ phi, dPhidxi, cap, can, suadd)
+
+ fvEq%sp(ijp) = fvEq%sp(ijp) - can
+ fvEq%su(ijp) = fvEq%su(ijp) - can*phi(ijb) + suadd
+
+ enddo
+
+ !if ( bctype(ib) == '') then
+
+ ! If boundary is fixed value type
+ do i=1,nfaces(ib)
+
+ iface = startFace(ib) + i
+ ijp = owner(iface)
+ ijb = iBndValueStart(ib) + i
+
+ fvEq%su(ijp) = fvEq%su(ijp) - fm(iface)*phi(ijb)
+
+ ! can = min(fm,zero)
+ ! fvEq%sp(ijp) = fvEq%sp(ijp) - can
+ ! fvEq%su(ijp) = fvEq%su(ijp) - can*fi(ijb) + suadd
+
+ enddo
+
+ !if ( bctype(ib) == '') then
+
+ ! If boundary is fixed gradient type
+ do i=1,nfaces(ib)
+
+ iface = startFace(ib) + i
+ ijp = owner(iface)
+ ijb = iBndValueStart(ib) + i
+
+ ! First determine boundary value by extrapolation
+ dpw = sqrt( (xc(ijp)-xf(iface))**2 + (yc(ijp)-yf(iface))**2 + (zc(ijp)-zf(iface))**2 )
+ phi(ijb) = phi(ijp) + gradVal*dpw
+
+ ! Move to RHS vector
+ fvEq%su(ijp) = fvEq%su(ijp) - fm(iface)*phi(ijb)
+
+ enddo
+
+ endif
+
+ enddo
+
+
+end subroutine
+
+
+function fvi_div_volVectorField(fm,U) result(fvEq)
+!
+! Description:
+! Implicit FVM discretization of divergence operator.
+! Usage:
+! [type(fvVectorEquation)] fvEq = fviDiv( [type(surfaceScalarField)] fm, [type(volumeVectorField)] U )
+!
+
+ implicit none
+
+ type(surfaceScalarField), intent(in) :: fm
+ type(volVectorField), intent(in) :: U
+!
+! > Result
+!
+ type(fvVectorEquation) :: fvEq
+
+!
+! > Local
+!
+ integer :: i, k, ijp, ijn, ijb, iface
+ real(dp) :: cap, can
+ real(dp) :: are,dpw
+ real(dp) :: gam
+ real(dp) :: suadd
+
+
+ ! Initialize matrix array
+ fvEq%a = 0.0_dp
+
+ ! > Assemble Laplacian system matrix
+
+ ! Internal faces:
+ do i = 1,numInnerFaces
+
+ ijp = owner(i)
+ ijn = neighbour(i)
+
+!
+! [NOTE] Sta sa gds(iu) kako to iskoristiti. Mozda to treba da bude svojstvo FvEqn? jer tu je odredjeno koliko
+! je implicit koliko explicit...
+!
+
+ call facefluxdivuvw(ijp, ijn, xf(i), yf(i), zf(i), arx(i), ary(i), arz(i), fm(i), facint(i), gds(iu), cap, can, sup, svp, swp)
+
+ ! > Off-diagonal elements:
+
+ ! (icell,jcell) matrix element:
+ k = icell_jcell_csr_index(i)
+ fvEq%a(k) = can
+
+ ! (jcell,icell) matrix element:
+ k = jcell_icell_csr_index(i)
+ fvEq%a(k) = cap
+
+ ! > Elements on main diagonal:
+
+ ! (icell,icell) main diagonal element
+ k = diag(ijp)
+ fvEq%a(k) = fvEq%a(k) - can
+
+ ! (jcell,jcell) main diagonal element
+ k = diag(ijn)
+ fvEq%a(k) = fvEq%a(k) - cap
+
+ ! > Sources:
+
+ fvEq%su(ijp) = fvEq%su(ijp) + sup
+ fvEq%sv(ijp) = fvEq%sv(ijp) + svp
+ fvEq%sw(ijp) = fvEq%sw(ijp) + swp
+
+ fvEq%su(ijn) = fvEq%su(ijn) - sup
+ fvEq%sv(ijn) = fvEq%sv(ijn) - svp
+ fvEq%sw(ijn) = fvEq%sw(ijn) - swp
+
+ end do
+
+
+ ! > Boundary conditions
+
+ do ib=1,numBoundaries
+
+ if ( bctype(ib) == 'inlet' .or. bctype(ib) == 'outlet' ) then
+ do i=1,nfaces(ib)
+ if = startFace(ib) + i
+ ijp = owner(if)
+ ijb = iBndValueStart(ib) + i
+
+ call facefluxsc( ijp, ijb, xf(if), yf(if), zf(if), fm(if), 0.0, 1.0, fi, dFidxi, cap, can, suadd)
+
+ fvEq%sp(ijp) = fvEq%sp(ijp) - can
+ fvEq%su(ijp) = fvEq%su(ijp) - can*fi(ijb) + suadd
+
+ enddo
+
+ endif
+
+ enddo
+
+
+end subroutine
+
+
+!***********************************************************************
+!
+subroutine facefluxdivuvw(ijp, ijn, xf, yf, zf, arx, ary, arz, fm, lambda, gam, cap, can, sup, svp, swp)
+!
+!***********************************************************************
+!
+! Face fluxes of divergence for inner faces.
+!
+!***********************************************************************
+!
+ implicit none
+
+
+ integer, intent(in) :: ijp, ijn
+ real(dp), intent(in) :: xf,yf,zf
+ real(dp), intent(in) :: arx, ary, arz
+ real(dp), intent(in) :: fm
+ real(dp), intent(in) :: lambda
+ real(dp), intent(in) :: gam
+ real(dp), intent(inout) :: cap, can
+ real(dp), intent(inout) :: sup, svp, swp
+
+ ! Local variables
+ real(dp) :: fxp,fxn
+ real(dp) :: xpn,ypn,zpn
+ real(dp) :: cp,ce
+ real(dp) :: fuuds,fvuds,fwuds
+ real(dp) :: fuhigh,fvhigh,fwhigh
+ real(dp) :: ui, vi, wi
+!----------------------------------------------------------------------
+
+
+ ! > Geometry:
+
+ ! Face interpolation factor
+ fxn = lambda
+ fxp = 1.0_dp-lambda
+
+ ! Distance vector between cell centers
+ xpn = xc(ijn)-xc(ijp)
+ ypn = yc(ijn)-yc(ijp)
+ zpn = zc(ijn)-zc(ijp)
+
+ ! > Equation coefficients:
+
+ ! > Equation coefficients - implicit convection
+ ce = min(fm,zero)
+ cp = max(fm,zero)
+
+ cap = - cp
+ can = ce
+
+
+ ! > Explicit convection:
+
+ ! Explicit convective fluxes for UDS
+ fuuds = cp*u(ijp)+ce*u(ijn)
+ fvuds = cp*v(ijp)+ce*v(ijn)
+ fwuds = cp*w(ijp)+ce*w(ijn)
+
+
+! EXPLICIT CONVECTIVE FLUXES FOR HIGH ORDER BOUNDED SCHEMES
+! Flux_high_order_scheme[N] = mass_flow_rate_in_cell_face_f[kg/s] * Phi_f[m/s]$
+
+ if( fm .ge. zero ) then
+ ! Flow goes from p to pj - > p is the upwind node
+ ui = face_value(ijp, ijn, xf, yf, zf, fxp, u, dUdxi)
+ vi = face_value(ijp, ijn, xf, yf, zf, fxp, v, dVdxi)
+ wi = face_value(ijp, ijn, xf, yf, zf, fxp, w, dWdxi)
+ else
+ ! Other way, flow goes from pj, to p -> pj is the upwind node.
+ ui = face_value(ijn, ijp, xf, yf, zf, fxn, u, dUdxi)
+ vi = face_value(ijn, ijp, xf, yf, zf, fxn, v, dVdxi)
+ wi = face_value(ijn, ijp, xf, yf, zf, fxn, w, dWdxi)
+ endif
+
+ fuhigh = fm*ui
+ fvhigh = fm*vi
+ fwhigh = fm*wi
+
+
+! > Explicit part of diffusion fluxes and sources due to deffered correction.
+
+ sup = -gam*(fuhigh-fuuds)
+ svp = -gam*(fvhigh-fvuds)
+ swp = -gam*(fwhigh-fwuds)
+
+end subroutine
+
+
+
+!***********************************************************************
+!
+subroutine facefluxdiv(ijp, ijn, xf, yf, zf, fm, lambda, gam, fi, dFidxi, cap, can, suadd)
+!
+!***********************************************************************
+!
+ use types
+ use interpolation, only: face_value
+
+ implicit none
+!
+!***********************************************************************
+!
+
+! Arguments
+ integer, intent(in) :: ijp, ijn
+ real(dp), intent(in) :: xf,yf,zf
+ real(dp), intent(in) :: fm
+ real(dp), intent(in) :: lambda
+ real(dp), intent(in) :: gam
+ real(dp), dimension(numTotal), intent(in) :: fi
+ real(dp), dimension(3,numTotal), intent(in) :: dFidxi
+ real(dp), intent(inout) :: cap, can, suadd
+
+! Local variables
+ real(dp) :: fxp,fxn
+ real(dp) :: cp,ce
+ real(dp) :: fii
+ real(dp) :: fcfie,fcfii
+ real(dp), parameter :: zero = 0.0
+
+ ! Face interpolation factor
+ fxn=lambda
+ fxp=1.0_dp-lambda
+
+ ! > Convection fluxes - upwind scheme
+ ce = min(fm,zero)
+ cp = max(fm,zero)
+
+ ! > Matrix coefficients - implicit part
+ cap = - cp
+ can = ce
+
+ ! > Explicit higher order approximation of face value
+
+ if( fm .ge. zero ) then
+ ! Flow goes from p to pj - > p is the upwind node
+ fii = face_value(ijp, ijn, xf, yf, zf, fxp, fi, dFidxi)
+ else
+ ! Other way, flow goes from pj, to p -> pj is the upwind node.
+ fii = face_value(ijn, ijp, xf, yf, zf, fxn, fi, dFidxi)
+ endif
+
+ ! > Explicit, hight order, approximation of convection
+ fcfie = fm*fii
+
+ ! > Explicit, first order, approximation of convection
+ fcfii = ce*fi(ijn)+cp*fi(ijp)
+
+ ! > Deffered correction source for convection = gamablend*(high-low)
+ suadd = -gam*(fcfie-fcfii)
+
+
+end subroutine
+
+end module
+
+
diff --git a/src/finiteVolume/fvImplicit/fviLaplacian.f90 b/src/finiteVolume/fvImplicit/fviLaplacian.f90
new file mode 100644
index 0000000..c92a479
--- /dev/null
+++ b/src/finiteVolume/fvImplicit/fviLaplacian.f90
@@ -0,0 +1,325 @@
+module fviLaplacian
+!
+! Purpose:
+! Module for IMPLICIT operations on discrete tensor fields: The Laplacian operator.
+!
+! Description:
+! Module contains procedures for IMPLICIT manipulation of discrete tensor fields based on
+! finite volume computations and integral theorems (e.g. Gauss) of vector calculus.
+! Discrete tensor fields are defined on a given finite volume mesh.
+! That means we are expecting discrete volume/surface scalar/vector/tensor fields.
+! Included operations are:
+! fviLaplacian (volField -> type(fvEquation)/type(fvVectorEquation))
+!
+! Author: Nikola Mirkov
+! This is a part of freeCappuccino.
+! The code is licenced under GPL licence.
+!
+
+use types
+use geometry
+use tensorFields
+use fvEquation
+! use fvxInterpolation
+! use gradients
+
+implicit none
+
+interface fviLaplacian
+ module procedure fvi_Lapl_volScalarField
+ ! module procedure fvi_Lapl_volVectorField
+ ! module procedure fvi_Lapl_surfaceVectorField
+end interface
+
+public
+
+contains
+
+function fvi_Lapl_volScalarField(mu,phi) result(fvEq)
+!
+! Description:
+! Implicit FVM discretization of Laplacian operator.
+! Usage:
+! [type(fvVectorEquation)] fvEq = fviLaplacian( [type(volumeScalarField)] phi )
+!
+! System of linear equations is written as:
+! $ a_p^{(i)}*\phi_p^(i)-\sum_{j=1}^{nb} a_j^{(i)}*\phi_j^(i) = b_p{(i)}, i=1,ncells $
+!
+
+ implicit none
+
+ type(volumeScalarField), intent(in) :: phi
+ type(volumeScalarField), intent(in) :: mu
+
+!
+! > Result
+!
+ type(fvVectorEquation) :: fvEq
+
+ !
+ ! Local variables
+ !
+
+ integer :: i, k, ijp, ijn
+ integer :: ib,ijb,iface
+ real(dp) :: cap, can
+ real(dp) :: are,dpw,dcoef
+
+
+ ! Initialize matrix array
+ fvEq%a = 0.0_dp
+
+ ! > Assemble Laplacian system matrix
+
+ ! Internal faces:
+ do i = 1,numInnerFaces
+
+ ijp = owner(i)
+ ijn = neighbour(i)
+
+ call facefluxlaplacian(ijp, ijn, arx(i), ary(i), arz(i), facint(i), mu%mag, cap, can)
+
+ ! > Off-diagonal elements:
+
+ ! (icell,jcell) matrix element:
+ k = icell_jcell_csr_index(i)
+ fvEq%a(k) = can
+
+ ! (jcell,icell) matrix element:
+ k = jcell_icell_csr_index(i)
+ fvEq%a(k) = cap
+
+ ! > Elements on main diagonal:
+
+ ! (icell,icell) main diagonal element
+ k = diag(ijp)
+ fvEq%a(k) = fvEq%a(k) - can
+
+ ! (jcell,jcell) main diagonal element
+ k = diag(ijn)
+ fvEq%a(k) = fvEq%a(k) - cap
+
+ end do
+
+
+!.....Modify matrix coefficients to reflect presence of Boundary Conditions in PDE problem.
+
+ do ib=1,numBoundaries
+
+ !if ( bctype(ib) == '') then
+
+ ! If boundary is fixed value type
+ do i=1,nfaces(ib)
+
+ iface = startFace(ib) + i
+ ijp = owner(iface)
+ ijb = iBndValueStart(ib) + i
+
+ are = sqrt(arx(iface)**2+ary(iface)**2+arz(iface)**2)
+ dpw = sqrt( (xc(ijp)-xf(iface))**2 + (yc(ijp)-yf(iface))**2 + (zc(ijp)-zf(iface))**2 )
+
+ dcoef = mu%mag(ijp)*are/dpw
+ fvEq%a( diag(ijp) ) = fvEq%a( diag(ijp) ) - dcoef
+ fvEq%su(ijp) = fvEq%su(ijp) - dcoef*phi(ijb)
+
+ enddo
+
+ !if ( bctype(ib) == '') then
+
+ ! If boundary is fixed gradient type
+ do i=1,nfaces(ib)
+
+ iface = startFace(ib) + i
+ ijp = owner(iface)
+ ijb = iBndValueStart(ib) + i
+
+ are = sqrt(arx(iface)**2+ary(iface)**2+arz(iface)**2)
+
+ fvEq%su(ijp) = fvEq%su(ijp) - gradVal*are
+
+ enddo
+
+
+ !endif
+
+ enddo
+
+
+end subroutine
+
+
+
+!***********************************************************************
+!
+subroutine facefluxuvw(ijp, ijn, xf, yf, zf, arx, ary, arz, flomass, lambda, gam, cap, can, sup, svp, swp)
+!
+!***********************************************************************
+!
+! Face fluxes of velocity for inner faces.
+!
+!***********************************************************************
+!
+ implicit none
+
+
+ integer, intent(in) :: ijp, ijn
+ real(dp), intent(in) :: xf,yf,zf
+ real(dp), intent(in) :: arx, ary, arz
+ real(dp), intent(in) :: flomass
+ real(dp), intent(in) :: lambda
+ real(dp), intent(in) :: gam
+ real(dp), intent(inout) :: cap, can
+ real(dp), intent(inout) :: sup, svp, swp
+
+ ! Local variables
+ integer :: nrelax
+ character(len=12) :: approach
+ real(dp) :: are,dpn
+ real(dp) :: xpn,ypn,zpn
+ real(dp) :: cp,ce
+ real(dp) :: duxi,duyi,duzi, &
+ dvxi,dvyi,dvzi, &
+ dwxi,dwyi,dwzi
+ real(dp) :: duxii,dvxii,dwxii, &
+ duyii,dvyii,dwyii, &
+ duzii,dvzii,dwzii
+ real(dp) :: de, game
+ real(dp) :: fxp,fxn
+ real(dp) :: fuuds,fvuds,fwuds,fuhigh,fvhigh,fwhigh
+ real(dp) :: ue, ve, we
+ real(dp) :: fdue,fdve,fdwe,fdui,fdvi,fdwi
+!----------------------------------------------------------------------
+
+
+ ! > Geometry:
+
+ ! Face interpolation factor
+ fxn=lambda
+ fxp=1.0_dp-lambda
+
+ ! Distance vector between cell centers
+ xpn=xc(ijn)-xc(ijp)
+ ypn=yc(ijn)-yc(ijp)
+ zpn=zc(ijn)-zc(ijp)
+
+ ! Distance from P to neighbor N
+ dpn=sqrt(xpn**2+ypn**2+zpn**2)
+
+ ! cell face area
+ are=sqrt(arx**2+ary**2+arz**2)
+
+
+ ! > Equation coefficients:
+
+ ! Cell face viscosity
+ game = vis(ijp)*fxp+vis(ijn)*fxn
+
+ ! Difusion coefficient
+ ! de = game*are/dpn
+ de = game*(arx*arx+ary*ary+arz*arz)/(xpn*arx+ypn*ary+zpn*arz)
+
+ can = -de
+ cap = -de
+
+
+ ! > Explicit diffusion:
+
+ nrelax = 0
+ approach = 'skewness'
+
+ call sngrad(ijp, ijn, xf, yf, zf, arx, ary, arz, lambda, &
+ u, dudxi, nrelax, approach, duxi, duyi, duzi, &
+ duxii, duyii, duzii)
+
+ call sngrad(ijp, ijn, xf, yf, zf, arx, ary, arz, lambda, &
+ v, dvdxi, nrelax, approach, dvxi, dvyi, dvzi, &
+ dvxii, dvyii, dvzii)
+
+ call sngrad(ijp, ijn, xf, yf, zf, arx, ary, arz, lambda, &
+ w, dwdxi, nrelax, approach, dwxi, dwyi, dwzi, &
+ dwxii, dwyii, dwzii)
+
+!---------------------------------------------------------------------------------------
+! We calculate explicit and implicit diffusion fde and fdi,
+! later we put their difference (fde-fdi) to rhs vector:
+! su = su + (fdue-fdui)
+! sv = sv + (fdve-fdvi)
+! sw = sw + (fdwe-fdwi)
+!---------------------------------------------------------------------------------------
+
+ ! Explicit diffussion:
+ fdue = game*( (duxii+duxii)*arx + (duyii+dvxii)*ary + (duzii+dwxii)*arz )
+ fdve = game*( (duyii+dvxii)*arx + (dvyii+dvyii)*ary + (dvzii+dwyii)*arz )
+ fdwe = game*( (duzii+dwxii)*arx + (dwyii+dvzii)*ary + (dwzii+dwzii)*arz )
+
+ ! Implicit diffussion:
+ fdui = game*are/dpn*(duxi*xpn+duyi*ypn+duzi*zpn)
+ fdvi = game*are/dpn*(dvxi*xpn+dvyi*ypn+dvzi*zpn)
+ fdwi = game*are/dpn*(dwxi*xpn+dwyi*ypn+dwzi*zpn)
+
+
+! > Explicit part of diffusion fluxes and sources due to deffered correction.
+
+ sup = fdue-fdui
+ svp = fdve-fdvi
+ swp = fdwe-fdwi
+
+end subroutine
+
+
+
+!***********************************************************************
+!
+subroutine faceFluxLaplacian(ijp, ijn, arx, ary, arz, lambda, mu, cap, can)
+!
+!***********************************************************************
+!
+ use types
+ use parameters
+ use geometry, only: numCells,xc,yc,zc
+
+ implicit none
+
+ integer, intent(in) :: ijp, ijn
+ real(dp), intent(in) :: arx, ary, arz
+ real(dp), intent(in) :: lambda
+ real(dp), dimension(numCells), intent(in) :: mu
+ real(dp), intent(inout) :: cap, can
+
+ ! Local variables
+ real(dp) :: fxn, fxp
+ real(dp) :: xpn,ypn,zpn
+ real(dp) :: smdpn
+
+ ! real(dp) :: are
+ ! real(dp) :: dpn
+
+ ! Face interpolation factor
+ fxn=lambda
+ fxp=1.0_dp-lambda
+
+ ! Distance vector between cell centers
+ xpn=xc(ijn)-xc(ijp)
+ ypn=yc(ijn)-yc(ijp)
+ zpn=zc(ijn)-zc(ijp)
+
+ ! _ _
+ ! First way: |Sf|/|dpn|
+ !
+ ! distance from p to p_j
+ ! dpn = sqrt(xpn**2+ypn**2+zpn**2)
+ ! cell face area
+ ! are=sqrt(arx**2+ary**2+arz**2)
+ ! smdpn = are/dpn
+
+ ! _ _ _ _
+ ! Second way: Sf . Sf / (Sf . dpn)
+ smdpn = (arx*arx+ary*ary+arz*arz)/(arx*xpn+ary*ypn+arz*zpn)
+
+ ! Coefficients of discretized Laplace equation
+ cap = (fxp*mu(ijp)+fxn*mu(ijn))*smdpn
+ can = cap
+
+end subroutine
+
+end module
diff --git a/src/finiteVolume/fvImplicit/fviSuSp.f90 b/src/finiteVolume/fvImplicit/fviSuSp.f90
new file mode 100644
index 0000000..72b067c
--- /dev/null
+++ b/src/finiteVolume/fvImplicit/fviSuSp.f90
@@ -0,0 +1,273 @@
+! 00204 fvm.diag() += mesh.V()*max(susp.field(), scalar(0));
+! 00205
+! 00206 fvm.source() -= mesh.V()*min(susp.field(), scalar(0))
+
+module fviSources
+!
+! Purpose:
+! Module contanins functions for discretisation of source terms.
+!
+! Author: Nikola Mirkov
+! This is a part of freeCappuccino.
+! The code is licenced under GPL licence.
+!
+use types
+use geometry
+use tensorFields
+use fvEquation
+
+implicit none
+
+
+ interface fviSu
+ module procedure fvi_su_scalar_field
+ module procedure fvi_su_vector_field
+ end interface
+
+ interface fviSp
+ module procedure fvi_sp_scalar_field
+ module procedure fvi_sp_vector_field
+ end interface
+
+ interface fviSuSp
+ module procedure fvi_susp_scalar_field
+ module procedure fvi_susp_vector_field
+ end interface
+
+public
+
+contains
+
+
+function fvi_su_scalar_field(su,psi) result(fvEqn)
+!
+! Description:
+! Explicit discretization of the source term.
+!
+! Usage:
+!
+
+ implicit none
+
+
+!
+! > Locals
+!
+ integer :: icell
+
+!
+! > Cell loop
+!
+ cell_loop: do icell=1,numCells
+
+ fvEqn%su( icell ) = fvEqn%su( icell ) - su%mag(icell) * Vol(icell)
+
+ enddo cell_loop
+
+end function fvi_su_scalar_field
+
+
+
+function fvi_su_vector_field(su,U) result(fvEqn)
+!
+! Description:
+! Explicit discretization of the source term for the vector field U.
+!
+! Usage:
+!
+
+ implicit none
+
+ type(volVectorField), intent(in) :: su
+ type(volVectorField), intent(in), optional :: U
+
+!
+! > Result
+!
+ type(fvVectorEquation) :: fvEqn
+!
+! > Locals
+!
+ integer :: icell
+
+!
+! > Cell loop
+!
+ cell_loop: do icell=1,numCells
+
+ fvEqn%su( icell ) = fvEqn%su( icell ) - su%x(icell) * Vol(icell)
+ fvEqn%sv( icell ) = fvEqn%sv( icell ) - su%y(icell) * Vol(icell)
+ fvEqn%sw( icell ) = fvEqn%sw( icell ) - su%z(icell) * Vol(icell)
+
+ enddo cell_loop
+
+end function fvi_su_vector_field
+
+
+
+
+function fvi_sp_scalar_field(sp,psi) result(fvEqn)
+!
+! Description:
+! Implicit discretization of the source term.
+!
+! Usage:
+!
+
+ implicit none
+
+ type(volScalarField), intent(in) :: sp
+ type(volScalarField), intent(in) :: psi
+
+!
+! > Result
+!
+ type(fvEquation) :: fvEqn
+!
+! > Locals
+!
+ integer :: icell
+
+!
+! > Cell loop
+!
+ cell_loop: do icell=1,numCells
+
+ fvEqn%a( diag(icell) ) = fvEqn%a( diag(icell) ) + sp%mag(icell) / ( psi%mag(icell) + small ) * Vol(icell)
+ ! ...or...
+ ! fvEqn%sp( icell ) = fvEqn%sp( icell ) + sp%mag(icell) / ( psi%mag(icell) + small ) * Vol(icell)
+
+ enddo cell_loop
+
+end function fvi_sp_scalar_field
+
+
+
+
+
+function fvi_sp_vector_field(sp,U) result(fvEqn)
+!
+! Description:
+! Implicit discretization of the source term for the vector field U.
+!
+! Usage:
+!
+
+ implicit none
+
+ type(volVectorField), intent(in) :: sp
+ type(volVectorField), intent(in) :: U
+
+!
+! > Result
+!
+ type(fvVectorEquation) :: fvEqn
+!
+! > Locals
+!
+ integer :: icell
+
+!
+! > Cell loop
+!
+ cell_loop: do icell=1,numCells
+
+ fvEqn%spu(icell) = fvEqn%spu(icell) + sp%x(icell) / ( U%x(icell) + small ) * Vol(icell)
+ fvEqn%spv(icell) = fvEqn%spv(icell) + sp%y(icell) / ( U%y(icell) + small ) * Vol(icell)
+ fvEqn%spw(icell) = fvEqn%spw(icell) + sp%z(icell) / ( U%z(icell) + small ) * Vol(icell)
+
+ enddo cell_loop
+
+end function fvi_sp_vector_field
+
+
+function fvi_susp_scalar_field(susp,psi) result(fvEqn)
+!
+! Description:
+! Implicit-Explicit discretization of the source term.
+!
+! Comment:
+! We don't allow source term to spoil diagonal dominance
+! of the linear system matrix, so if it is negative,
+! we automatically move it to rhs, i.e. to source of fvEquation.
+!
+! Usage:
+!
+
+ implicit none
+
+ type(volScalarField), intent(in) :: susp
+ type(volScalarField), intent(in) :: psi
+
+!
+! > Result
+!
+ type(fvEquation) :: fvEqn
+!
+! > Locals
+!
+ integer :: icell
+
+!
+! > Cell loop
+!
+ cell_loop: do icell=1,numCells
+
+ fvEqn%a( diag(icell) ) = fvEqn%a( diag(icell) ) + max( susp%mag(icell), zero) / ( psi%mag(icell) + small ) * Vol(icell)
+
+ fvEqn%su( icell ) = fvEqn%su( icell ) - min( susp%mag(icell), zero ) * Vol(icell)
+
+ enddo cell_loop
+
+end function fvi_susp_scalar_field
+
+
+
+
+
+function fvi_susp_vector_field(susp,U) result(fvEqn)
+!
+! Description:
+! Implicit-Explicit discretization of the source term.
+!
+! Comment:
+! We don't allow source term to spoil diagonal dominance
+! of the linear system matrix, so if it is negative,
+! we automatically move it to rhs, i.e. to source of fvVectorEquation.
+!
+! Usage:
+!
+
+ implicit none
+
+ type(volVectorField), intent(in) :: susp
+ type(volVectorField), intent(in) :: U
+
+!
+! > Result
+!
+ type(fvVectorEquation) :: fvEqn
+!
+! > Locals
+!
+ integer :: icell
+
+!
+! > Cell loop
+!
+ cell_loop: do icell=1,numCells
+
+ fvEqn%spu(icell) = fvEqn%spu(icell) + max( susp%x(icell), zero) / ( U%x(icell) + small ) * Vol(icell)
+ fvEqn%spv(icell) = fvEqn%spv(icell) + max( susp%y(icell), zero) / ( U%y(icell) + small ) * Vol(icell)
+ fvEqn%spw(icell) = fvEqn%spw(icell) + max( susp%z(icell), zero) / ( U%z(icell) + small ) * Vol(icell)
+
+ fvEqn%su( icell ) = fvEqn%su( icell ) - min( susp%x(icell), zero ) * Vol(icell)
+ fvEqn%sv( icell ) = fvEqn%sv( icell ) - min( susp%y(icell), zero ) * Vol(icell)
+ fvEqn%sw( icell ) = fvEqn%sw( icell ) - min( susp%z(icell), zero ) * Vol(icell)
+
+
+ enddo cell_loop
+
+end function fvi_susp_vector_field
+
+end module
\ No newline at end of file
diff --git a/src/finiteVolume/fvImplicit/fvm_ddt.f90 b/src/finiteVolume/fvImplicit/fvm_ddt.f90
deleted file mode 100644
index e67331b..0000000
--- a/src/finiteVolume/fvImplicit/fvm_ddt.f90
+++ /dev/null
@@ -1,206 +0,0 @@
-subroutine fvm_ddt_vector_field
-!
-!******************************************************************************
-!
-! Finds source and matrix coefficients representing FVM discretization
-! of time derivative operator: \partial / \partial t.
-!
-! System of linear equations is written as:
-! $ a_p^{(i)}*\phi_p^(i)-\sum_{j=1}^{nb} a_j^{(i)}*\phi_j^(i) = b_p{(i)}, i=1,ncells $
-!
-!******************************************************************************
-!
- use types
- use parameters
- use geometry
- use variables
- use sparse_matrix
-
- implicit none
-
- integer :: inp
- real(dp) :: apotime, sut, svt, swt
-
-!
-! > Shift in time
-!
- ! fvEqn%xoo(:) = fvEqn%xo(:)
- ! fvEqn%yoo(:) = fvEqn%yo(:)
- ! fvEqn%zoo(:) = fvEqn%zo(:)
-
- ! fvEqn%xo(:) = U%x(:)
- ! fvEqn%yo(:) = U%y(:)
- ! fvEqn%zo(:) = U%z(:)
-
- ! CALCULATE SOURCE TERMS INTEGRATED OVER VOLUME
- do inp=1,numCells
-
- ! For u sp => spu; for v sp => spv; for w sp => sp
- spu(inp) = 0.0_dp
- spv(inp) = 0.0_dp
- sp(inp) = 0.0_dp
-
- !=======================================================================
- ! Unsteady term
- !=======================================================================
- if(bdf) then
- !-----------------------------------------------------------------------
- ! Backward differentiation formula:
- ! in case that BTIME=0. --> Implicit Euler
- ! in case that BTIME=1. --> Three Level Implicit Time Integration Method or BDF2
- !-----------------------------------------------------------------------
- apotime=den(inp)*vol(inp)/timestep
-
- sut = apotime*((1+btime)*uo(inp))
- svt = apotime*((1+btime)*vo(inp))
- swt = apotime*((1+btime)*wo(inp))
-
- if (btime > 0.99) then ! bdf2 scheme btime=1.
- sut = sut - apotime*(0.5*btime*uoo(inp))
- svt = svt - apotime*(0.5*btime*voo(inp))
- swt = swt - apotime*(0.5*btime*woo(inp))
- endif
-
- su(inp) = su(inp) + sut
- sv(inp) = sv(inp) + svt
- sw(inp) = sw(inp) + swt
-
- spu(inp) = spu(inp) + apotime*(1+0.5*btime)
- spv(inp) = spv(inp) + apotime*(1+0.5*btime)
- sp(inp) = sp(inp) + apotime*(1+0.5*btime)
- !-----------------------------------------------------------------------
- endif
-
- end do
-
-
-end subroutine
-
-
-subroutine fvm_ddt_scalar_field
-!
-!******************************************************************************
-!
-! Finds source and matrix coefficients representing FVM discretization
-! of time derivative operator: \partial / \partial t.
-!
-! System of linear equations is written as:
-! $ a_p^{(i)}*\phi_p^(i)-\sum_{j=1}^{nb} a_j^{(i)}*\phi_j^(i) = b_p{(i)}, i=1,ncells $
-!
-!******************************************************************************
-!
- use types
- use parameters
- use geometry
- use variabeles
- use sparse_matrix
-
- implicit none
-
- integer :: inp
- real(dp) :: apotime, sut
-
-!
-! > Shift in time
-!
- ! fvEqn%oo(:) = fvEqn%o(:)
- ! fvEqn%o(:) = phi%mag(:)
-
- ! CALCULATE SOURCE TERMS INTEGRATED OVER VOLUME
- do inp=1,numCells
-
- !.....for u sp => spu; for v sp => spv; for w sp => sp
- !.....sum source terms
- spu(inp) = 0.0_dp
-
- !=======================================================================
- ! Unsteady term
- !=======================================================================
- if(bdf) then
- !-----------------------------------------------------------------------
- ! Backward differentiation formula:
- ! in case that BTIME=0. --> Implicit Euler
- ! in case that BTIME=1. --> Three Level Implicit Time Integration Method or BDF2
- !-----------------------------------------------------------------------
- apotime=den(inp)*vol(inp)/timestep
-
- sut = apotime*((1+btime)*uo(inp))
-
- if (btime > 0.99) then ! bdf2 scheme
- sut = sut - apotime*(0.5*btime*uoo(inp))
- endif
-
- su(inp) = su(inp) + sut
-
- spu(inp) = spu(inp) + apotime*(1+0.5*btime)
- !-----------------------------------------------------------------------
- endif
-
- end do
-
-
-end subroutine
-
-
-
-subroutine fvm_d2dt2_scalar_field
-!
-!******************************************************************************
-!
-! Description:
-! Second order time differentiation for scalar fields.
-!
-! Finds source and matrix coefficients representing FVM discretization
-! of scnd. order time derivative operator: \partial^2 / \partial t^2.
-!
-! System of linear equations is written as:
-! $ a_p^{(i)}*\phi_p^(i)-\sum_{j=1}^{nb} a_j^{(i)}*\phi_j^(i) = b_p{(i)}, i=1,ncells $
-!
-!******************************************************************************
-!
- use types
- use parameters
- use geometry
- use sparse_matrix
-
- implicit none
-
-!
-! > Shift in time
-!
- ! fvEqn%oo(:) = fvEqn%o(:)
- ! fvEqn%o(:) = phi%mag(:)
-
- ! spu(1:numCells) = den(1:numCells)*vol(1:numCells)/timestep**2
- ! su(1:numCells) = den(1:numCells)*vol(1:numCells)/timestep**2 * (2*uo(1:numCells) - uoo(1:numCells))
-
- ! CALCULATE SOURCE TERMS INTEGRATED OVER VOLUME
- do inp=1,numCells
-
- !.....for u sp => spu; for v sp => spv; for w sp => sp
- !.....sum source terms
- spu(inp) = 0.0_dp
-
- !=======================================================================
- ! Unsteady term
- !=======================================================================
- if(bdf) then
- !-----------------------------------------------------------------------
- ! Backward differentiation formula:
- ! in case that BTIME=0. --> Implicit Euler
- ! in case that BTIME=1. --> Three Level Implicit Time Integration Method or BDF2
- !-----------------------------------------------------------------------
- apotime=den(inp)*vol(inp)/timestep**2
-
- sut = apotime*(2*uo(inp) - uoo(inp))
-
- su(inp) = su(inp) + sut
-
- spu(inp) = spu(inp) + apotime
- !-----------------------------------------------------------------------
- endif
-
- end do
-
-
-end subroutine
\ No newline at end of file
diff --git a/src/finiteVolume/fvImplicit/fvm_div.f90 b/src/finiteVolume/fvImplicit/fvm_div.f90
deleted file mode 100644
index 22e2c64..0000000
--- a/src/finiteVolume/fvImplicit/fvm_div.f90
+++ /dev/null
@@ -1,425 +0,0 @@
-subroutine Div(phi,u)
-!
-!******************************************************************************
-!
-! Fills matrix with coefficients representing implicit FVM discretization
-! of dicergence operator: div(rho*u).
-!
-! System of linear equations is written as:
-! $ a_p^{(i)}*\phi_p^(i)-\sum_{j=1}^{nb} a_j^{(i)}*\phi_j^(i) = b_p{(i)}, i=1,ncells $
-!
-!******************************************************************************
-!
- use types
- use parameters
- use geometry
- use sparse_matrix
-
- implicit none
-
- real(dp), dimension(...), intent(in) :: phi
- real(dp), dimension(numTotal), intent(in) :: u
-
- !
- ! Local variables
- !
-
- integer :: i, k, ijp, ijn, ijb, iface
- real(dp) :: cap, can
- real(dp) :: are,dpw
- real(dp) :: gam
- real(dp) :: sup, svp, swp
-
-
- ! Initialize matrix array
- a = 0.0_dp
-
- ! > Assemble Laplacian system matrix
-
- ! Internal faces:
- do i = 1,numInnerFaces
-
- ijp = owner(i)
- ijn = neighbour(i)
-
- call facefluxconvective(ijp, ijn, xf(i), yf(i), zf(i), phi(i), facint(i), gam, cap, can, sup, svp, swp)
-
- ! > Off-diagonal elements:
-
- ! (icell,jcell) matrix element:
- k = icell_jcell_csr_index(i)
- a(k) = can
-
- ! (jcell,icell) matrix element:
- k = jcell_icell_csr_index(i)
- a(k) = cap
-
- ! > Elements on main diagonal:
-
- ! (icell,icell) main diagonal element
- k = diag(ijp)
- a(k) = a(k) - can
-
- ! (jcell,jcell) main diagonal element
- k = diag(ijn)
- a(k) = a(k) - cap
-
- ! > Sources:
-
- su(ijp) = su(ijp) + sup
- sv(ijp) = sv(ijp) + svp
- sw(ijp) = sw(ijp) + swp
-
- su(ijn) = su(ijn) - sup
- sv(ijn) = sv(ijn) - svp
- sw(ijn) = sw(ijn) - swp
-
- end do
-
-
-
-!.....Modify matrix coefficients to reflect presence of Boundary Conditions in PDE problem.
-
- ! Contribution from inlet boundaries
- do i=1,ninl
- iface = iInletFacesStart+i
- ijp = owner(iface)
- ijb = iInletStart+i
-
- k=diag(ijp)
- are = sqrt(arx(iface)**2+ary(iface)**2+arz(iface)**2)
- dpw = sqrt( (xc(ijp)-xf(iface))**2 + (yc(ijp)-yf(iface))**2 + (zc(ijp)-zf(iface))**2 )
-
- a(k) = a(k) - mu(ijp)*are/dpw !..or mu_wall*are/dpw;
- su(ijp) = su(ijp) + a(k)*phi(ijb)
-
- end do
-
- ! Contribution from outlet boundaries
- do i=1,nout
- iface = iOutletFacesStart+i
- ijp = owner(iface)
- ijb = iOutletStart+i
-
- k=diag(ijp)
- are = sqrt(arx(iface)**2+ary(iface)**2+arz(iface)**2)
- dpw = sqrt( (xc(ijp)-xf(iface))**2 + (yc(ijp)-yf(iface))**2 + (zc(ijp)-zf(iface))**2 )
-
- a(k) = a(k) - mu(ijp)*are/dpw !..or mu_wall*are/dpw;
- su(ijp) = su(ijp) + a(k)*phi(ijb)
-
- end do
-
- ! Contribution from symmetry boundaries
- do i=1,nsym
- iface = iSymmetryFacesStart
- ijp = owner(iface)
- ijb = iSymmetryStart+i
-
- k=diag(ijp)
-
- are = sqrt(arx(iface)**2+ary(iface)**2+arz(iface)**2)
- dpw = sqrt( (xc(ijp)-xf(iface))**2 + (yc(ijp)-yf(iface))**2 + (zc(ijp)-zf(iface))**2 )
-
- a(k) = a(k) - mu(ijp)*are/dpw !..or mu_wall*are/dpw;
-
- ! a(k) = a(k) - mu(ijp)*srds(i)
- su(ijp) = su(ijp) + a(k)*phi(ijb)
-
- end do
-
- ! Contribution from wall boundaries
- do i=1,nwal
- iface = iWallFacesStart+i
- ijp = owner(iface)
- ijb = iWallStart+i
-
- k=diag(ijp)
-
- are = sqrt(arx(iface)**2+ary(iface)**2+arz(iface)**2)
- dpw = sqrt( (xc(ijp)-xf(iface))**2 + (yc(ijp)-yf(iface))**2 + (zc(ijp)-zf(iface))**2 )
-
- a(k) = a(k) - mu(ijp)*are/dpw !..or mu_wall*are/dpw;
- ! a(k) = a(k) - mu(ijp)*srdw(i)
- su(ijp) = su(ijp) + a(k)*phi(ijb)
-
- end do
-
- ! Contribution from pressure outlet boundaries
- do i=1,npru
- ijp = owner(iPressOutletFacesStart+i)
- ijb = iPressOutletStart+i
- end do
-
-
-end subroutine
-
-
-
-
-
-!***********************************************************************
-!
-subroutine facefluxconvective(ijp, ijn, xf, yf, zf, flomass, lambda, gam, cap, can, sup, svp, swp)
-!
-!***********************************************************************
-!
- use types
- use parameters
- use geometry, only: xc,yc,zc
- use variables
-
- implicit none
-!
-!***********************************************************************
-!
-
- integer, intent(in) :: ijp, ijn
- real(dp), intent(in) :: xf,yf,zf
- ! real(dp), intent(in) :: arx, ary, arz
- real(dp), intent(in) :: flomass
- real(dp), intent(in) :: lambda
- real(dp), intent(in) :: gam
- real(dp), intent(inout) :: cap, can
- real(dp), intent(inout) :: sup, svp, swp
-
-! Local variables
- ! real(dp) :: are
- ! real(dp) :: onethird, twothirds
- real(dp) :: xpn,ypn,zpn
- ! real(dp) :: nxx,nyy,nzz
- ! real(dp) :: ixi1,ixi2,ixi3
- ! real(dp) :: dpn,costheta,costn
- real(dp) :: xi,yi,zi
- real(dp) :: cp,ce
-
- real(dp) :: duxi,duyi,duzi,dvxi,dvyi,dvzi,dwxi,dwyi,dwzi
-
- ! real(dp) :: duxii,dvxii,dwxii, &
- ! duyii,dvyii,dwyii, &
- ! duzii,dvzii,dwzii
-
- ! real(dp) :: d2x,d2y,d2z,d1x,d1y,d1z
-
- ! real(dp) :: de, vole, game
- real(dp) :: fxp,fxn
- real(dp) :: fuuds,fvuds,fwuds,fuhigh,fvhigh,fwhigh
- real(dp) :: ue, ve, we
- ! real(dp) :: fdue,fdve,fdwe,fdui,fdvi,fdwi
- real(dp) :: r1,r2,r3,r4,r5,r6
- real(dp) :: psie1,psie2,psie3,psiw1,psiw2,psiw3
-!----------------------------------------------------------------------
-
-
- ! > Geometry:
-
-
- ! Face interpolation factor
- fxn=lambda
- fxp=1.0_dp-lambda
-
- ! Distance vector between cell centers
- xpn=xc(ijn)-xc(ijp)
- ypn=yc(ijn)-yc(ijp)
- zpn=zc(ijn)-zc(ijp)
-
- ! Coordinates of point j'
- xi = xc(ijp)*fxp+xc(ijn)*fxn
- yi = yc(ijp)*fxp+yc(ijn)*fxn
- zi = zc(ijp)*fxp+zc(ijn)*fxn
-
- ! > Equation coefficients:
-
- can = min(flomass,zero)
- cap = -max(flomass,zero)
-
-
- ! > Explicit part due to deffered correction:
-
-
- ! Interpolate gradients defined at cv centers to faces
- duxi = dUdxi(1,ijp)*fxp+dUdxi(1,ijn)*fxn
- duyi = dUdxi(2,ijp)*fxp+dUdxi(2,ijn)*fxn
- duzi = dUdxi(3,ijp)*fxp+dUdxi(3,ijn)*fxn
-
- dvxi = dVdxi(1,ijp)*fxp+dVdxi(1,ijn)*fxn
- dvyi = dVdxi(2,ijp)*fxp+dVdxi(2,ijn)*fxn
- dvzi = dVdxi(3,ijp)*fxp+dVdxi(3,ijn)*fxn
-
- dwxi = dWdxi(1,ijp)*fxp+dWdxi(1,ijn)*fxn
- dwyi = dWdxi(2,ijp)*fxp+dWdxi(2,ijn)*fxn
- dwzi = dWdxi(3,ijp)*fxp+dWdxi(3,ijn)*fxn
-
-
-
- ! > Explicit convection:
-
- ! Explicit convective fluxes for UDS
- fuuds=max(flomass,zero)*u(ijp)+min(flomass,zero)*u(ijn)
- fvuds=max(flomass,zero)*v(ijp)+min(flomass,zero)*v(ijn)
- fwuds=max(flomass,zero)*w(ijp)+min(flomass,zero)*w(ijn)
-
-
- ! Initialize explicit convective fluxes for higher-order schemes
- fuhigh=0.0_dp
- fvhigh=0.0_dp
- fwhigh=0.0_dp
-
- ! Explicit convective fluxes for CDS
- if(lcds) then
-
- ! > Velocities at cell face center
-
- ! |________uj'_________|_______________ucorr___________________|
- ue=u(ijp)*fxp+u(ijn)*fxn+(duxi*(xf-xi)+duyi*(yf-yi)+duzi*(zf-zi))
- ! |________vj'_________|_______________vcorr___________________|
- ve=v(ijp)*fxp+v(ijn)*fxn+(dvxi*(xf-xi)+dvyi*(yf-yi)+dvzi*(zf-zi))
- ! |________wj'_________|_______________wcorr___________________|
- we=w(ijp)*fxp+w(ijn)*fxn+(dwxi*(xf-xi)+dwyi*(yf-yi)+dwzi*(zf-zi))
-
- ! ue = face_interpolated(u,dUdxi,inp,idew,idns,idtb,fxp,fxe)
- ! ve = face_interpolated(v,dVdxi,inp,idew,idns,idtb,fxp,fxe)
- ! we = face_interpolated(w,dWdxi,inp,idew,idns,idtb,fxp,fxe)
-
- fuhigh=flomass*ue
- fvhigh=flomass*ve
- fwhigh=flomass*we
-
- end if
-
-!--------------------------------------------------------------------------------------------
-! BOUNDED HIGH-ORDER CONVECTIVE SCHEMES (Waterson & Deconinck JCP 224 (2007) pp. 182-207)
-!--------------------------------------------------------------------------------------------
- if(lsmart.or.lavl.or.lmuscl.or.lumist.or.lgamma) then
-
- !.... find r's. this is universal for all schemes.
- !.....if flow goes from p to e
- r1 = (2*dUdxi(1,ijp)*xpn + 2*dUdxi(2,ijp)*ypn + 2*dUdxi(3,ijp)*zpn)/(u(ijn)-u(ijp)) - 1.0_dp
- r2 = (2*dVdxi(1,ijp)*xpn + 2*dVdxi(2,ijp)*ypn + 2*dVdxi(3,ijp)*zpn)/(v(ijn)-v(ijp)) - 1.0_dp
- r3 = (2*dWdxi(1,ijp)*xpn + 2*dWdxi(2,ijp)*ypn + 2*dWdxi(3,ijp)*zpn)/(w(ijn)-w(ijp)) - 1.0_dp
- !.....if flow goes from e to p
- r4 = (2*dUdxi(1,ijn)*xpn + 2*dUdxi(2,ijn)*ypn + 2*dUdxi(3,ijn)*zpn)/(u(ijp)-u(ijn)) - 1.0_dp
- r5 = (2*dVdxi(1,ijn)*xpn + 2*dVdxi(2,ijn)*ypn + 2*dVdxi(3,ijn)*zpn)/(v(ijp)-v(ijn)) - 1.0_dp
- r6 = (2*dWdxi(1,ijn)*xpn + 2*dWdxi(2,ijn)*ypn + 2*dWdxi(3,ijn)*zpn)/(w(ijp)-w(ijn)) - 1.0_dp
-
-
- !=====smart scheme================================
- if(lsmart) then
- !.....psi for smart scheme:
- !.....if flow goes from p to e
- psiw1 = max(0., min(2.*r1, 0.75*r1+0.25, 4.))
- psiw2 = max(0., min(2.*r2, 0.75*r2+0.25, 4.))
- psiw3 = max(0., min(2.*r3, 0.75*r3+0.25, 4.))
- !.....if flow goes from e to p
- psie1 = max(0., min(2.*r4, 0.75*r4+0.25, 4.))
- psie2 = max(0., min(2.*r5, 0.75*r5+0.25, 4.))
- psie3 = max(0., min(2.*r6, 0.75*r6+0.25, 4.))
- !=====end smart scheme=============================
-
-
- !=====avl-smart scheme=============================
- elseif(lavl) then
- !.....psi for avl-smart scheme:
- !.....if flow goes from p to e
- psiw1 = max(0., min(1.5*r1, 0.75*r1+0.25, 2.5))
- psiw2 = max(0., min(1.5*r2, 0.75*r2+0.25, 2.5))
- psiw3 = max(0., min(1.5*r3, 0.75*r3+0.25, 2.5))
- !.....if flow goes from e to p
- psie1 = max(0., min(1.5*r4, 0.75*r4+0.25, 2.5))
- psie2 = max(0., min(1.5*r5, 0.75*r5+0.25, 2.5))
- psie3 = max(0., min(1.5*r6, 0.75*r6+0.25, 2.5))
- !=====end avl-smart scheme==========================
-
-
- !=====muscl scheme=================================
- elseif(lmuscl) then
- !.....psi for muscl scheme:
- !.....if flow goes from p to e
- psiw1 = max(0., min(2.*r1, 0.5*r1+0.5, 2.))
- psiw2 = max(0., min(2.*r2, 0.5*r2+0.5, 2.))
- psiw3 = max(0., min(2.*r3, 0.5*r3+0.5, 2.))
- !.....if flow goes from e to p
- psie1 = max(0., min(2.*r4, 0.5*r4+0.5, 2.))
- psie2 = max(0., min(2.*r5, 0.5*r5+0.5, 2.))
- psie3 = max(0., min(2.*r6, 0.5*r6+0.5, 2.))
- !=====end muscl scheme=============================
-
-
- !=====umist scheme=================================
- elseif(lumist) then
- !.....psi for umist scheme:
- !.....if flow goes from p to e
- psiw1 = max(0., min(2.*r1, 0.75*r1+0.25, 0.25*r1+0.75, 2.))
- psiw2 = max(0., min(2.*r2, 0.75*r2+0.25, 0.25*r2+0.75, 2.))
- psiw3 = max(0., min(2.*r3, 0.75*r3+0.25, 0.25*r3+0.75, 2.))
- !.....if flow goes from e to p
- psie1 = max(0., min(2.*r4, 0.75*r4+0.25, 0.25*r4+0.75, 2.))
- psie2 = max(0., min(2.*r5, 0.75*r5+0.25, 0.25*r5+0.75, 2.))
- psie3 = max(0., min(2.*r6, 0.75*r6+0.25, 0.25*r6+0.75, 2.))
- !=====end umist scheme=============================
-
- !=====gamma scheme================================
- elseif(lgamma) then
- !.....psi for gamma scheme:
- !.....if flow goes from p to e
- psiw1 = max(0., min(r1, 2.*r1/(r1+1.)))
- psiw2 = max(0., min(r2, 2.*r2/(r2+1.)))
- psiw3 = max(0., min(r3, 2.*r3/(r3+1.)))
- !.....if flow goes from e to p
- psie1 = max(0., min(r4, 2.*r4/(r4+1.)))
- psie2 = max(0., min(r5, 2.*r5/(r5+1.)))
- psie3 = max(0., min(r6, 2.*r6/(r6+1.)))
- !=====end gamma scheme=============================
-
- !=====luds scheme================================
- else
- !.....psi for 2nd order upwind scheme:
- !.....if flow goes from p to e
- psiw1 = 1.0_dp
- psiw2 = 1.0_dp
- psiw3 = 1.0_dp
- !.....if flow goes from e to p
- psie1 = 1.0_dp
- psie2 = 1.0_dp
- psie3 = 1.0_dp
- !=====end luds scheme=============================
- end if
-
-
-
-!.....EXPLICIT CONVECTIVE FLUXES FOR HIGH ORDER BOUNDED SCHEMES
-! $Flux_high_order_scheme[N] = mass_flow_rate_in_cell_face_e[kg/s] * Phi_e[m/s]$
-! Phi_e is found by extrapolation from upwind nodes, see eq. (3.29) in Sasa's Thesis.
-! Additional multiplication with PSI is application of flux limiters,
-! see eq. (10) in Waterson&Deconinck paper.
-
- ce = min(flomass,zero)
- cp = max(flomass,zero)
-
-!......Darwish-Moukalled TVD schemes for unstructured girds, IJHMT, 2003.
- fuhigh = ce*(u(ijn) + fxn*psie1*(u(ijp)-u(ijn)))+ &
- cp*(u(ijp) + fxp*psiw1*(u(ijn)-u(ijp)))
- ! mass flux| bounded interpolation of velocity to face |
-
- fvhigh = ce*(v(ijn) + fxn*psie2*(v(ijp)-v(ijn)))+ &
- cp*(v(ijp) + fxp*psiw2*(v(ijn)-v(ijp)))
-
- fwhigh = ce*(w(ijn) + fxn*psie3*(w(ijp)-w(ijn)))+ &
- cp*(w(ijp) + fxp*psiw3*(w(ijn)-w(ijp)))
-
-!.....END OF BOUNDED HIGH-ORDER SCHEMES
-!--------------------------------------------------------------------------------------------
- END IF
-
-
-! > Explicit part due to deffered correction.
-
- sup = -gam*(fuhigh-fuuds)
- svp = -gam*(fvhigh-fvuds)
- swp = -gam*(fwhigh-fwuds)
-
-
-end subroutine
-
-
-
diff --git a/src/finiteVolume/fvImplicit/fvm_laplacian.f90 b/src/finiteVolume/fvImplicit/laplacian.f90
similarity index 89%
rename from src/finiteVolume/fvImplicit/fvm_laplacian.f90
rename to src/finiteVolume/fvImplicit/laplacian.f90
index c8ce89b..c9da2b3 100644
--- a/src/finiteVolume/fvImplicit/fvm_laplacian.f90
+++ b/src/finiteVolume/fvImplicit/laplacian.f90
@@ -3,7 +3,7 @@ subroutine laplacian(mu,phi)
!******************************************************************************
!
! Fills matrix with coefficients representing implicit FVM discretization
-! of negative Laplacian operator: -div(mu*grad(phi)).
+! of Laplacian operator: -div(mu*grad(phi)).
!
! System of linear equations is written as:
! $ a_p^{(i)}*\phi_p^(i)-\sum_{j=1}^{nb} a_j^{(i)}*\phi_j^(i) = b_p{(i)}, i=1,ncells $
@@ -24,9 +24,10 @@ subroutine laplacian(mu,phi)
! Local variables
!
- integer :: i, ib, k, ijp, ijn, ijb, iface
+ integer :: i, k, ijp, ijn
+ integer :: ib,ijb,iface
real(dp) :: cap, can
- real(dp) :: are,dpw
+ real(dp) :: are,dpw,dcoef
! Initialize matrix array
@@ -69,7 +70,7 @@ subroutine laplacian(mu,phi)
do ib=1,numBoundaries
- if ( bctype(ib) == 'wall') then
+ !if ( bctype(ib) == 'wall') then
do i=1,nfaces(ib)
@@ -77,18 +78,16 @@ subroutine laplacian(mu,phi)
ijp = owner(iface)
ijb = iBndValueStart(ib) + i
- k = diag(ijp)
-
are = sqrt(arx(iface)**2+ary(iface)**2+arz(iface)**2)
dpw = sqrt( (xc(ijp)-xf(iface))**2 + (yc(ijp)-yf(iface))**2 + (zc(ijp)-zf(iface))**2 )
- a(k) = a(k) - mu(ijp)*are/dpw !..or mu_wall*are/dpw;
- !a(k) = a(k) - mu(ijp)*srdw(i)
- su(ijp) = su(ijp) + a(k)*phi(ijb)
+ dcoef = mu(ijp)*are/dpw
+ a( diag(ijp) ) = a( diag(ijp) ) - dcoef
+ su(ijp) = su(ijp) - dcoef*phi(ijb)
enddo
- endif
+ !endif
enddo
diff --git a/src/finiteVolume/interpolation/interpolation.f90 b/src/finiteVolume/interpolation/interpolation.f90
index 7d2d1c5..e9e13bb 100644
--- a/src/finiteVolume/interpolation/interpolation.f90
+++ b/src/finiteVolume/interpolation/interpolation.f90
@@ -4,11 +4,27 @@ module interpolation
! Various approaches are implemented
!
use types
- use parameters
use geometry, only: numTotal,numCells,xc,yc,zc
implicit none
+ ! Choosing discretization scheme applied for all variables at the moment.
+ logical :: lcds = .false.
+ logical :: lcdsc = .false.
+ logical :: lluds = .false.
+ logical :: lsmart = .false.
+ logical :: lavl = .false.
+ logical :: lmuscl = .false.
+ logical :: lumist = .false.
+ logical :: lkoren = .false.
+ logical :: lcharm = .false.
+ logical :: lospre = .false.
+ logical :: lcds_flnt = .false.
+ logical :: l2nd_flnt = .false.
+ logical :: lmuscl_flnt = .false.
+
+ logical :: flux_limiter = .false.
+
public
contains
@@ -49,7 +65,7 @@ function face_value(ijp,ijn,xf,yf,zf,lambda,u,dUdxi) result(ue)
ue = face_value_muscl(ijp, ijn, xf, yf, zf, u, dUdxi)
elseif (flux_limiter) then
- ue = face_value_2nd_upwind_flux_limiter(ijp, ijn, lambda, u, dUdxi)
+ ue = face_value_2nd_upwind_flux_limiter(ijp, ijn, xf, yf, zf, u, dUdxi)
else
ue = face_value_muscl(ijp, ijn, xf, yf, zf, u, dUdxi)
@@ -59,6 +75,50 @@ function face_value(ijp,ijn,xf,yf,zf,lambda,u,dUdxi) result(ue)
end function
+!***********************************************************************
+!
+function face_value_w_option(ijp,ijn,xf,yf,zf,lambda,u,dUdxi,scheme) result(ue)
+!
+!***********************************************************************
+!
+ implicit none
+
+ ! Result
+ real(dp) :: ue
+
+ ! Input
+ integer :: ijp, ijn
+ real(dp) :: xf, yf, zf,lambda
+ real(dp), dimension(numTotal) :: u
+ real(dp), dimension(3,numCells) :: dUdxi
+ character(len=10), intent(in) :: scheme
+
+
+ if (scheme == 'cds') then
+ ue = face_value_cds(ijp,ijn, lambda, u)
+
+ elseif (scheme == 'cdscorr') then
+ ue = face_value_cds_corrected(ijp, ijn, xf, yf, zf, lambda, u, dUdxi)
+
+ elseif (scheme == 'central') then
+ ue = face_value_central(ijp, ijn, xf, yf, zf, u, dUdxi)
+
+ elseif (scheme == 'sou') then
+ ue = face_value_2nd_upwind(ijp, xf, yf, zf, u, dUdxi)
+
+ elseif (scheme == 'muscl') then
+ ue = face_value_muscl(ijp, ijn, xf, yf, zf, u, dUdxi)
+
+ elseif (scheme == 'flxlim') then
+ ue = face_value_2nd_upwind_flux_limiter(ijp, ijn, xf, yf, zf, u, dUdxi)
+
+ else
+ ue = face_value_muscl(ijp, ijn, xf, yf, zf, u, dUdxi)
+
+
+ endif
+
+end function
!***********************************************************************
!
@@ -163,38 +223,12 @@ function face_value_central(inp,inn, xf, yf, zf, fi, gradfi) result(face_value)
real(dp), dimension(3,numCells) :: gradfi
! Locals
- real(dp) :: phi_p, phi_n
- real(dp) :: xcp,ycp,zcp
- real(dp) :: xcn,ycn,zcn
- real(dp) :: gradfi_p_x,gradfi_p_y,gradfi_p_z
- real(dp) :: gradfi_n_x,gradfi_n_y,gradfi_n_z
real(dp) :: gradfidr
- ! Values at cell center's of neighbouring cells:
- phi_p = fi(inp)
-
- phi_n = fi(inn)
-
- xcp = xc(inp)
- ycp = yc(inp)
- zcp = zc(inp)
-
- xcn = xc(inn)
- ycn = yc(inn)
- zcn = zc(inn)
-
- gradfi_p_x = gradfi(1,inp)
- gradfi_p_y = gradfi(2,inp)
- gradfi_p_z = gradfi(3,inp)
-
- gradfi_n_x = gradfi(1,inn)
- gradfi_n_y = gradfi(2,inn)
- gradfi_n_z = gradfi(3,inn)
-
- gradfidr=gradfi_p_x*(xf-xcp)+gradfi_p_y*(yf-ycp)+gradfi_p_z*(zf-zcp) &
- +gradfi_n_x*(xf-xcn)+gradfi_n_y*(yf-ycn)+gradfi_n_z*(zf-zcn)
+ gradfidr=gradfi(1,inp)*(xf-xc(inp))+gradfi(2,inp)*(yf-yc(inp))+gradfi(3,inp)*(zf-zc(inp)) &
+ +gradfi(1,inn)*(xf-xc(inn))+gradfi(2,inn)*(yf-yc(inn))+gradfi(3,inn)*(zf-zc(inn))
- face_value = 0.5_dp*( phi_p + phi_n + gradfidr)
+ face_value = 0.5_dp*( fi(inp) + fi(inn) + gradfidr)
end function
@@ -225,26 +259,11 @@ function face_value_2nd_upwind(inp, xf, yf, zf, fi, gradfi) result(face_value)
real(dp), dimension(3,numCells) :: gradfi
! Locals
- real(dp) :: phi_p
- real(dp) :: xcp,ycp,zcp
- real(dp) :: gradfi_p_x,gradfi_p_y,gradfi_p_z
real(dp) :: gradfidr
- ! Values at cell center's of neighbouring cells:
- phi_p = fi(inp)
+ gradfidr = gradfi(1,inp)*(xf-xc(inp))+gradfi(2,inp)*(yf-yc(inp))+gradfi(3,inp)*(zf-zc(inp))
- xcp = xc(inp)
- ycp = yc(inp)
- zcp = zc(inp)
-
- gradfi_p_x = gradfi(1,inp)
- gradfi_p_y = gradfi(2,inp)
- gradfi_p_z = gradfi(3,inp)
-
-
- gradfidr = gradfi_p_x*(xf-xcp)+gradfi_p_y*(yf-ycp)+gradfi_p_z*(zf-zcp)
-
- face_value = phi_p + gradfidr
+ face_value = fi(inp) + gradfidr
end function
@@ -274,46 +293,20 @@ function face_value_muscl(inp,inn, xf, yf, zf, fi, gradfi) result(face_value)
real(dp), dimension(3,numCells) :: gradfi
! Locals
- real(dp) :: phi_p, phi_n
- real(dp) :: xcp,ycp,zcp
- real(dp) :: xcn,ycn,zcn
- real(dp) :: gradfi_p_x,gradfi_p_y,gradfi_p_z
- real(dp) :: gradfi_n_x,gradfi_n_y,gradfi_n_z
real(dp) :: gradfidr_2nd_upwind,gradfidr_central,face_value_2nd_upwind,face_value_central
real(dp) :: theta
! theta = 1/8
theta = 0.125_dp
- !.....Values at cell center's of neighbouring cells:
- phi_p = fi(inp)
-
- phi_n = fi(inn)
-
- xcp = xc(inp)
- ycp = yc(inp)
- zcp = zc(inp)
-
- xcn = xc(inn)
- ycn = yc(inn)
- zcn = zc(inn)
- gradfi_p_x = gradfi(1,inp)
- gradfi_p_y = gradfi(2,inp)
- gradfi_p_z = gradfi(3,inp)
+ gradfidr_2nd_upwind=gradfi(1,inp)*(xf-xc(inp))+gradfi(2,inp)*(yf-yc(inp))+gradfi(3,inp)*(zf-zc(inp))
- gradfi_n_x = gradfi(1,inn)
- gradfi_n_y = gradfi(2,inn)
- gradfi_n_z = gradfi(3,inn)
+ gradfidr_central=gradfi(1,inp)*(xf-xc(inp))+gradfi(2,inp)*(yf-yc(inp))+gradfi(3,inp)*(zf-zc(inp)) &
+ +gradfi(1,inn)*(xf-xc(inn))+gradfi(2,inn)*(yf-yc(inn))+gradfi(3,inn)*(zf-zc(inn))
-
- ! gradfixdr = (sum(gradphi_nb(i,:)*r_nb2f(i,:)), i=1,n)
- gradfidr_2nd_upwind=gradfi_p_x*(xf-xcp)+gradfi_p_y*(yf-ycp)+gradfi_p_z*(zf-zcp)
- gradfidr_central=gradfi_p_x*(xf-xcp)+gradfi_p_y*(yf-ycp)+gradfi_p_z*(zf-zcp) &
- +gradfi_n_x*(xf-xcn)+gradfi_n_y*(yf-ycn)+gradfi_n_z*(zf-zcn)
-
- face_value_2nd_upwind = ( phi_p + gradfidr_2nd_upwind )
- face_value_central = 0.5_dp*( phi_p + phi_n + gradfidr_central)
+ face_value_2nd_upwind = ( fi(inp) + gradfidr_2nd_upwind )
+ face_value_central = 0.5_dp*( fi(inp) + fi(inn) + gradfidr_central)
face_value = theta*face_value_central + (1.0_dp-theta)*face_value_2nd_upwind
@@ -322,7 +315,7 @@ function face_value_muscl(inp,inn, xf, yf, zf, fi, gradfi) result(face_value)
!***********************************************************************
!
- function face_value_2nd_upwind_flux_limiter(ijp, ijn, lambda, u, dUdxi) result(face_value)
+ function face_value_2nd_upwind_flux_limiter(ijp, ijn, xf, yf, zf, u, dUdxi) result(face_value)
!
!***********************************************************************
!
@@ -342,21 +335,20 @@ function face_value_2nd_upwind_flux_limiter(ijp, ijn, lambda, u, dUdxi) result(f
! Input
integer :: ijn, ijp
- real(dp) :: lambda
+ real(dp) :: xf, yf, zf
real(dp), dimension(numTotal) :: u
real(dp), dimension(3,numCells) :: dUdxi
! Locals
- real(dp) :: r,psi,xpn,ypn,zpn,fxp
+ real(dp) :: r,psi,xpn,ypn,zpn
- ! Face interpolation factor
- fxp = 1.0_dp-lambda
! Distance vector between cell centers
xpn = xc(ijn)-xc(ijp)
ypn = yc(ijn)-yc(ijp)
zpn = zc(ijn)-zc(ijp)
+
! Gradient ratio expression taken from Darwish-Moukalled 'TVD schemes for unstructured grids' paper.
r = (2*dUdxi(1,ijp)*xpn + 2*dUdxi(2,ijp)*ypn + 2*dUdxi(3,ijp)*zpn)/(u(ijn)-u(ijp)) - 1.0_dp
@@ -388,7 +380,7 @@ function face_value_2nd_upwind_flux_limiter(ijp, ijn, lambda, u, dUdxi) result(f
end if
- face_value = u(ijp) + fxp*psi*(u(ijn)-u(ijp))
+ face_value = u(ijp) + psi*( dUdxi(1,ijp)*(xf-xc(ijp))+dUdxi(2,ijp)*(yf-yc(ijp))+dUdxi(3,ijp)*(zf-zc(ijp)) )
end function
diff --git a/src/finiteVolume/tensorFields/tensor_fields.f90 b/src/finiteVolume/tensorFields/tensorFields.f90
similarity index 63%
rename from src/finiteVolume/tensorFields/tensor_fields.f90
rename to src/finiteVolume/tensorFields/tensorFields.f90
index 29239fd..1743005 100644
--- a/src/finiteVolume/tensorFields/tensor_fields.f90
+++ b/src/finiteVolume/tensorFields/tensorFields.f90
@@ -1,13 +1,11 @@
-module tensor_fields
+module tensorFields
!
! Definition of volume and surface tensor fields and operations on them.
!
use types
-use geometry, only: numCells,numInnerFaces
implicit none
-
!
! > Volume fields
!
@@ -70,36 +68,41 @@ module tensor_fields
! > Operations on vector and tensor fields
!
-interface operator(.dot.)
+interface operator(*)
module procedure calc_inner_product
module procedure calc_inner_product_surface_vectors
module procedure calc_inner_product_rank2_and_rank1_tensors
module procedure calc_inner_product_rank1_and_rank2_tensors
end interface
-interface operator(.cross.)
+interface operator(.x.)
module procedure calc_cross_product
end interface
-interface operator(.tensor.)
+interface operator(.o.)
module procedure calc_tensor_product
module procedure calc_tensor_product_rank2_tensors
end interface
-interface operator(.ddot.)
+interface operator(**)
module procedure calc_inner_product_rank2_tensor
module procedure calc_inner_product_rank2_symmetric_tensor
end interface
-interface operator(.transposed.)
+interface operator(.trans.)
module procedure transpose_rank2_tensor
end interface
-interface operator(.trace.)
+interface operator(.tr.)
module procedure trace_rank2_tensor
module procedure trace_rank2_symmetric_tensor
end interface
+interface operator(.Sq.)
+ module procedure square_rank2_tensor
+ module procedure square_rank2_symmetric_tensor
+end interface
+
interface operator(.det.)
module procedure determinant_rank2_tensor
module procedure determinant_rank2_symmetric_tensor
@@ -156,25 +159,27 @@ module tensor_fields
end interface
interface operator(-)
- module procedure substract_tensors
+ module procedure subtract_tensors
end interface
+
+! Various ways of multiplying scalar and a vector/tensor
interface operator(*)
- module procedure scalar_vector_multiply
- module procedure scalar_field_vector_multiply
- module procedure scalar_rank2_tensor_multiply
- module procedure scalar_field_rank2_tensor_multiply
- module procedure scalar_surface_vector_multiply
- module procedure scalar_field_surface_vector_multiply
+ module procedure scalar_volVectorField_multiply
+ module procedure scalarField_volVectorField_multiply
+ module procedure volScalarField_volVectorField_multiply
+ module procedure scalar_volTensorField_multiply
+ module procedure scalarField_volTensorField_multiply
+ module procedure volScalarField_volTensorField_multiply
+ module procedure scalar_surfaceVectorField_multiply
+ module procedure scalarField_surfaceVectorField_multiply
+ module procedure surfaceScalarField_surfaceTensorField_multiply
end interface
-
public
-
contains
-
!
! > Create new fields
!
@@ -310,59 +315,87 @@ end function new_surfaceTensorField
function calc_inner_product(v1, v2) result(inner_product)
implicit none
type(volVectorField), intent(in) :: v1, v2
- real(dp), dimension(numCells) :: inner_product
- integer :: i
+ type(volScalarField) :: inner_product
+ integer :: i,num
+
+ num = size( v1%x )
- do i = 1,numCells
- inner_product(i) = v1%x(i) * v2%x(i) + v1%y(i) * v2%y(i) + v1%z(i) * v2%z(i)
+ ! Simple check
+ if (num /= size(v2%x)) then
+ write(*,*) "Vectors in dot product are not the same size!"
+ stop
+ endif
+
+ inner_product = new_volScalarField(num)
+
+ do i = 1,num
+ inner_product%mag(i) = v1%x(i) * v2%x(i) + v1%y(i) * v2%y(i) + v1%z(i) * v2%z(i)
enddo
+
end function calc_inner_product
+
function calc_inner_product_surface_vectors(v1, v2) result(inner_product)
implicit none
type(surfaceVectorField), intent(in) :: v1, v2
- real(dp), dimension(numInnerFaces) :: inner_product
- integer :: i
+ type(surfaceScalarField) :: inner_product
+ integer :: i,num
+
+ num = size( v1%x )
+
+ ! Simple check
+ if (num /= size(v2%x)) then
+ write(*,*) "Vectors in dot product are not the same size!"
+ stop
+ endif
+
+ inner_product = new_surfaceScalarField(num)
- do i = 1,numInnerFaces
- inner_product(i) = v1%x(i) * v2%x(i) + v1%y(i) * v2%y(i) + v1%z(i) * v2%z(i)
+ do i = 1,num
+ inner_product%mag(i) = v1%x(i) * v2%x(i) + v1%y(i) * v2%y(i) + v1%z(i) * v2%z(i)
enddo
end function calc_inner_product_surface_vectors
+
! ... inner product between tensor and vector vi = Tij*vj, and...
-function calc_inner_product_rank2_and_rank1_tensors(T1, v1) result(v2)
+function calc_inner_product_rank2_and_rank1_tensors(T, v1) result(v2)
implicit none
- type(volTensorField), intent(in) :: T1
+ type(volTensorField), intent(in) :: T
type(volVectorField), intent(in) :: v1
type(volVectorField) :: v2
- integer :: i
+ integer :: i,num
- v2 = new_volVectorField(numCells)
+ num = size( v1%x )
- do i = 1,numCells
- v2%x (i) = T1%xx(i) * v1%x(i) + T1%xy(i) * v1%y(i) + T1%xz(i) * v1%z(i)
- v2%y (i) = T1%yx(i) * v1%x(i) + T1%yy(i) * v1%y(i) + T1%yz(i) * v1%z(i)
- v2%z (i) = T1%zx(i) * v1%x(i) + T1%zy(i) * v1%y(i) + T1%zz(i) * v1%z(i)
+ v2 = new_volVectorField(num)
+
+ do i = 1,num
+ v2%x (i) = T%xx(i) * v1%x(i) + T%xy(i) * v1%y(i) + T%xz(i) * v1%z(i)
+ v2%y (i) = T%yx(i) * v1%x(i) + T%yy(i) * v1%y(i) + T%yz(i) * v1%z(i)
+ v2%z (i) = T%zx(i) * v1%x(i) + T%zy(i) * v1%y(i) + T%zz(i) * v1%z(i)
enddo
end function calc_inner_product_rank2_and_rank1_tensors
! ... inner product between vector and tensor vi = vj*Tij
-function calc_inner_product_rank1_and_rank2_tensors(v1,T1) result(v2)
+function calc_inner_product_rank1_and_rank2_tensors(v1,T) result(v2)
implicit none
type(volVectorField), intent(in) :: v1
- type(volTensorField), intent(in) :: T1
+ type(volTensorField), intent(in) :: T
type(volVectorField) :: v2
+ integer :: num
+
+ num = size( v1%x )
- v2 = new_volVectorField(numCells)
+ v2 = new_volVectorField(num)
!
! bi = Tji*aj using derived operators:
!
! transpose tensor Tij
! | inner product bi = Tij*aj
! | |
- v2 = .transposed.T1 .dot. v1
+ v2 = .trans.T * v1
end function calc_inner_product_rank1_and_rank2_tensors
@@ -373,11 +406,13 @@ function calc_cross_product(v1, v2) result(v3)
implicit none
type(volVectorField), intent(in) :: v1, v2
type(volVectorField) :: v3
- integer :: i
+ integer :: i,num
+
+ num = size(v1%x)
- v3 = new_volVectorField(numCells)
+ v3 = new_volVectorField( num )
- do i = 1,numCells
+ do i = 1,num
v3%x (i) = v1%y(i) * v2%z(i) - v1%z(i) * v2%y(i)
v3%y (i) = v1%z(i) * v2%x(i) - v1%x(i) * v2%z(i)
v3%z (i) = v1%x(i) * v2%y(i) - v1%y(i) * v2%x(i)
@@ -385,28 +420,30 @@ function calc_cross_product(v1, v2) result(v3)
end function calc_cross_product
-! ! The .tensor. operator defining tensor, or outer product between two column vectors, or ...
+! ! The .o. operator defining tensor, or outer product between two column vectors, or ...
-function calc_tensor_product(v1, v2) result(T1)
+function calc_tensor_product(v1, v2) result(T)
implicit none
type(volVectorField), intent(in) :: v1, v2
- type(volTensorField) :: T1
- integer :: i
+ type(volTensorField) :: T
+ integer :: i,num
- T1 = new_volTensorField(numCells)
+ num = size(v1%x)
- do i = 1,numCells
- T1%xx(i) = v1%x(i) * v2%x(i)
- T1%xy(i) = v1%x(i) * v2%y(i)
- T1%xz(i) = v1%x(i) * v2%z(i)
+ T = new_volTensorField(num)
- T1%yx(i) = v1%y(i) * v2%x(i)
- T1%yy(i) = v1%y(i) * v2%y(i)
- T1%yz(i) = v1%y(i) * v2%z(i)
+ do i = 1,num
+ T%xx(i) = v1%x(i) * v2%x(i)
+ T%xy(i) = v1%x(i) * v2%y(i)
+ T%xz(i) = v1%x(i) * v2%z(i)
+
+ T%yx(i) = v1%y(i) * v2%x(i)
+ T%yy(i) = v1%y(i) * v2%y(i)
+ T%yz(i) = v1%y(i) * v2%z(i)
- T1%zx(i) = v1%z(i) * v2%x(i)
- T1%zy(i) = v1%z(i) * v2%y(i)
- T1%zz(i) = v1%z(i) * v2%z(i)
+ T%zx(i) = v1%z(i) * v2%x(i)
+ T%zy(i) = v1%z(i) * v2%y(i)
+ T%zz(i) = v1%z(i) * v2%z(i)
enddo
end function calc_tensor_product
@@ -416,11 +453,13 @@ function calc_tensor_product_rank2_tensors(T1, T2) result(T3)
implicit none
type(volTensorField), intent(in) :: T1, T2
type(volTensorField) :: T3
- integer :: i
+ integer :: i,num
+
+ num = size(T1%xx)
- T3 = new_volTensorField(numCells)
+ T3 = new_volTensorField(num)
- do i = 1,numCells
+ do i = 1,num
T3%xx(i) = T1%xx(i) * T2%xx(i) + T1%xy(i) * T2%yx(i) + T1%xz(i) * T2%zx(i)
T3%xy(i) = T1%xx(i) * T2%xy(i) + T1%xy(i) * T2%yy(i) + T1%xz(i) * T2%zy(i)
T3%xz(i) = T1%xx(i) * T2%xz(i) + T1%xy(i) * T2%yz(i) + T1%xz(i) * T2%zz(i)
@@ -436,16 +475,17 @@ function calc_tensor_product_rank2_tensors(T1, T2) result(T3)
end function calc_tensor_product_rank2_tensors
-
function calc_inner_product_rank2_tensor(T1, T2) result(inner_product)
implicit none
type(volTensorField), intent(in) :: T1, T2
type(volScalarField) :: inner_product
- integer :: i
+ integer :: i,num
- inner_product = new_volScalarField(numCells)
+ num = size(T1%xx)
- do i = 1,numCells
+ inner_product = new_volScalarField(num)
+
+ do i = 1,num
inner_product%mag(i) = T1%xx(i) * T2%xx(i) + T1%xy(i) * T2%xy(i) + T1%xz(i) * T2%xz(i) &
+ T1%yx(i) * T2%yx(i) + T1%yy(i) * T2%yy(i) + T1%yz(i) * T2%yz(i) &
+ T1%zx(i) * T2%zx(i) + T1%zy(i) * T2%zy(i) + T1%zz(i) * T2%zz(i)
@@ -456,14 +496,16 @@ function calc_inner_product_rank2_symmetric_tensor(T1, T2) result(inner_product)
implicit none
type(volSymmetricTensorField), intent(in) :: T1, T2
type(volScalarField) :: inner_product
- integer :: i
+ integer :: i,num
- inner_product = new_volScalarField(numCells)
+ num = size(T1%xx)
- do i = 1,numCells
- inner_product%mag(i) = T1%xx(i) * T2%xx(i) + T1%xy(i) * T2%xy(i) + T1%xz(i) * T2%xz(i) &
- + T1%yy(i) * T2%yy(i) + T1%yz(i) * T2%yz(i) &
- + T1%zz(i) * T2%zz(i)
+ inner_product = new_volScalarField(num)
+
+ do i = 1,num
+ inner_product%mag(i) = T1%xx(i) * T2%xx(i) + T1%yy(i) * T2%yy(i) + T1%zz(i) * T2%zz(i) &
+ + 2 * ( T1%xy(i) * T2%xy(i) + T1%xz(i) * T2%xz(i) + T1%yz(i) * T2%yz(i) )
+
enddo
end function calc_inner_product_rank2_symmetric_tensor
@@ -472,11 +514,13 @@ function transpose_rank2_tensor(T1) result(T2)
implicit none
type(volTensorField), intent(in) :: T1
type(volTensorField) :: T2
- integer :: i
+ integer :: i,num
- T2 = new_volTensorField(numCells)
+ num = size(T1%xx)
- do i = 1,numCells
+ T2 = new_volTensorField(num)
+
+ do i = 1,num
T2%xx(i) = T1%xx(i)
T2%xy(i) = T1%yx(i)
T2%xz(i) = T1%zx(i)
@@ -495,11 +539,13 @@ function add_tensors(T1,T2) result(T3)
implicit none
type(volTensorField), intent(in) :: T1, T2
type(volTensorField) :: T3
- integer :: i
+ integer :: i,num
- T3 = new_volTensorField(numCells)
+ num = size(T1%xx)
- do i = 1,numCells
+ T3 = new_volTensorField(num)
+
+ do i = 1,num
T3%xx(i) = T1%xx(i) + T2%xx(i)
T3%xy(i) = T1%xy(i) + T2%xy(i)
T3%xz(i) = T1%xz(i) + T2%xz(i)
@@ -514,15 +560,17 @@ function add_tensors(T1,T2) result(T3)
enddo
end function add_tensors
-function substract_tensors(T1,T2) result(T3)
+function subtract_tensors(T1,T2) result(T3)
implicit none
type(volTensorField), intent(in) :: T1, T2
type(volTensorField) :: T3
- integer :: i
+ integer :: i,num
+
+ num = size(T1%xx)
- T3 = new_volTensorField(numCells)
+ T3 = new_volTensorField(num)
- do i = 1,numCells
+ do i = 1,num
T3%xx(i) = T1%xx(i) - T2%xx(i)
T3%xy(i) = T1%xy(i) - T2%xy(i)
T3%xz(i) = T1%xz(i) - T2%xz(i)
@@ -535,53 +583,78 @@ function substract_tensors(T1,T2) result(T3)
T3%zy(i) = T1%zy(i) - T2%zy(i)
T3%zz(i) = T1%zz(i) - T2%zz(i)
enddo
-end function substract_tensors
+end function subtract_tensors
-function scalar_vector_multiply(alpha,v1) result(v2)
+function scalar_volVectorField_multiply(alpha,v1) result(v2)
implicit none
real(dp), intent(in) :: alpha
type(volVectorField), intent(in) :: v1
type(volVectorField) :: v2
- integer :: i
+ integer :: i,num
- v2 = new_volVectorField(numCells)
+ num = size(v1%x)
- do i = 1,numCells
+ v2 = new_volVectorField(num)
+
+ do i = 1,num
v2%x (i) = alpha * v1%x(i)
v2%y (i) = alpha * v1%y(i)
v2%z (i) = alpha * v1%z(i)
enddo
-end function scalar_vector_multiply
+end function scalar_volVectorField_multiply
-function scalar_field_vector_multiply(alpha,v1) result(v2)
+function scalarField_volVectorField_multiply(alpha,v1) result(v2)
implicit none
- real(dp), dimension(numCells), intent(in) :: alpha
+ real(dp), dimension(*), intent(in) :: alpha
type(volVectorField), intent(in) :: v1
type(volVectorField) :: v2
- integer :: i
+ integer :: i,num
- v2 = new_volVectorField(numCells)
+ num = size(v1%x)
- do i = 1,numCells
+ v2 = new_volVectorField(num)
+
+ do i = 1,num
v2%x (i) = alpha(i) * v1%x(i)
v2%y (i) = alpha(i) * v1%y(i)
v2%z (i) = alpha(i) * v1%z(i)
enddo
-end function scalar_field_vector_multiply
+end function scalarField_volVectorField_multiply
-function scalar_rank2_tensor_multiply(alpha,T1) result(T2)
+function volScalarField_volVectorField_multiply(alpha,v1) result(v2)
+ implicit none
+ type(volScalarField), intent(in) :: alpha
+ type(volVectorField), intent(in) :: v1
+ type(volVectorField) :: v2
+ integer :: i,num
+
+ num = size(v1%x)
+
+ v2 = new_volVectorField(num)
+
+ do i = 1,num
+ v2%x (i) = alpha%mag(i) * v1%x(i)
+ v2%y (i) = alpha%mag(i) * v1%y(i)
+ v2%z (i) = alpha%mag(i) * v1%z(i)
+ enddo
+end function volScalarField_volVectorField_multiply
+
+
+function scalar_volTensorField_multiply(alpha,T1) result(T2)
implicit none
real(dp), intent(in) :: alpha
type(volTensorField), intent(in) :: T1
type(volTensorField) :: T2
- integer :: i
+ integer :: i,num
+
+ num = size(T1%xx)
- T2 = new_volTensorField(numCells)
+ T2 = new_volTensorField(num)
- do i = 1,numCells
+ do i = 1,num
T2%xx(i) = alpha * T1%xx(i)
T2%xy(i) = alpha * T1%xy(i)
T2%xz(i) = alpha * T1%xz(i)
@@ -594,19 +667,21 @@ function scalar_rank2_tensor_multiply(alpha,T1) result(T2)
T2%zy(i) = alpha * T1%zy(i)
T2%zz(i) = alpha * T1%zz(i)
enddo
-end function scalar_rank2_tensor_multiply
+end function scalar_volTensorField_multiply
-function scalar_field_rank2_tensor_multiply(alpha,T1) result(T2)
+function scalarField_volTensorField_multiply(alpha,T1) result(T2)
implicit none
- real(dp), dimension(numCells), intent(in) :: alpha
+ real(dp), dimension(*), intent(in) :: alpha
type(volTensorField), intent(in) :: T1
type(volTensorField) :: T2
- integer :: i
+ integer :: i,num
- T2 = new_volTensorField(numCells)
+ num = size(T1%xx)
- do i = 1,numCells
+ T2 = new_volTensorField(num)
+
+ do i = 1,num
T2%xx(i) = alpha(i) * T1%xx(i)
T2%xy(i) = alpha(i) * T1%xy(i)
T2%xz(i) = alpha(i) * T1%xz(i)
@@ -619,51 +694,111 @@ function scalar_field_rank2_tensor_multiply(alpha,T1) result(T2)
T2%zy(i) = alpha(i) * T1%zy(i)
T2%zz(i) = alpha(i) * T1%zz(i)
enddo
-end function scalar_field_rank2_tensor_multiply
+end function scalarField_volTensorField_multiply
+
+
+function volScalarField_volTensorField_multiply(alpha,T1) result(T2)
+ implicit none
+ type(volScalarField), intent(in) :: alpha
+ type(volTensorField), intent(in) :: T1
+ type(volTensorField) :: T2
+ integer :: i,num
+
+ num = size(alpha%mag)
+
+ T2 = new_volTensorField(num)
+
+ do i = 1,num
+ T2%xx(i) = alpha%mag(i) * T1%xx(i)
+ T2%xy(i) = alpha%mag(i) * T1%xy(i)
+ T2%xz(i) = alpha%mag(i) * T1%xz(i)
+
+ T2%yx(i) = alpha%mag(i) * T1%yx(i)
+ T2%yy(i) = alpha%mag(i) * T1%yy(i)
+ T2%yz(i) = alpha%mag(i) * T1%yz(i)
+
+ T2%zx(i) = alpha%mag(i) * T1%zx(i)
+ T2%zy(i) = alpha%mag(i) * T1%zy(i)
+ T2%zz(i) = alpha%mag(i) * T1%zz(i)
+ enddo
+end function volScalarField_volTensorField_multiply
+
+function surfaceScalarField_surfaceTensorField_multiply(alpha,T1) result(T2)
+ implicit none
+ type(surfaceScalarField), intent(in) :: alpha
+ type(surfaceTensorField), intent(in) :: T1
+ type(surfaceTensorField) :: T2
+ integer :: i,num
+
+ num = size(alpha%mag)
+
+ T2 = new_surfaceTensorField(num)
+
+ do i = 1,num
+ T2%xx(i) = alpha%mag(i) * T1%xx(i)
+ T2%xy(i) = alpha%mag(i) * T1%xy(i)
+ T2%xz(i) = alpha%mag(i) * T1%xz(i)
+
+ T2%yx(i) = alpha%mag(i) * T1%yx(i)
+ T2%yy(i) = alpha%mag(i) * T1%yy(i)
+ T2%yz(i) = alpha%mag(i) * T1%yz(i)
+ T2%zx(i) = alpha%mag(i) * T1%zx(i)
+ T2%zy(i) = alpha%mag(i) * T1%zy(i)
+ T2%zz(i) = alpha%mag(i) * T1%zz(i)
+ enddo
+end function surfaceScalarField_surfaceTensorField_multiply
-function scalar_surface_vector_multiply(alpha,v1) result(v2)
+function scalar_surfaceVectorField_multiply(alpha,v1) result(v2)
implicit none
real(dp), intent(in) :: alpha
type(surfaceVectorField), intent(in) :: v1
type(surfaceVectorField) :: v2
- integer :: i
+ integer :: i,num
+
+ num = size(v1%x)
- v2 = new_surfaceVectorField(numCells)
+ v2 = new_surfaceVectorField(num)
- do i = 1,numCells
+ do i = 1,num
v2%x (i) = alpha * v1%x(i)
v2%y (i) = alpha * v1%y(i)
v2%z (i) = alpha * v1%z(i)
enddo
-end function scalar_surface_vector_multiply
+end function scalar_surfaceVectorField_multiply
-function scalar_field_surface_vector_multiply(alpha,v1) result(v2)
+function scalarField_surfaceVectorField_multiply(alpha,v1) result(v2)
implicit none
- real(dp), dimension(numCells), intent(in) :: alpha
+ real(dp), dimension(*), intent(in) :: alpha
type(surfaceVectorField), intent(in) :: v1
type(surfaceVectorField) :: v2
- integer :: i
+ integer :: i,num
+
+ num = size(v1%x)
- v2 = new_surfaceVectorField(numCells)
+ v2 = new_surfaceVectorField(num)
- do i = 1,numCells
+ do i = 1,num
v2%x (i) = alpha(i) * v1%x(i)
v2%y (i) = alpha(i) * v1%y(i)
v2%z (i) = alpha(i) * v1%z(i)
enddo
-end function scalar_field_surface_vector_multiply
+end function scalarField_surfaceVectorField_multiply
function trace_rank2_symmetric_tensor(T) result(trace)
implicit none
type(volSymmetricTensorField), intent(in) :: T
- real(dp), dimension(numCells) :: trace
- integer :: i
+ type(volScalarField) :: trace
+ integer :: i,num
- do i = 1,numCells
- trace(i) = T%xx(i) + T%yy(i) + T%zz(i)
+ num = size(T%xx)
+
+ trace = new_volScalarField(num)
+
+ do i = 1,num
+ trace%mag(i) = T%xx(i) + T%yy(i) + T%zz(i)
enddo
end function trace_rank2_symmetric_tensor
@@ -671,25 +806,82 @@ end function trace_rank2_symmetric_tensor
function trace_rank2_tensor(T) result(trace)
implicit none
type(volTensorField), intent(in) :: T
- real(dp), dimension(numCells) :: trace
- integer :: i
+ type(volScalarField) :: trace
+ integer :: i,num
+
+ num = size(T%xx)
+
+ trace = new_volScalarField(num)
- do i = 1,numCells
- trace(i) = T%xx(i) + T%yy(i) + T%zz(i)
+ do i = 1,num
+ trace%mag(i) = T%xx(i) + T%yy(i) + T%zz(i)
enddo
end function trace_rank2_tensor
+function square_rank2_tensor(T1) result(T2)
+ implicit none
+ type(volTensorField), intent(in) :: T1
+ type(volTensorField) :: T2
+ integer :: i,num
+
+ num = size(T1%xx)
+
+ T2 = new_volTensorField(num)
+
+ do i = 1,num
+ T2%xx(i) = T1%xx(i)**2
+ T2%xy(i) = T1%xy(i)**2
+ T2%xz(i) = T1%xz(i)**2
+
+ T2%yx(i) = T1%yx(i)**2
+ T2%yy(i) = T1%yy(i)**2
+ T2%yz(i) = T1%yz(i)**2
+
+ T2%zx(i) = T1%zx(i)**2
+ T2%zy(i) = T1%zy(i)**2
+ T2%zz(i) = T1%zz(i)**2
+ enddo
+end function square_rank2_tensor
+
+
+function square_rank2_symmetric_tensor(T1) result(T2)
+ implicit none
+ type(volSymmetricTensorField), intent(in) :: T1
+ type(volSymmetricTensorField) :: T2
+ integer :: i,num
+
+ num = size(T1%xx)
+
+ T2 = new_volSymmetricTensorField(num)
+
+ do i = 1,num
+ T2%xx(i) = T1%xx(i)**2
+ T2%xy(i) = T1%xy(i)**2
+ T2%xz(i) = T1%xz(i)**2
+
+ T2%yy(i) = T1%yy(i)**2
+ T2%yz(i) = T1%yz(i)**2
+
+ T2%zz(i) = T1%zz(i)**2
+ enddo
+end function square_rank2_symmetric_tensor
+
+
function determinant_rank2_symmetric_tensor(T) result(determinant)
implicit none
type(volSymmetricTensorField), intent(in) :: T
- real(dp), dimension(numCells) :: determinant
- integer :: i
+ type(volScalarField) :: determinant
+ integer :: i,num
+
+ num = size(T%xx)
+
+ determinant = new_volScalarField(num)
- do i = 1,numCells
- determinant(i) = ( T%xx(i) * ( T%yy(i) * T%zz(i) - T%yz(i)*T%yz(i) ) - &
- T%xy(i) * ( T%xy(i) * T%zz(i) - T%yz(i)*T%xz(i) ) + &
- T%xz(i) * ( T%xy(i) * T%yz(i) - T%yy(i)*T%xz(i) ) )
+ do i = 1,num
+ determinant%mag(i) = ( T%xx(i) * ( T%yy(i) * T%zz(i) - T%yz(i)*T%yz(i) ) - &
+ T%xy(i) * ( T%xy(i) * T%zz(i) - T%yz(i)*T%xz(i) ) + &
+ T%xz(i) * ( T%xy(i) * T%yz(i) - T%yy(i)*T%xz(i) ) )
enddo
end function determinant_rank2_symmetric_tensor
@@ -697,13 +889,17 @@ end function determinant_rank2_symmetric_tensor
function determinant_rank2_tensor(T) result(determinant)
implicit none
type(volTensorField), intent(in) :: T
- real(dp), dimension(numCells) :: determinant
- integer :: i
+ type(volScalarField) :: determinant
+ integer :: i,num
- do i = 1,numCells
- determinant(i) = ( T%xx(i) * ( T%yy(i) * T%zz(i) - T%yz(i)*T%zy(i) ) - &
- T%xy(i) * ( T%yx(i) * T%zz(i) - T%yz(i)*T%zx(i) ) + &
- T%xz(i) * ( T%yx(i) * T%zy(i) - T%yy(i)*T%zx(i) ) )
+ num = size(T%xx)
+
+ determinant = new_volScalarField(num)
+
+ do i = 1,num
+ determinant%mag(i) = ( T%xx(i) * ( T%yy(i) * T%zz(i) - T%yz(i)*T%zy(i) ) - &
+ T%xy(i) * ( T%yx(i) * T%zz(i) - T%yz(i)*T%zx(i) ) + &
+ T%xz(i) * ( T%yx(i) * T%zy(i) - T%yy(i)*T%zx(i) ) )
enddo
end function determinant_rank2_tensor
@@ -712,11 +908,13 @@ function diagonal(T) result(v)
implicit none
type(volTensorField), intent(in) :: T
type(volVectorField) :: v
- integer :: i
+ integer :: i,num
+
+ num = size(T%xx)
- v = new_volVectorField(numCells)
+ v = new_volVectorField(num)
- do i = 1,numCells
+ do i = 1,num
v%x (i) = T%xx(i)
v%y (i) = T%yy(i)
v%z (i) = T%zz(i)
@@ -728,11 +926,13 @@ function hodge_dual(T) result(v)
implicit none
type(volTensorField), intent(in) :: T
type(volVectorField) :: v
- integer :: i
+ integer :: i,num
+
+ num = size(T%xx)
- v = new_volVectorField(numCells)
+ v = new_volVectorField(num)
- do i = 1,numCells
+ do i = 1,num
v%x (i) = T%yz(i)
v%y (i) =-T%xz(i)
v%z (i) = T%xy(i)
@@ -768,11 +968,10 @@ function symm(T) result(D)
type(volTensorField), intent(in) :: T
type(volTensorField) :: D
- D = new_volTensorField(numCells)
! overloaded operator - here '*' multiplies tensor fields by a constant scalar
! | overloaded operator - here '+' adds two tensor fields
! | |
- D = 0.5_dp * ( T + .transposed.T )
+ D = 0.5_dp * ( T + .trans.T )
end function symm
@@ -781,11 +980,10 @@ function skew(T) result(S)
type(volTensorField), intent(in) :: T
type(volTensorField) :: S
- !S = new_volTensorField(numCells)
! overloaded operator - here '*' multiplies tensor field by a constant scalar
-! | overloaded operator - here '-' substracts two tensor fields
+! | overloaded operator - here '-' subtracts two tensor fields
! | |
- S = 0.5_dp * ( T - .transposed.T )
+ S = 0.5_dp * ( T - .trans.T )
end function skew
@@ -793,15 +991,13 @@ function curl(D) result(v)
!
! Curl of a vector field is twice Hodge dual of skew-symmetric part of gradient tensor of that vector field.
! Make sure that D in this function call is gradient tensor, e.g. velocity gradient tensor, so it makes sense.
-! To obtain it you will have to use gradient function from teh 'fvc' module, and apply it to a vector field
-! in question: [volTensorField] D = fvc_grad([volVectorField] u)
+! To obtain it you will have to use gradient function from the 'fvx' module, and apply it to a vector field
+! in question: [volTensorField] D = fvxGrad([volVectorField] u)
!
implicit none
type(volTensorField), intent(in) :: D
type(volVectorField) :: v
- ! Will not allocate it because it will be allocated in .hodge. funtion
- !v = new_volVectorField(numCells)
! overloaded operator - here '*' multiplies vector field by a constant scalar
! | derived operators - Hodge dual of skew-symmetric part of tensor T
! | |
@@ -815,14 +1011,17 @@ function deviatoric_part_rank2_tensor(T) result(devT)
type(volTensorField), intent(in) :: T
type(volTensorField) :: devT
type(volTensorField) :: I
+ integer :: num
+
+ num = size(T%xx)
- devT = new_volTensorField(numCells)
- I = eye(numCells)
-! overloaded operator - here '-' substracts two tensor fields
+ I = eye(num)
+
+! overloaded operator - here '-' subtracts two tensor fields
! | overloaded operator - here '*' multiplies tensor field by a constant scalar
-! | | overloaded operator - here '*' multiplies tensor fields by a real scalar array of size[1:numCells]
-! | | |
- devT = T - ( 1./3.0_dp * ( .trace.T * I) )
+! | | overloaded operator - here '*' multiplies tensor fields by a real scalar array of size[1:numCells]
+! | | |
+ devT = T - ( 1./3.0_dp * ( .tr.T * I) )
end function deviatoric_part_rank2_tensor
@@ -832,14 +1031,17 @@ function deviatoric_part_rank2_tensor_23(T) result(devT)
type(volTensorField), intent(in) :: T
type(volTensorField) :: devT
type(volTensorField) :: I
+ integer :: num
+
+ num = size(T%xx)
- devT = new_volTensorField(numCells)
- I = eye(numCells)
-! overloaded operator - here '-' substracts two tensor fields
+ I = eye(num)
+
+! overloaded operator - here '-' subtracts two tensor fields
! | overloaded operator - here '*' multiplies tensor field by a constant scalar
-! | | overloaded operator - here '*' multiplies tensor fields by a real scalar array of size[1:numCells]
-! | | |
- devT = T - ( 2./3.0_dp * ( .trace.T * I) )
+! | | overloaded operator - here '*' multiplies tensor fields by a real scalar array of size[1:numCells]
+! | | |
+ devT = T - ( 2./3.0_dp * ( .tr.T * I) )
!^
!!----2/3 here !
@@ -851,13 +1053,15 @@ function hydrostatic_part_rank2_tensor(T) result(hydT)
type(volTensorField), intent(in) :: T
type(volTensorField) :: hydT
type(volTensorField) :: I
+ integer :: num
+
+ num = size(T%xx)
- hydT = new_volTensorField(numCells)
- I = eye(numCells)
+ I = eye(num)
! overloaded operator - here '*' multiplies tensor field by a constant scalar
-! | overloaded operator - here '*' multiplies tensor fields by a real scalar array of size[1:numCells]
-! | |
- hydT = 1./3.0_dp * ( .trace.T * I)
+! | overloaded operator - here '*' multiplies tensor fields by a real scalar array of size[1:numCells]
+! | |
+ hydT = 1./3.0_dp * ( .tr.T * I )
end function hydrostatic_part_rank2_tensor
@@ -868,7 +1072,7 @@ function magSqrTensorField(T) result(scalar)
type(volTensorField), intent(in) :: T
type(volScalarField) :: scalar
- scalar = T.ddot.T
+ scalar = T**T
end function
@@ -877,7 +1081,7 @@ function magSqrSymmetricTensorField(S) result(scalar)
type(volSymmetricTensorField), intent(in) :: S
type(volScalarField) :: scalar
- scalar = S.ddot.S
+ scalar = S**S
end function
@@ -888,7 +1092,7 @@ function magTensorField(T) result(scalar)
type(volTensorField), intent(in) :: T
type(volScalarField) :: scalar
- scalar = T.ddot.T
+ scalar = T**T
scalar%mag = sqrt(scalar%mag)
end function
@@ -898,9 +1102,9 @@ function magSymmetricTensorField(S) result(scalar)
type(volSymmetricTensorField), intent(in) :: S
type(volScalarField) :: scalar
- scalar = S.ddot.S
+ scalar = S**S
scalar%mag = sqrt(scalar%mag)
end function
-end module tensor_fields
\ No newline at end of file
+end module tensorFields
\ No newline at end of file
diff --git a/src/io/output.f90 b/src/io/output.f90
index 239b35f..af817c3 100644
--- a/src/io/output.f90
+++ b/src/io/output.f90
@@ -2,120 +2,12 @@ module output
use types
use parameters
use geometry
-use tensor_fields
use utils, only: get_unit, i4_to_s_left
-!
-! > Derived operators
-!
-interface operator(.visualize.)
- module procedure write_volScalarField_field
- module procedure write_volVectorField_field
-end interface
-
public
contains
-
- pure integer function paraview_ntype(NTYPE)
-!
-! Element type in Paraview corresponding to Cappuccino type of element given by NTYPE.
-!
- implicit none
- integer, intent(in) :: NTYPE
-
- if(NTYPE.eq.1) then ! -> Cappuccino line
- paraview_ntype = 3
- elseif(NTYPE.eq.2) then ! -> Cappuccino Tri
- paraview_ntype = 5
- elseif(NTYPE.eq.3) then ! -> Cappuccino Quad
- paraview_ntype = 9
- elseif(NTYPE.eq.4) then ! -> Cappuccino Tet
- paraview_ntype = 10
- elseif(NTYPE.eq.5) then ! -> Cappuccino Hex
- paraview_ntype = 12
- elseif(NTYPE.eq.6) then ! -> Cappuccino Prism
- paraview_ntype = 13
- elseif(NTYPE.eq.7) then ! -> Cappuccino Pyramid
- paraview_ntype = 14
- else
- paraview_ntype = 0
- endif
-
- end function
-
- pure integer function noel(NTYPE)
-!
-! Number of nodes in element of NTYPE type of element
-!
- implicit none
- integer, intent(in) :: NTYPE
-
-
- if(NTYPE.eq.12) then ! -> Paraview Hex
- noel = 8
- elseif(NTYPE.eq.13) then ! -> Paraview Prism
- noel = 6
- elseif(NTYPE.eq.14) then ! -> Paraview Pyramid
- noel = 5
- elseif(NTYPE.eq.10) then ! -> Paraview Tet
- noel = 4
- elseif(NTYPE.eq.9) then ! -> Paraview Quad
- noel = 4
- elseif(NTYPE.eq.5) then ! -> Paraview Tri
- noel = 3
- else
- noel = 0
- endif
-
- end function
-
-
-
-function write_volScalarField_field(phi) result(ierr)
-!
-! Wrapper around subroutine vtu_write for VolScalarField
-!
- implicit none
- type(volScalarField), intent(in) :: phi
- integer :: ierr
-
- integer :: output_unit
-
- call get_unit( output_unit )
-
- open(unit = output_unit, file = trim(phi%field_name)//'_field_data.vtu', status = 'replace', iostat = ierr)
-
- call vtu_write_scalar_field ( output_unit, trim(phi%field_name)//'_field_data', phi%mag )
-
- close ( unit = output_unit )
-
-end function
-
-
-function write_volVectorField_field(v) result(ierr)
-!
-! Wrapper around subroutine vtu_write for VolScalarField
-!
- implicit none
- type(volVectorField), intent(in) :: v
- integer :: ierr
-
- integer :: output_unit
-
- call get_unit( output_unit )
-
- open(unit = output_unit, file = trim(v%field_name)//'_field_data.vtu', status = 'replace', iostat = ierr)
-
- call vtu_write_vector_field ( output_unit, trim(v%field_name)//'_field_data', v%x, v%y, v%z )
-
- close ( unit = output_unit )
-
-end function
-
-
-
subroutine vtu_write_XML_header ( output_unit )
!
! Writes header data to Paraview XML, unstructured, ".vtu" file.
@@ -1052,4 +944,57 @@ subroutine vtu_write_mesh ( output_unit )
end subroutine vtu_write_mesh
+ pure integer function paraview_ntype(NTYPE)
+!
+! Element type in Paraview corresponding to Cappuccino type of element given by NTYPE.
+!
+ implicit none
+ integer, intent(in) :: NTYPE
+
+ if(NTYPE.eq.1) then ! -> Cappuccino line
+ paraview_ntype = 3
+ elseif(NTYPE.eq.2) then ! -> Cappuccino Tri
+ paraview_ntype = 5
+ elseif(NTYPE.eq.3) then ! -> Cappuccino Quad
+ paraview_ntype = 9
+ elseif(NTYPE.eq.4) then ! -> Cappuccino Tet
+ paraview_ntype = 10
+ elseif(NTYPE.eq.5) then ! -> Cappuccino Hex
+ paraview_ntype = 12
+ elseif(NTYPE.eq.6) then ! -> Cappuccino Prism
+ paraview_ntype = 13
+ elseif(NTYPE.eq.7) then ! -> Cappuccino Pyramid
+ paraview_ntype = 14
+ else
+ paraview_ntype = 0
+ endif
+
+ end function
+
+ pure integer function noel(NTYPE)
+!
+! Number of nodes in element of NTYPE type of element
+!
+ implicit none
+ integer, intent(in) :: NTYPE
+
+
+ if(NTYPE.eq.12) then ! -> Paraview Hex
+ noel = 8
+ elseif(NTYPE.eq.13) then ! -> Paraview Prism
+ noel = 6
+ elseif(NTYPE.eq.14) then ! -> Paraview Pyramid
+ noel = 5
+ elseif(NTYPE.eq.10) then ! -> Paraview Tet
+ noel = 4
+ elseif(NTYPE.eq.9) then ! -> Paraview Quad
+ noel = 4
+ elseif(NTYPE.eq.5) then ! -> Paraview Tri
+ noel = 3
+ else
+ noel = 0
+ endif
+
+ end function
+
end module
\ No newline at end of file
diff --git a/src/io/read_input.f90 b/src/io/read_input.f90
index 330ee31..380a2b1 100644
--- a/src/io/read_input.f90
+++ b/src/io/read_input.f90
@@ -10,6 +10,7 @@ subroutine read_input_file
use types
use parameters
use gradients, only: lstsq, lstsq_qr, lstsq_dm, gauss, limiter
+ use interpolation
use title_mod
implicit none
@@ -49,7 +50,7 @@ subroutine read_input_file
READ(5,*) NUMSTEP,TIMESTEP,NZAPIS,MAXIT
READ(5,*) lstsq, lstsq_qr, lstsq_dm, gauss
READ(5,*) NPCOR, NIGRAD
- READ(5,*) SIMPLE,PISO,PIMPLE,ncorr
+ READ(5,*) SIMPLE,PISO,ncorr
READ(5,*) const_mflux
READ(5,*) CoNumFix, CoNumFixValue
!.END: READ INPUT FILE.............................................!
@@ -60,7 +61,7 @@ subroutine read_input_file
WRITE(6,'(a)') '---cut here-----------------------------------------------------------------------------'
WRITE(6,'(a70)') TITLE
WRITE(6,'(3(L1,1x),5x,a)') LREAD,LWRITE,LTEST,'READ3,WRIT3,LTEST'
- WRITE(6,'(10(L1,1x),5x,a)') (LCAL(I),I=1,NPHI),'(LCAL(I),I=1,NPHI),IP=4,ITE=5,IED=6,IEN=7,IVIS=8,IVART=9,ICON=10'
+ WRITE(6,'(11(L1,1x),5x,a)') (LCAL(I),I=1,NPHI),'(LCAL(I),I=1,NPHI),IP=4,ITE=5,IED=6,IEN=7,IVIS=8,IVART=9,ICON=10,IEP=11'
WRITE(6,'(3(i3,1x),5x,a)') monCell,pRefCell,MPoints,'monCell,pRefCell,MPoints'
WRITE(6,'(2(es11.4,1x),5x,a)') SLARGE,SORMAX,'SLARGE,SORMAX'
WRITE(6,'(2(es11.4,1x),a)') DENSIT,VISCOS,'DENSIT,VISCOS'
@@ -71,18 +72,18 @@ subroutine read_input_file
WRITE(6,'(5(L1,1x),1x,a)') LTRANSIENT,BDF,BDF2,BDF3,CN,'LTRANSIENT,BDF,BDF2,BDF3,CN'
WRITE(6,'(3(L1,1x),a)') LEVM,LASM,LLES,'LEVM,LASM,LLES'
WRITE(6,'(3(L1,1x),a)') LSGDH,LGGDH,LAFM,'LSGDH,LGGDH,LAFM'
- WRITE(6,'(i2,1x,a)') TurbModel, 'Turbulence Model'
+ WRITE(6,'(i0,1x,a)') TurbModel, 'Turbulence Model'
WRITE(6,'(8(es11.4,1x),a)') UIN,VIN,WIN,TEIN,EDIN,TIN,VARTIN,CONIN,'UIN,VIN,WIN,TEIN,EDIN,TIN,VARTIN,CONIN'
WRITE(6,'(a,a)') convective_scheme, 'Convective scheme'
WRITE(6,'(a,1x,a)') limiter, 'Gradient limiter'
- WRITE(6,'(10(f4.2,1x),a)') (GDS(I),I=1,NPHI),'(GDS(I),I=1,NPHI)'
- WRITE(6,'(10(f4.2,1x),a)') (URF(I),I=1,NPHI),'(URF(I),I=1,NPHI)'
- WRITE(6,'(10(es9.2,1x),a)') (SOR(I),I=1,NPHI),'(SOR(I),I=1,NPHI)'
- WRITE(6,'(10(i3,1x),a)') (NSW(I),I=1,NPHI),'(NSW(I),I=1,NPHI)'
- WRITE(6,'(i5,1x,es9.2,1x,i5,1x,i4,1x,a)') NUMSTEP,TIMESTEP,NZAPIS,MAXIT,'NUMSTEP,TIMESTEP,NZAPIS,MAXIT'
+ WRITE(6,'(11(f4.2,1x),a)') (GDS(I),I=1,NPHI),'(GDS(I),I=1,NPHI)'
+ WRITE(6,'(11(f4.2,1x),a)') (URF(I),I=1,NPHI),'(URF(I),I=1,NPHI)'
+ WRITE(6,'(11(es9.2,1x),a)') (SOR(I),I=1,NPHI),'(SOR(I),I=1,NPHI)'
+ WRITE(6,'(11(i0,1x),a)') (NSW(I),I=1,NPHI),'(NSW(I),I=1,NPHI)'
+ WRITE(6,'(i0,1x,es9.2,1x,i5,1x,i4,1x,a)') NUMSTEP,TIMESTEP,NZAPIS,MAXIT,'NUMSTEP,TIMESTEP,NZAPIS,MAXIT'
WRITE(6,'(4(L1,1x),a)') lstsq, lstsq_qr, lstsq_dm, gauss,'lstsq, lstsq_qr, lstsq_dm, gauss'
- WRITE(6,'(i1,1x,i1,1x,a)') NPCOR, NIGRAD,'NPCOR, NIGRAD'
- WRITE(6,'(3(L1,1x),i1,1x,a)') SIMPLE,PISO,PIMPLE,ncorr,'SIMPLE,PISO,PIMPLE,ncorr'
+ WRITE(6,'(i0,1x,i1,1x,a)') NPCOR, NIGRAD,'NPCOR, NIGRAD'
+ WRITE(6,'(2(L1,1x),i1,1x,a)') SIMPLE,PISO,ncorr,'SIMPLE,PISO,ncorr'
WRITE(6,'(1(L1,1x),5x,a)') const_mflux,'const_mflux'
WRITE(6,'(L1,es11.4,5x,a)') CoNumFix, CoNumFixValue,'CoNumFix, CoNumFixValue'
WRITE(6,'(a)') '---cut here-----------------------------------------------------------------------------'
@@ -95,7 +96,7 @@ subroutine read_input_file
!
! Convective scheme:
!
- select case(convective_scheme)
+ select case( trim(convective_scheme) )
case ('central')
lcds = .true.
@@ -123,7 +124,6 @@ subroutine read_input_file
l2nd_flnt = .true.
case('muscl-f')
lmuscl_flnt = .true.
-
case default
write(*,'(a)') "Using default convective scheme - 2nd order upwind."
l2nd_flnt = .true.
@@ -173,11 +173,11 @@ subroutine read_input_file
! Open files for data at monitoring points
!
if(ltransient) then
- open(unit=89,file=trim(out_folder_path)//'/transient_monitoring_points')
+ open(unit=89,file='transient_monitoring_points')
rewind 89
do imon=1,mpoints
write(trpn,'(i2)') imon
- open(91+imon,file=trim(out_folder_path)//"/transient_monitor_point_"//trpn, access='append')
+ open(91+imon,file="transient_monitor_point_"//trpn, access='append')
if(.not.lread) rewind(91+imon)
end do
end if
diff --git a/src/io/readfiles.f90 b/src/io/readfiles.f90
index 5a99d44..0870b9c 100644
--- a/src/io/readfiles.f90
+++ b/src/io/readfiles.f90
@@ -34,12 +34,13 @@ subroutine readfiles
read(restart_unit) ed
read(restart_unit) t
read(restart_unit) vis
- read(restart_unit) uu
- read(restart_unit) vv
- read(restart_unit) ww
- read(restart_unit) uv
- read(restart_unit) uw
- read(restart_unit) vw
+ read(restart_unit) visw
+ ! read(restart_unit) uu
+ ! read(restart_unit) vv
+ ! read(restart_unit) ww
+ ! read(restart_unit) uv
+ ! read(restart_unit) uw
+ ! read(restart_unit) vw
read(restart_unit) uo
read(restart_unit) vo
read(restart_unit) wo
@@ -72,7 +73,7 @@ subroutine readfiles
call get_unit ( statistics_file )
- open(unit=statistics_file,file=trim(out_folder_path)//'/statistics') ! <- u_aver, v_aver,... are here, statistics restart file 2
+ open(unit=statistics_file,file='statistics')
rewind statistics_file
diff --git a/src/io/write_restart_files.f90 b/src/io/write_restart_files.f90
index a252b03..7b2d0e9 100644
--- a/src/io/write_restart_files.f90
+++ b/src/io/write_restart_files.f90
@@ -38,12 +38,13 @@ subroutine write_restart_files
write(restart_unit) ed
write(restart_unit) t
write(restart_unit) vis
- write(restart_unit) uu
- write(restart_unit) vv
- write(restart_unit) ww
- write(restart_unit) uv
- write(restart_unit) uw
- write(restart_unit) vw
+ write(restart_unit) visw
+ ! write(restart_unit) uu
+ ! write(restart_unit) vv
+ ! write(restart_unit) ww
+ ! write(restart_unit) uv
+ ! write(restart_unit) uw
+ ! write(restart_unit) vw
write(restart_unit) uo
write(restart_unit) vo
write(restart_unit) wo
@@ -72,7 +73,7 @@ subroutine write_restart_files
call get_unit ( statistics_file )
- open(unit=statistics_file,file=trim(out_folder_path)//'/statistics') ! <- u_aver, v_aver,... are here, statistics restart file 2
+ open(unit=statistics_file,file='statistics')
rewind statistics_file
write(statistics_file,*) n_sample
diff --git a/src/io/writefiles.f90 b/src/io/writefiles.f90
index 0754a03..2d6adeb 100644
--- a/src/io/writefiles.f90
+++ b/src/io/writefiles.f90
@@ -15,6 +15,7 @@ subroutine writefiles
use sparse_matrix
use output
use utils, only: i4_to_s_left
+ use mhd
implicit none
!
@@ -95,6 +96,8 @@ subroutine writefiles
call vtu_write_XML_vector_field( output_unit, 'U', u, v, w )
+ if( lcal(iep) ) call vtu_write_XML_vector_field( output_unit, 'uxB', curix, curiy, curiz )
+
!
! > Scalars in cell-centers
!
@@ -109,6 +112,11 @@ subroutine writefiles
if( solveOmega ) call vtu_write_XML_scalar_field ( output_unit, 'omega', ed )
+ if( lcal(ien) ) call vtu_write_XML_scalar_field ( output_unit, 'T', t )
+
+ if( lcal(iep) ) call vtu_write_XML_scalar_field ( output_unit, 'Epot', Epot )
+
+
!
! > Mesh data
!
@@ -195,6 +203,8 @@ subroutine writefiles
call vtu_write_XML_vector_field_boundary( output_unit, 'U', u, v, w, istart, iend )
+ if( lcal(iep) ) call vtu_write_XML_vector_field_boundary( output_unit, 'uxB', curix, curiy, curiz, istart, iend )
+
!
! > Scalars in face-centers
!
@@ -209,6 +219,12 @@ subroutine writefiles
if( solveOmega ) call vtu_write_XML_scalar_field_boundary ( output_unit, 'omega', ed, istart, iend )
+ if( lcal(ien) ) call vtu_write_XML_scalar_field_boundary ( output_unit, 'T', t, istart, iend )
+
+ if( lcal(iep) ) call vtu_write_XML_scalar_field_boundary ( output_unit, 'Epot', Epot, istart, iend )
+
+
+
! Write y+ and shear force at wall boundary regions
if ( bctype(ib) == 'wall' ) then
diff --git a/src/materialProperties/constitutiveRelations.f90 b/src/materialProperties/constitutiveRelations.f90
new file mode 100644
index 0000000..5983009
--- /dev/null
+++ b/src/materialProperties/constitutiveRelations.f90
@@ -0,0 +1,80 @@
+module constitutiveRelations
+
+!********************************************************************************************************************************132
+!
+! Purpose:
+!
+! A module containing built-in linear solvers library.
+!
+! Discussion:
+!
+! Say something...
+!
+! Licensing:
+!
+! This code is distributed under the GNU GPL license.
+!
+ use types
+ use parameters
+ use geometry
+ use variables
+
+ implicit none
+
+ private
+
+ public :: ...,
+
+contains
+
+subroutine CarreauYassudaModel()
+!
+! Purpose:
+!
+! This subroutine ...
+!
+! Discussion:
+!
+! Say something...
+!
+! Licensing:
+!
+! This code is distributed under the GNU GPL license.
+!
+! Modified:
+!
+! dd Month yyy
+!
+! Author:
+!
+! Nikola Mirkov/Email: largeddysimulation@gmail.com
+!
+! Reference:
+!
+! A. Ref, Title, Publication, pp.1-2, year.
+!
+! Parameters:
+!
+! Input, integer, name( size ), description.
+! Input/Output, type, name( size ), description.
+! Output, type, name( size ), description.
+!
+ use amodule, only: ...
+
+ implicit none
+!
+! Parameters
+!
+ A list ...
+!
+! Local variables
+!
+ real(dp) :: mu0 = 22e-3
+ real(dp) :: muinf = 2.2e-3
+ real(dp) :: nexp = 0.392_dp
+ real(dp) :: aexp = 0.644_dp
+ real(dp) :: lambdcy = 0.110_dp
+
+end subroutine
+
+end module XXX
\ No newline at end of file
diff --git a/src/mesh/geometry-dev.f90 b/src/mesh/geometry-dev.f90
new file mode 100644
index 0000000..b753acd
--- /dev/null
+++ b/src/mesh/geometry-dev.f90
@@ -0,0 +1,1541 @@
+
+module geometry
+!
+! Purpose: Module for manipulation of unstructured meshes.
+!
+use types
+use utils, only: get_unit, file_row_count, r8vec_print_some, i4vec_print2
+
+implicit none
+
+! NOTE:
+!***
+! In variable arrays, field variables defined at cell centres are written in positions from 1 to numCells, after that we write
+! variable values for boundary faces from numCells+1 to numTotal.
+!***
+
+! General mesh data
+integer :: numNodes ! no. of nodes in mesh
+integer :: numCells ! no. of cells in the mesh
+integer :: numFaces ! no. of INNER+BOUNDARY faces in the mesh
+integer :: numInnerFaces ! no. of INNER cells faces in the mesh
+integer :: numBoundaryFaces ! self explanatory
+integer :: numTotal ! number of volume field values + number of boundary field values numCells+numBoundaryFaces
+
+! To define boundary regions
+integer :: numBoundaries
+integer, dimension(:), allocatable :: nfaces,startFace,iBndValueStart
+character(len=30), dimension(:), allocatable :: bcname, bctype
+
+integer :: nwal ! Total no. of boundary faces of type 'wall'
+integer :: nsym ! Total no. of boundary faces of type 'symmetry'
+integer :: ninl ! No. of inlet boundary faces
+integer :: nout ! No. of outlet boundary faces
+
+
+integer, parameter :: nomax = 30 ! Max no. of nodes in face - determines size of some arrays, just change this if necessary.
+real(dp), parameter :: tiny = 1e-30
+
+! Mesh file units
+integer :: points_file, cells_file, faces_file, owner_file, neighbour_file, boundary_file
+
+integer, parameter :: interpolation_coeff_variant = 2 ! (1,2) look at the code below.
+
+
+! Mesh geometry
+
+! Geometry parameters defined for mesh nodes [1:numNodes]
+real(dp), dimension(:), allocatable :: x,y,z ! Coordinates of mesh nodes
+
+! Geometry parameters defined cellwise [1:numCells]:
+real(dp), dimension(:), allocatable :: xc,yc,zc ! Coordinates of cell centers
+real(dp), dimension(:), allocatable :: vol ! Cell volume
+real(dp), dimension(:), allocatable :: wallDistance ! Distance to the nearest wall - needed in some turb. models
+
+! Geometry parameters defined for all (inner+boundary) cell faces [1:numFaces]
+real(dp), dimension(:), allocatable :: arx, ary, arz ! Cell face area x-, y- and z-component
+real(dp), dimension(:), allocatable :: xf, yf, zf ! Coordinates of cell face center
+
+! Geometry parameters defined for all inner cell faces [1:numInnerFaces]
+real(dp), dimension(:), allocatable :: xpp, ypp, zpp ! Coordinates of auxilliary points - owner cell
+real(dp), dimension(:), allocatable :: xnp, ynp, znp ! Coordinates of auxilliary points - neighbour cell
+real(dp), dimension(:), allocatable :: facint ! Interpolation factor
+!real(dp), dimension(:), allocatable :: dpn ! Distance between neigbor cell centers [1:numInnerFaces]
+
+! Geometry parameters defined for boundary faces
+
+real(dp), dimension(:), allocatable :: srds,dns ! srds = |are|/|dns|, dns = normal distance to cell center from face |dpn*face_normal_unit_vec|
+real(dp), dimension(:), allocatable :: srdw,dnw ! srdw = |are|/|dnw|, dnw = normal distance to cell center from face |dpn*face_normal_unit_vec|
+
+! Mesh topology information - connectivity of cells trough faces
+integer, dimension(:), allocatable :: owner ! Index of the face owner cell
+integer, dimension(:), allocatable :: neighbour ! Index of the neighbour cell - it shares the face with owner
+
+
+public
+
+contains
+
+
+
+subroutine read_mesh_native
+!
+! Purpose:
+! Reads mesh in native freeCappuccino format and provides basic geometrical mesh description.
+!
+! Description:
+! Mesh is described in files of polyMesh format almost identical to the one used by OpenFoam.
+! The difference is that present one is adapted for Fortran numbering (starting from 1), etc.
+! Mesh files are 'points', 'faces', 'owner, 'neighbour', 'boundary'.
+! There is also a 'cells' file which is used only for Paraview postprocessing, i.e. when we write
+! Praview unstructured .vtu files, when we need to give cell connectivity. Also, such information
+! is usually given by mesh generators, so we don't want to waste this information.
+! For the purposes of Finite Volume Computation, as it is implemented in freeCappuccino, the cell
+! connectivity is not necessary.
+!
+! Date:
+! 26/11/2015; Jan-2019; Dec-2019.
+!
+! Author:
+! Nikola Mirkov (E-mail: largeddysimulation@gmail.com
+!
+ implicit none
+
+ ! Locals
+ integer :: i,k
+ integer :: ib,iwall,isym
+ integer :: iface
+ integer :: inp,inn,ijp
+
+ character(len=80) :: line_string
+
+ integer, dimension(:,:), allocatable :: node ! It will store global node numbers of face vertices
+ integer, dimension(:), allocatable :: nnodes ! no. of nodes in face
+
+ ! Parameters
+ real(dp), parameter :: half = 0.5_dp
+ real(dp), parameter :: third = 1./3._dp
+
+ real(dp) :: px,py,pz, qx,qy,qz, nx,ny,nz, cx,cy,cz
+ real(dp) :: riSi
+ real(dp) :: are,areasum
+ real(dp) :: xpn,ypn,zpn
+ real(dp) :: xjp,yjp,zjp
+ real(dp) :: dpn,djn,djp
+ real(dp) :: nxf,nyf,nzf
+
+ ! Array for temporary storage of doubles
+ real(dp), dimension(:), allocatable :: r8tmp
+
+
+!******************************************************************************
+! > OPEN polyMesh format files: 'points', 'faces', 'owner', 'neighbour'.
+!..............................................................................
+
+ call get_unit( points_file )
+ open( unit = points_file,file = 'polyMesh/points' )
+ rewind points_file
+
+ call get_unit( cells_file )
+ open( unit = cells_file,file = 'polyMesh/cells' )
+ rewind cells_file
+
+ call get_unit( faces_file )
+ open( unit = faces_file, file='polyMesh/faces' )
+ rewind faces_file
+
+ call get_unit( owner_file )
+ open( unit = owner_file, file='polyMesh/owner' )
+ rewind owner_file
+
+ call get_unit( neighbour_file )
+ open( unit = neighbour_file, file='polyMesh/neighbour' )
+ rewind neighbour_file
+
+ call get_unit( boundary_file )
+ open( unit = boundary_file, file='polyMesh/boundary' )
+ rewind boundary_file
+
+!
+! > Read boundary conditions file.
+!
+
+! Discussion:
+! Boundary conditions file consists of header and numBoundaries number of subsequent lines each containing:
+! boundary condition given name, bc type, number of faces belonging to that bc and starting face for that bc.
+! Possible boundary contiions types are: inlet, outlet, symmtery, wall, wallIsoth, wallAdiab, wallQFlux, prOutlet, etc.
+! Please check are all of these implemented, because this is still in the development. Contact me if you have any questions.
+!
+
+ ! Number of rows in the file excluding #comment in header to find the number of prescribed boundaries.
+ call file_row_count ( boundary_file, numBoundaries )
+
+ read(boundary_file,'(a)') line_string ! First line is header.
+ ! read(boundary_file,*) numBoundaries ! it doesn't need to read the number of boundaries because of the above
+
+ ! Allocate
+ allocate ( bcname(numBoundaries) )
+ allocate ( bctype(numBoundaries) )
+ allocate ( nFaces(numBoundaries) )
+ allocate ( startFace(numBoundaries) )
+ allocate ( iBndValueStart(numBoundaries))
+
+ nwal = 0
+ nsym = 0
+ ninl = 0
+
+ do i=1,numBoundaries
+ read(boundary_file,*) bcname(i), bctype(i), nfaces(i) ,startFace(i)
+
+ ! We need total number of some bctype faces like wall and symmetry to make things easier for bc implementation
+ ! so lets count them.
+ if( bctype(i) == 'wall') then
+ nwal = nwal + nfaces(i)
+ elseif( bctype(i) == 'symmetry') then
+ nsym = nsym + nfaces(i)
+ elseif( bctype(i) == 'inlet') then
+ ninl = ninl + nfaces(i)
+ elseif( bctype(i) == 'outlet') then
+ nout = nout + nfaces(i)
+ endif
+ enddo
+
+
+!
+! > Find out numCells, numNodes, numFaces, numInnerFaces, etc.
+!
+
+ read(cells_file, *) numCells
+ close( cells_file)
+
+ read(points_file, *) numNodes
+
+ read(owner_file, *) numFaces
+
+ read(neighbour_file, *) numInnerFaces
+
+
+ ! Number of boundary faces
+ numBoundaryFaces = numFaces - numInnerFaces
+
+ ! Size of arrays storing variables numCells+numBoundaryFaces
+ numTotal = numCells + numBoundaryFaces
+
+ ! NOTE:
+ ! The variable values defined at boundary faces are stored in variable arrays after numCells. The length of variable arrays therefore becomes numTotal = numCells + numBoundaryFaces
+ ! It is therefore important to do the following also:
+ ! Define where are the boundary field values located in the variable array, for each boundary region.
+ do i=1,numBoundaries
+ iBndValueStart(i) = numCells + (startFace(i) - numInnerFaces)
+ enddo
+
+!
+! > Write report on mesh size into log file
+!
+ write ( *, '(a)' ) ' '
+ write ( *, '(a)' ) ' '
+ write ( *, '(a)' ) ' Mesh data: '
+
+ write ( *, '(a)' ) ' '
+ write ( *, '(a,i0)' ) ' Number of nodes, numNodes = ', numNodes
+
+ write ( *, '(a)' ) ' '
+ write ( *, '(a,i0)' ) ' Number of cells, numCells = ', numCells
+
+ write ( *, '(a)' ) ' '
+ write ( *, '(a,i0)' ) ' Number of cell-faces, numFaces = ', numFaces
+
+ write ( *, '(a)' ) ' '
+ write ( *, '(a,i0)' ) ' Number of inner cell-faces, numInnerFaces = ', numInnerFaces
+
+ write ( *, '(a)' ) ' '
+ write ( *, '(a,i0)' ) ' Number of cell-faces on boundary, numBoundaryFaces = ', numBoundaryFaces
+
+ write ( *, '(a)' ) ' '
+ write ( *, '(a)' ) ' Boundary information (bcname, bctype, nFaces, startFace):'
+ write ( *, '(a)' ) ' '
+
+ do i=1,numBoundaries
+ write(*,'(2x,a,1x,a,1x,2(i0,1x))') bcname(i), bctype(i), nfaces(i) ,startFace(i)
+ enddo
+ write ( *, '(a)' ) ' '
+
+
+
+!******************************************************************************
+! > Allocate arrays for Mesh description
+!..............................................................................
+
+ ! Nodal coordinates
+ allocate ( x(numNodes) )
+ allocate ( y(numNodes) )
+ allocate ( z(numNodes) )
+
+ ! Coordinates of cell centers
+ allocate ( xc(numCells) )
+ allocate ( yc(numCells) )
+ allocate ( zc(numCells) )
+
+ ! Cell volumes
+ allocate ( vol(numCells) )
+
+ ! Face area vector components
+ allocate ( arx(numFaces) )
+ allocate ( ary(numFaces) )
+ allocate ( arz(numFaces) )
+
+ ! Coordinates of cell face centers
+ allocate ( xf(numFaces) )
+ allocate ( yf(numFaces) )
+ allocate ( zf(numFaces) )
+
+ ! Interpolation factor for inner faces
+ allocate ( facint(numInnerFaces) )
+
+ ! Indices of owner cell (inner+boundary faces) and indices of neighbours for every inner cell-face.
+ allocate ( owner(numFaces) )
+ allocate ( neighbour(numInnerFaces) )
+
+ ! Array stroring the walue of distance to the nearest wall, needed only in some turb. models (maybe allocate only when needed)
+ allocate ( wallDistance(numCells) )
+
+ ! We need this only for wall and symmetry BCs, so it is not bad to have nsym and nwal parameters, which count home many of them
+ ! are there.
+ allocate ( dns(nsym) )
+ allocate ( srds(nsym) )
+ allocate ( dnw(nwal) )
+ allocate ( srdw(nwal) )
+
+
+!******************************************************************************
+! > Read and process Mesh files
+!..............................................................................
+
+ ! The 'points' file
+ do i=1,numNodes
+ read(points_file,*) x(i),y(i),z(i)
+ end do
+
+
+ ! The 'owner' file
+ do i=1,numFaces
+ read(owner_file,*) owner(i)
+ end do
+
+
+ ! The 'neighbour' file
+ do i=1,numInnerFaces
+ read(neighbour_file,*) neighbour(i)
+ end do
+
+ ! The 'faces' file
+
+ read( faces_file, * ) line_string ! we don't need this info on first line
+
+ ! Allocate tmp array of number of nodes for each face - nnodes, and node array
+ allocate( nnodes(numFaces) )
+ allocate( node(4,numFaces) )
+
+ do iface=1,numFaces
+ read( faces_file, * ) nnodes(iface),(node(k,iface), k=1,nnodes(iface) )
+ enddo
+
+ ! Allocate tmp array of doubles
+ allocate( r8tmp(numCells))
+ r8tmp = 0.0_dp
+
+
+ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ ! > Cell volumes, cell centers and cell face centers
+ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ do iface=1,numFaces
+
+ inp = owner(iface)
+
+ ! Initialize total area of polygon.
+ areasum = 0.0_dp
+
+ ! We decompose a polygon to a series of triangles, all having first node in common.
+ do i=1, nnodes(iface)-2
+ ! Vectors to vertices
+ ! 2-1
+ px = x( node(i+1,iface) )-x( node(1,iface) )
+ py = y( node(i+1,iface) )-y( node(1,iface) )
+ pz = z( node(i+1,iface) )-z( node(1,iface) )
+ ! 3-1
+ qx = x( node(i+2,iface) )-x( node(1,iface) )
+ qy = y( node(i+2,iface) )-y( node(1,iface) )
+ qz = z( node(i+2,iface) )-z( node(1,iface) )
+
+
+ call triangle_area_vector( px,py,pz, qx,qy,qz, nx,ny,nz )
+
+ !
+ ! > Cell-face area vector components (Area vector lies in direction of face normal)
+ !
+
+ arx(iface) = arx(iface) + nx
+ ary(iface) = ary(iface) + ny
+ arz(iface) = arz(iface) + nz
+
+ ! Face center for a triangle
+ cx = third*( x( node(i+2,iface) ) + x( node(i+1,iface) ) + x( node(1,iface) ) )
+ cy = third*( y( node(i+2,iface) ) + y( node(i+1,iface) ) + y( node(1,iface) ) )
+ cz = third*( z( node(i+2,iface) ) + z( node(i+1,iface) ) + z( node(1,iface) ) )
+
+ !
+ ! > Cell-face centroid components - accumulation stage
+ !
+
+ are = sqrt(nx**2 + ny**2 + nz**2)
+
+ xf(iface) = xf(iface) + (are*cx)
+ yf(iface) = yf(iface) + (are*cy)
+ zf(iface) = zf(iface) + (are*cz)
+
+ ! Accumulate triangle areas to get total area of the polygon
+ areasum = areasum + are
+
+
+ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ ! > Compute cell volumes and cell centers
+ !
+ ! We compute cell volumes by aaplying divergence theorem to the position vector,
+ ! see eq. (5) in [1].
+ ! Cell center coordinates of an arbitrary polyhedron are computed using eq.(15) of ref. [1].
+ !
+ ! [1] Z.J. Wang - Improved Formulation for Geometric Properties of Arbitrary Polyhedra
+ ! AIAA Journal, Vol. 37, No. 10, October 1999
+ !
+ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+
+ riSi = ( cx*nx + cy*ny + cz*nz )
+
+ vol(inp) = vol(inp) + third * riSi
+
+ xc(inp) = xc(inp) + 0.75_dp * riSi * cx
+ yc(inp) = yc(inp) + 0.75_dp * riSi * cy
+ zc(inp) = zc(inp) + 0.75_dp * riSi * cz
+
+ ! We use r8tmp array to store accumulated denominator
+ r8tmp(inp) = r8tmp(inp) + riSi
+
+
+ if ( iface <= numInnerFaces ) then
+ inn = neighbour(iface)
+
+ riSi = -( cx*nx + cy*ny + cz*nz )
+
+ vol(inn) = vol(inn) + third * riSi
+
+ xc(inn) = xc(inn) + 0.75_dp * riSi * cx
+ yc(inn) = yc(inn) + 0.75_dp * riSi * cy
+ zc(inn) = zc(inn) + 0.75_dp * riSi * cz
+
+ ! We use r8tmp array to store accumulated denominator
+ r8tmp(inn) = r8tmp(inn) + riSi
+
+ endif
+
+ enddo
+
+ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ ! > Cell-face centroid components - final
+ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+ xf(iface) = xf(iface) / areasum
+ yf(iface) = yf(iface) / areasum
+ zf(iface) = zf(iface) / areasum
+
+ enddo
+
+ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ ! > Cell centroid components - final
+ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+ ! Do one more loop over cell volumes to divide accumulated cell center values by
+ ! denominator accumulated in wallDistance array for convenience.
+ do inp=1,numCells
+ xc(inp) = xc(inp) / r8tmp(inp)
+ yc(inp) = yc(inp) / r8tmp(inp)
+ zc(inp) = zc(inp) / r8tmp(inp)
+ enddo
+
+ ! Thank you.
+ deallocate(r8tmp)
+
+
+ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ ! > Interpolation factor
+ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+ if ( interpolation_coeff_variant == 1 ) then
+
+ !
+ ! > Interpolation factor > inner faces - Variant 1.
+ !
+ do iface=1,numInnerFaces
+
+ inp = owner(iface)
+ inn = neighbour(iface)
+
+ xpn = xc(inn)-xc(inp)
+ ypn = yc(inn)-yc(inp)
+ zpn = zc(inn)-zc(inp)
+
+ dpn = sqrt( xpn**2 + ypn**2 + zpn**2 )
+
+ !
+ ! > > Intersection point j' of line connecting centers with cell face, we are taking only three points assuming that other are co-planar
+ !
+ call find_intersection_point(&
+ ! plane defined by three face vertices:
+ x( node(1,iface) ), y( node(1,iface) ), z( node(1,iface) ),&
+ x( node(2,iface) ), y( node(2,iface) ), z( node(2,iface) ), &
+ x( node(3,iface) ), y( node(3,iface) ), z( node(3,iface) ), &
+ ! line defined by cell center and neighbour center:
+ xc(inp),yc(inp),zc(inp), &
+ xc(inn),yc(inn),zc(inn), &
+ ! intersection point (output):
+ xjp,yjp,zjp &
+ )
+ xpn = xjp - xc(inp)
+ ypn = yjp - yc(inp)
+ zpn = zjp - zc(inp)
+
+ djn = sqrt( xpn**2 + ypn**2 + zpn**2 )
+
+ ! Interpolation factor |P Pj'|/|P Pj| where P is cell center, Pj neighbour cell center and j' intersection point.
+ facint(iface) = djn / dpn
+
+ enddo
+
+ else
+
+ !
+ ! > Interpolation factor > inner faces - Variant 2.
+ !
+ do iface=1,numInnerFaces
+
+ inp = owner(iface)
+ inn = neighbour(iface)
+
+ xpn = xf(iface) - xc(inp)
+ ypn = yf(iface) - yc(inp)
+ zpn = zf(iface) - zc(inp)
+
+ djp = sqrt( xpn**2 + ypn**2 + zpn**2 )
+
+ xpn = xf(iface) - xc(inn)
+ ypn = yf(iface) - yc(inn)
+ zpn = zf(iface) - zc(inn)
+
+ djn = sqrt( xpn**2 + ypn**2 + zpn**2 )
+
+ ! Interpolation factor |PjF|/|PF + PjF| where P is cell center, Pj neighbour cell center and F is face centroid.
+ facint(iface) = djp / ( djp + djn )
+
+ enddo
+
+ endif
+
+ deallocate(nnodes)
+ deallocate(node)
+
+
+ ! Loop over wall boundaries to calculate normal distance from cell center of the first cell layer - dnw, and
+ ! loop over symmetry boundaries to calculate normal distance from cell center of the first cell layer - dns.
+
+ iWall = 0
+ iSym = 0
+
+ do ib=1,numBoundaries
+
+ if ( bctype(ib) == 'symmetry') then
+
+ ! Symmetry
+ do i=1,nfaces(ib)
+
+ iface = startFace(ib) + i
+ ijp = owner(iface)
+ iSym = iSym + 1
+
+ ! Face area
+ are = sqrt(arx(iface)**2+ary(iface)**2+arz(iface)**2)
+
+ ! Face normals
+ nxf = arx(iface)/are
+ nyf = ary(iface)/are
+ nzf = arz(iface)/are
+
+ ! We need the minus sign because of the direction of normal vector to boundary face which is positive if it faces out.
+ dns(iSym) = (xf(iface)-xc(ijp))*nxf + (yf(iface)-yc(ijp))*nyf + (zf(iface)-zc(ijp))*nzf
+
+ ! Cell face area divided by distance to the cell center
+ srds(iSym) = are/dns(iSym)
+
+ end do
+
+ elseif ( bctype(ib) == 'wall') then
+
+ do i=1,nfaces(ib)
+
+ iface = startFace(ib) + i
+ ijp = owner(iface)
+ iWall = iWall + 1
+
+ ! Face area
+ are = sqrt(arx(iface)**2+ary(iface)**2+arz(iface)**2)
+
+ ! Face normals
+ nxf = arx(iface)/are
+ nyf = ary(iface)/are
+ nzf = arz(iface)/are
+
+ ! We need the minus sign because of the direction of normal vector to boundary face which is positive if it faces out.
+ dnw(iWall) = (xf(iface)-xc(ijp))*nxf + (yf(iface)-yc(ijp))*nyf + (zf(iface)-zc(ijp))*nzf
+
+ ! Cell face area divided by distance to the cell center
+ srdw(iWall) = are/dnw(iWall)
+
+ enddo
+
+ endif
+
+ enddo
+
+
+!******************************************************************************
+! > Report on geometrical quantities > I will leave this for debug purposes.
+!..............................................................................
+
+ write ( *, '(a)' ) ' '
+ write ( *, '(a)' ) ' Cell data: '
+
+ call r8vec_print_some ( numCells, vol, 1, 10, &
+ ' First 10 elements of cell volumes array:' )
+
+ call r8vec_print_some ( numCells, xc, 1, 10, &
+ ' First 10 elements of cell x-centers array:' )
+
+ call r8vec_print_some ( numCells, yc, 1, 10, &
+ ' First 10 elements of cell y-centers array:' )
+
+ call r8vec_print_some ( numCells, zc, 1, 10, &
+ ' First 10 elements of cell z-centers array:' )
+
+ write ( *, '(a)' ) ' '
+ write ( *, '(a)' ) ' Face data: '
+
+ call i4vec_print2 ( 10, owner, neighbour, ' First 10 lines of owner and neighbour arrays:' )
+
+ call r8vec_print_some ( numFaces, arx, 1, 10, &
+ ' First 10 elements of Arx array:' )
+
+ call r8vec_print_some ( numFaces, ary, 1, 10, &
+ ' First 10 elements of Ary array:' )
+
+ call r8vec_print_some ( numFaces, arz, 1, 10, &
+ ' First 10 elements of Arz array:' )
+
+ call r8vec_print_some ( numFaces, xf, 1, 10, &
+ ' First 10 elements of xf array:' )
+
+ call r8vec_print_some ( numFaces, yf, 1, 10, &
+ ' First 10 elements of yf array:' )
+
+ call r8vec_print_some ( numFaces, zf, 1, 10, &
+ ' First 10 elements of zf array:' )
+
+ call r8vec_print_some ( numInnerFaces, facint, 1, 10, &
+ ' First 10 elements of interpolation factor (facint) array:' )
+
+ write ( *, '(a)' ) ' '
+
+!
+! > CLOSE polyMesh format file: 'points', 'faces', 'owner', 'neighbour', 'boundary'.
+!
+ close ( points_file )
+ close ( faces_file )
+ close ( owner_file )
+ close ( neighbour_file)
+ close ( boundary_file)
+!+-----------------------------------------------------------------------------+
+
+end subroutine read_mesh_native
+
+
+
+subroutine read_mesh
+!
+! Description:
+! Calculates basic geometrical quantities of numerical mesh
+! defined in this module and needed for FVM computation.
+! Mesh is described in files of polyMesh format.
+! Mesh files are 'points', 'faces', 'owner, 'neighbour', 'boundary'
+!
+! Date:
+! 26/11/2015; Jan-2019
+!
+! Author:
+! Nikola Mirkov nmirkov@vin.bg.ac.rs
+!
+ implicit none
+
+ ! Locals
+ integer :: i,j,k,l,itmp
+ integer :: ib,iwall,isym
+ integer :: iface
+ integer :: inp,inn,ijp
+ integer :: v1,v2,v3
+
+ character(len=1) :: ch
+ character(len=20) :: char_string,char_string2
+ character(len=80) :: line_string
+
+ integer, dimension(:,:), allocatable :: node ! It will store global node numbers of face vertices
+ integer, dimension(:), allocatable :: nnodes ! no. of nodes in face
+
+ ! Parameters
+ real(dp), parameter :: half = 0.5_dp
+ real(dp), parameter :: third = 1./3._dp
+
+ real(dp) :: px,py,pz, qx,qy,qz, nx,ny,nz, cx,cy,cz
+ real(dp) :: riSi
+ real(dp) :: are,areasum
+ real(dp) :: xpn,ypn,zpn
+ real(dp) :: xjp,yjp,zjp
+ real(dp) :: dpn,djn
+ real(dp) :: nxf,nyf,nzf
+
+ ! Array for temporary storage of doubles
+ real(dp), dimension(:), allocatable :: r8tmp
+
+
+!******************************************************************************
+! > OPEN polyMesh format files: 'points', 'faces', 'owner', 'neighbour'.
+!..............................................................................
+
+ call get_unit( points_file )
+ open( unit = points_file,file = 'polyMesh/points' )
+ rewind points_file
+
+ call get_unit( faces_file )
+ open( unit = faces_file, file='polyMesh/faces' )
+ rewind faces_file
+
+ call get_unit( owner_file )
+ open( unit = owner_file, file='polyMesh/owner' )
+ rewind owner_file
+
+ call get_unit( neighbour_file )
+ open( unit = neighbour_file, file='polyMesh/neighbour' )
+ rewind neighbour_file
+
+ call get_unit( boundary_file )
+ open( unit = boundary_file, file='polyMesh/boundary' )
+ rewind boundary_file
+
+
+
+!
+! > Read boundary conditions file.
+!
+
+!
+! Boundary conditions file consists of header and numBoundaries number of subsequent lines each containing:
+! boundary condition given name, bc type, number of faces belonging to that bc and starting face for that bc.
+! Possible boundary contiions types are: inlet, outlet, symmtery, wall, wallIsoth, wallAdiab, wallQFlux, prOutlet, etc.
+! Please check are all of these implemented, because this is still in the development. Contact me if you have any questions.
+!
+
+
+ ! Number of rows in the file excluding #comment in header to find the number of prescribed boundaries
+ call file_row_count ( boundary_file, numBoundaries )
+
+ read(boundary_file,'(a)') line_string ! Firts line is header.
+ ! read(boundary_file,*) numBoundaries ! it doesn't need to read the number of boundaries because of the above
+
+ ! Allocate
+ allocate ( bcname(numBoundaries) )
+ allocate ( bctype(numBoundaries) )
+ allocate ( nFaces(numBoundaries) )
+ allocate ( startFace(numBoundaries) )
+ allocate ( iBndValueStart(numBoundaries))
+
+ nwal = 0
+ nsym = 0
+ ninl = 0
+
+ do i=1,numBoundaries
+ read(boundary_file,*) bcname(i), bctype(i), nfaces(i) ,startFace(i)
+
+ ! We need total number of some bctype faces like wall and symmetry to make things easier for bc implementation
+ ! so lets count them.
+ if( bctype(i) == 'wall') then
+ nwal = nwal + nfaces(i)
+ elseif( bctype(i) == 'symmetry') then
+ nsym = nsym + nfaces(i)
+ elseif( bctype(i) == 'inlet') then
+ ninl = ninl + nfaces(i)
+ elseif( bctype(i) == 'outlet') then
+ nout = nout + nfaces(i)
+ endif
+ enddo
+
+
+!******************************************************************************
+! > Find out numNodes, numFaces, numInnerFaces, etc.
+!..............................................................................
+
+ !
+ ! Code here is tested for OpenFOAM version 4.0, if they don't change polyMesh format this should be OK.
+ !
+
+ !
+ ! The 'owner' file. After reading this we will have numNodes, numCells, numInnerFaces, numFaces
+ !
+
+ k=0
+ l=0
+ char_string = ' '
+
+ owner_header_loop: do
+
+ ! Trying to find the line with mesh size info, and read numCells
+ read(owner_file,*) char_string,line_string
+ ! write(*,*) "owner file ",char_string
+
+ if (char_string == 'note') then
+
+ ! Do probing for nPoints:
+ do j=1,len_trim(line_string)-5
+ if (line_string(j:j+6)=='nPoints') then
+ k=j+8
+ endif
+ if (line_string(j:j+5)=='nCells') then
+ l=j-2
+ exit
+ endif
+ end do
+ read(line_string(k:l),*) numNodes
+ ! write(*,*) numNodes
+
+ ! Do probing for nCells:
+ do j=1,len_trim(line_string)-5
+ if (line_string(j:j+5)=='nCells') then
+ k=j+7
+ endif
+ if (line_string(j:j+5)=='nFaces') then
+ l=j-2
+ exit
+ endif
+ end do
+ read(line_string(k:l),*) numCells
+ ! write(*,*) numCells
+
+ ! Do probing for nFaces:
+ do j=1,len_trim(line_string)-5
+ if (line_string(j:j+5)=='nFaces') then
+ k=j+7
+ endif
+ if (line_string(j:j+13)=='nInternalFaces') then
+ l=j-2
+ exit
+ endif
+ end do
+ read(line_string(k:l),*) numFaces
+ ! write(*,*) numFaces
+
+ ! Do probing for nInternalFaces:
+ do j=1,len_trim(line_string)-5
+ ! write(*,*)line_string(j:j+15)
+
+ if (line_string(j:j+14)=='nInternalFaces:') then
+ read(line_string(j+15:),*) numInnerFaces
+ ! write(*,*) numInnerFaces
+ exit
+
+ endif
+ end do
+
+ exit owner_header_loop
+ endif
+
+ end do owner_header_loop
+
+ rewind owner_file
+
+ ! NOTE: Trying to acces number of faces data. So we go check line by line,
+ ! when we get to "(" we go two lines back and read numFaces.
+
+ ch = ' '
+ owner_loop: do
+ read(owner_file,*) ch
+ if (ch == '(') then
+ ! Return two lines
+ backspace(owner_file)
+ backspace(owner_file)
+ exit owner_loop
+ endif
+ end do owner_loop
+
+ read(owner_file,*) itmp
+ if (itmp /= numFaces ) then
+ write(*,*) "Error reading polyMesh format. numFaces value is not confirmed in body of the 'owner' file."
+ stop
+ endif
+ read(owner_file,*) char_string ! reads "(" again
+
+
+ !
+ ! The 'points' file
+ !
+
+ ! NOTE: Trying to acces number of points data. So we go check line by line,
+ ! when we get to "(" we go two lines back and read numNodes.
+
+ ch = ' '
+ point_header_loop: do
+ read(points_file,*) ch
+ if (ch == '(') then
+ ! Return two lines
+ backspace(points_file)
+ backspace(points_file)
+ exit point_header_loop
+ endif
+ end do point_header_loop
+
+ read(points_file,*) itmp
+ if (itmp /= numNodes ) then
+ write(*,*) "Error reading polyMesh format. numNodes value is not confirmed in 'points' file."
+ stop
+ endif
+ read(points_file,*) char_string ! reads "("
+
+ !
+ ! The 'neighbour' file
+ !
+
+ ! NOTE: Trying to acces number of inner faces data. So we go check line by line,
+ ! when we get to "(" we go two lines back and read numInnerFaces.
+
+ ch = ' '
+ neighbour_header_loop: do
+ read(neighbour_file,*) ch
+ if (ch == '(') then
+ ! Return two lines
+ backspace(neighbour_file)
+ backspace(neighbour_file)
+ exit neighbour_header_loop
+ endif
+ end do neighbour_header_loop
+
+ read(neighbour_file,*) itmp
+ if (itmp /= numInnerFaces ) then
+ write(*,*) "Error reading polyMesh format. numInnerFaces value is not confirmed in 'neighbour' file."
+ stop
+ endif
+ read(neighbour_file,*) char_string ! reads "("
+
+ !
+ ! The 'faces' file
+ !
+
+ ! NOTE: Trying to acces number of faces data. So we go check line by line,
+ ! when we get to "(" we go two lines back and read numFaces.
+
+ ch = ' '
+ faces_header_loop: do
+ read(faces_file,*) ch
+ if (ch == '(') then
+ backspace(faces_file)
+ backspace(faces_file)
+ exit faces_header_loop
+ endif
+ end do faces_header_loop
+
+ read(faces_file, *) itmp
+ if (itmp /= numFaces ) then
+ write(*,*) "Error reading polyMesh format. numFaces value is not confirmed in 'faces' file."
+ stop
+ endif
+ read(faces_file,*) char_string ! the '(' chracter
+
+ ! Number of boundary faces
+ numBoundaryFaces = numFaces - numInnerFaces
+
+ ! Size of arrays storing variables numCells+numBoundaryFaces
+ numTotal = numCells + numBoundaryFaces
+
+ ! NOTE:
+ ! The variable values defined at boundary faces are stored in variable arrays after numCells. The length of variable arrays therefore becomes numTotal = numCells + numBoundaryFaces
+ ! It is therefore important to do the following also.
+ ! Define where are the boundary field values located in the variable array, for each boundary region
+ do i=1,numBoundaries
+ iBndValueStart(i) = numCells + (startFace(i) - numInnerFaces)
+ enddo
+
+!
+! > Write report on mesh size into log file
+!
+ write ( *, '(a)' ) ' '
+ write ( *, '(a)' ) ' '
+ write ( *, '(a)' ) ' Mesh data: '
+
+ write ( *, '(a)' ) ' '
+ write ( *, '(a,i0)' ) ' Number of nodes, numNodes = ', numNodes
+
+ write ( *, '(a)' ) ' '
+ write ( *, '(a,i0)' ) ' Number of cells, numCells = ', numCells
+
+ write ( *, '(a)' ) ' '
+ write ( *, '(a,i0)' ) ' Number of cell-faces, numFaces = ', numFaces
+
+ write ( *, '(a)' ) ' '
+ write ( *, '(a,i0)' ) ' Number of inner cell-faces, numInnerFaces = ', numInnerFaces
+
+ write ( *, '(a)' ) ' '
+ write ( *, '(a,i0)' ) ' Number of cell-faces on boundary, numBoundaryFaces = ', numBoundaryFaces
+
+ write ( *, '(a)' ) ' '
+ write ( *, '(a)' ) ' Boundary information (bcname, bctype, nFaces, startFace):'
+ write ( *, '(a)' ) ' '
+
+ do i=1,numBoundaries
+ write(*,'(2x,a,1x,a,1x,2(i0,1x))') bcname(i), bctype(i), nfaces(i) ,startFace(i)
+ enddo
+ write ( *, '(a)' ) ' '
+
+
+
+!******************************************************************************
+! > Allocate arrays for Mesh description
+!..............................................................................
+
+ ! Nodal coordinates
+ allocate ( x(numNodes) )
+ allocate ( y(numNodes) )
+ allocate ( z(numNodes) )
+
+ ! Coordinates of cell centers
+ allocate ( xc(numCells) )
+ allocate ( yc(numCells) )
+ allocate ( zc(numCells) )
+
+ ! Cell volumes
+ allocate ( vol(numCells) )
+
+ ! Face area vector components
+ allocate ( arx(numFaces) )
+ allocate ( ary(numFaces) )
+ allocate ( arz(numFaces) )
+
+ ! Coordinates of cell face centers
+ allocate ( xf(numFaces) )
+ allocate ( yf(numFaces) )
+ allocate ( zf(numFaces) )
+
+ ! Interpolation factor for inner faces
+ allocate ( facint(numInnerFaces) )
+
+ ! Indices of owner cell (inner+boundary faces) and indices of neighbours for every inner cell-face.
+ allocate ( owner(numFaces) )
+ allocate ( neighbour(numInnerFaces) )
+
+ ! Array stroring the walue of distance to the nearest wall, needed only in some turb. models (maybe allocate only when needed)
+ allocate ( wallDistance(numCells) )
+
+ ! We need this only for wall and symmetry, so it is not bad to have nsym and nwal wich count home many of them there is.
+ allocate ( dns(nsym) )
+ allocate ( srds(nsym) )
+ allocate ( dnw(nwal) )
+ allocate ( srdw(nwal) )
+
+
+
+!******************************************************************************
+! > Read and process Mesh files
+!..............................................................................
+
+ ! The 'points' file
+ do i=1,numNodes
+ ! char_string reads (number, char_string reads number), we have to strip off the brackets later.
+ read(points_file,*) char_string,y(i),char_string2
+
+ ! Char to double conversion + stripping off the brackets:
+ read(char_string(2:),*) x(i)
+ read(char_string2(1:len_trim(char_string2)-1),*) z(i)
+ end do
+
+
+ ! The 'owner' file
+ do i=1,numFaces
+ read(owner_file,*) owner(i)
+ owner(i) = owner(i) + 1 ! fortran starts from 1
+ end do
+
+
+ ! The 'neighbour' file
+ do i=1,numInnerFaces
+ read(neighbour_file,*) neighbour(i)
+ neighbour(i) = neighbour(i) + 1 ! fortran starts from 1
+ end do
+
+ ! Allocate tmp array of number of nodes for each face - nnodes, and node array
+ allocate( nnodes(numFaces) )
+ allocate( node(4,numFaces) )
+ nnodes = 0
+ node = 0
+
+
+ ! The 'faces' file
+ do iface=1,numFaces
+ ! Read line in 'faces' file
+ call read_line_faces_file_polyMesh(faces_file,nnodes(iface),node(1:4,iface),4)
+ enddo
+
+ ! Allocate tmp array of doubles
+ allocate( r8tmp(numCells) )
+ r8tmp = 0.0_dp
+
+ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ ! > Cell volumes, cell centers and cell face centers
+ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+ do iface=1,numFaces
+
+ inp = owner(iface)
+
+ r8tmp(inp) = 0.0_dp
+
+ ! Initialize total area of polygon.
+ areasum = 0.0_dp
+
+ ! We decompose a polygon to a series of triangles, all having first node in common.
+ do i=1, nnodes(iface)-2
+
+ v1 = node(1, iface)
+ v2 = node(i+1,iface)
+ v3 = node(i+2,iface)
+
+ ! Vectors to vertices
+ ! 2-1
+ px = x( v2 ) - x( v1 )
+ py = y( v2 ) - y( v1 )
+ pz = z( v2 ) - z( v1 )
+ ! 3-1
+ qx = x( v3 ) - x( v1 )
+ qy = y( v3 ) - y( v1 )
+ qz = z( v3 ) - z( v1 )
+
+ call triangle_area_vector( px,py,pz, qx,qy,qz, nx,ny,nz )
+
+ !
+ ! > Cell-face area vector components (Area vector lies in direction of face normal)
+ !
+
+ arx(iface) = arx(iface) + nx
+ ary(iface) = ary(iface) + ny
+ arz(iface) = arz(iface) + nz
+
+ ! Face center for a triangle
+ cx = third*( x( v3 ) + x( v2 ) + x( v1 ) )
+ cy = third*( y( v3 ) + y( v2 ) + y( v1 ) )
+ cz = third*( z( v3 ) + z( v2 ) + z( v1 ) )
+ !
+ ! > Cell-face centroid components - accumulation stage
+ !
+
+ are = sqrt(nx**2 + ny**2 + nz**2)
+
+ xf(iface) = xf(iface) + (are*cx)
+ yf(iface) = yf(iface) + (are*cy)
+ zf(iface) = zf(iface) + (are*cz)
+
+ ! Accumulate triangle areas to get total area of the polygon
+ areasum = areasum + are
+
+
+ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ ! > Compute cell volumes and cell centers
+ !
+ ! We compute cell volumes by aaplying divergence theorem to the position vector,
+ ! see eq. (5) in [1].
+ ! Cell center coordinates of an arbitrary polyhedron are computed using eq.(15) of ref. [1].
+ !
+ ! [1] Z.J. Wang - Improved Formulation for Geometric Properties of Arbitrary Polyhedra
+ ! AIAA Journal, Vol. 37, No. 10, October 1999
+ !
+ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+
+ riSi = ( cx*nx + cy*ny + cz*nz )
+
+ vol(inp) = vol(inp) + third * riSi
+
+ xc(inp) = xc(inp) + 0.75_dp * riSi * cx
+ yc(inp) = yc(inp) + 0.75_dp * riSi * cy
+ zc(inp) = zc(inp) + 0.75_dp * riSi * cz
+
+ ! We use r8tmp array to store accumulated denominator
+ r8tmp(inp) = r8tmp(inp) + riSi
+
+
+ if ( iface <= numInnerFaces ) then
+ inn = neighbour(iface)
+
+ riSi = -( cx*nx + cy*ny + cz*nz )
+
+ vol(inn) = vol(inn) + third * riSi
+
+ xc(inn) = xc(inn) + 0.75_dp * riSi * cx
+ yc(inn) = yc(inn) + 0.75_dp * riSi * cy
+ zc(inn) = zc(inn) + 0.75_dp * riSi * cz
+
+ ! We use r8tmp array to store accumulated denominator
+ r8tmp(inn) = r8tmp(inn) + riSi
+
+ endif
+
+ enddo
+
+ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ ! > Cell-face centroid components - final
+ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+ xf(iface) = xf(iface) / areasum
+ yf(iface) = yf(iface) / areasum
+ zf(iface) = zf(iface) / areasum
+
+ enddo
+
+ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ ! > Cell centroid components - final
+ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+ ! Do one more loop over cell volumes to divide accumulated cell center values by
+ ! denominator accumulated in wallDistance array for convenience.
+ do inp=1,numCells
+ xc(inp) = xc(inp) / r8tmp(inp)
+ yc(inp) = yc(inp) / r8tmp(inp)
+ zc(inp) = zc(inp) / r8tmp(inp)
+ enddo
+
+
+ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ ! > Interpolation factor
+ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+ !
+ ! > Interpolation factor > inner faces
+ !
+
+ do iface=1,numInnerFaces
+
+ inp = owner(iface)
+ inn = neighbour(iface)
+
+ ! xpn = xc(inn)-xc(inp)
+ ! ypn = yc(inn)-yc(inp)
+ ! zpn = zc(inn)-zc(inp)
+
+ xpn = xc(inn)-xf(iface)
+ ypn = yc(inn)-yf(iface)
+ zpn = zc(inn)-zf(iface)
+
+ dpn = sqrt( xpn**2 + ypn**2 + zpn**2 )
+
+ ! !
+ ! ! > > Intersection point j' of line connecting centers with cell face, we are taking only three points assuming that other are co-planar
+ ! !
+ ! call find_intersection_point(&
+ ! ! plane defined by three face vertices:
+ ! x( node(1,iface) ), y( node(1,iface) ), z( node(1,iface) ),&
+ ! x( node(2,iface) ), y( node(2,iface) ), z( node(2,iface) ), &
+ ! x( node(3,iface) ), y( node(3,iface) ), z( node(3,iface) ), &
+ ! ! line defined by cell center and neighbour center:
+ ! xc(inp),yc(inp),zc(inp), &
+ ! xc(inn),yc(inn),zc(inn), &
+ ! ! intersection point (output):
+ ! xjp,yjp,zjp &
+ ! )
+ ! xpn = xjp - xc(inp)
+ ! ypn = yjp - yc(inp)
+ ! zpn = zjp - zc(inp)
+
+ xpn = xf(iface) - xc(inp)
+ ypn = yf(iface) - yc(inp)
+ zpn = zf(iface) - zc(inp)
+
+ djn = sqrt( xpn**2 + ypn**2 + zpn**2 )
+
+ ! Interpolation factor |P Pj'|/|P Pj| where P is cell center, Pj neighbour cell center and j' intersection point.
+ ! facint(iface) = djn / dpn
+ facint(iface) = djn / ( dpn + djn )
+
+ enddo
+
+
+ ! Loop over wall boundaries to calculate normal distance from cell center of the first cell layer - dnw, and
+ ! loop over symmetry boundaries to calculate normal distance from cell center of the first cell layer - dns.
+
+ iWall = 0
+ iSym = 0
+
+ do ib=1,numBoundaries
+
+ if ( bctype(ib) == 'symmetry') then
+
+ ! Symmetry
+ do i=1,nfaces(ib)
+
+ iface = startFace(ib) + i
+ ijp = owner(iface)
+ iSym = iSym + 1
+
+ ! Face area
+ are = sqrt(arx(iface)**2+ary(iface)**2+arz(iface)**2)
+
+ ! Face normals
+ nxf = arx(iface)/are
+ nyf = ary(iface)/are
+ nzf = arz(iface)/are
+
+ ! We need the minus sign because of the direction of normal vector to boundary face which is positive if it faces out.
+ dns(iSym) = (xf(iface)-xc(ijp))*nxf + (yf(iface)-yc(ijp))*nyf + (zf(iface)-zc(ijp))*nzf
+
+ ! Cell face area divided by distance to the cell center
+ srds(iSym) = are/dns(iSym)
+
+ end do
+
+ elseif ( bctype(ib) == 'wall') then
+
+ do i=1,nfaces(ib)
+
+ iface = startFace(ib) + i
+ ijp = owner(iface)
+ iWall = iWall + 1
+
+ ! Face area
+ are = sqrt(arx(iface)**2+ary(iface)**2+arz(iface)**2)
+
+ ! Face normals
+ nxf = arx(iface)/are
+ nyf = ary(iface)/are
+ nzf = arz(iface)/are
+
+ ! We need the minus sign because of the direction of normal vector to boundary face which is positive if it faces out.
+ dnw(iWall) = (xf(iface)-xc(ijp))*nxf + (yf(iface)-yc(ijp))*nyf + (zf(iface)-zc(ijp))*nzf
+
+ ! Cell face area divided by distance to the cell center
+ srdw(iWall) = are/dnw(iWall)
+
+ enddo
+
+ endif
+
+ enddo
+
+
+!******************************************************************************
+! > Report on geometrical quantities > I will leave this for debug purposes.
+!..............................................................................
+
+ write ( *, '(a)' ) ' '
+ write ( *, '(a)' ) ' Cell data: '
+
+ call r8vec_print_some ( numCells, vol, 1, 10, &
+ ' First 10 elements of cell volumes array:' )
+
+ call r8vec_print_some ( numCells, xc, 1, 10, &
+ ' First 10 elements of cell x-centers array:' )
+
+ call r8vec_print_some ( numCells, yc, 1, 10, &
+ ' First 10 elements of cell y-centers array:' )
+
+ call r8vec_print_some ( numCells, zc, 1, 10, &
+ ' First 10 elements of cell z-centers array:' )
+
+ write ( *, '(a)' ) ' '
+ write ( *, '(a)' ) ' Face data: '
+
+ call i4vec_print2 ( 10, owner, neighbour, ' First 10 lines of owner and neighbour arrays:' )
+
+ call r8vec_print_some ( numFaces, arx, 1, 10, &
+ ' First 10 elements of Arx array:' )
+
+ call r8vec_print_some ( numFaces, ary, 1, 10, &
+ ' First 10 elements of Ary array:' )
+
+ call r8vec_print_some ( numFaces, arz, 1, 10, &
+ ' First 10 elements of Arz array:' )
+
+ call r8vec_print_some ( numFaces, xf, 1, 10, &
+ ' First 10 elements of xf array:' )
+
+ call r8vec_print_some ( numFaces, yf, 1, 10, &
+ ' First 10 elements of yf array:' )
+
+ call r8vec_print_some ( numFaces, zf, 1, 10, &
+ ' First 10 elements of zf array:' )
+
+ call r8vec_print_some ( numInnerFaces, facint, 1, 10, &
+ ' First 10 elements of interpolation factor (facint) array:' )
+
+ write ( *, '(a)' ) ' '
+
+ ! Thank you
+ deallocate(nnodes)
+ deallocate(node)
+ deallocate(r8tmp)
+
+ deallocate ( x )
+ deallocate ( y )
+ deallocate ( z )
+
+!
+! > CLOSE polyMesh format file: 'points', 'faces', 'owner', 'neighbour', 'boundary'.
+!
+ close ( points_file )
+ close ( faces_file )
+ close ( owner_file )
+ close ( neighbour_file)
+ close ( boundary_file)
+!+-----------------------------------------------------------------------------+
+
+end subroutine read_mesh
+
+
+
+subroutine triangle_area_vector(px,py,pz,qx,qy,qz,nx,ny,nz)
+!
+! Ai, i=1,n are n triangular faces enclosing polyhedron P.
+! Vertices of Ai are (ai,bi,ci),
+! _ _ _ _ _ _ _ _
+! Unit normal to P on each Ai is ni = ni/|ni|, ni = (bi-ai)x(ci-ai)
+! and
+! _ _ _ _ _ _
+! p = (bi-ai); q = (ci-ai)
+!
+! Finally: _
+! Area A of Ai, A = 1/2|ni|
+!
+! Sources:
+! [1] Dr Robert Nurnberg, Imperial College London, www.ma.ic.ac.uk/~rn/centroid.pdf
+! [2] paulbourke.net/geometry/polygonmesh
+!
+ implicit none
+ real(dp), intent(in) :: px,py,pz,qx,qy,qz
+ real(dp), intent(inout) :: nx,ny,nz
+
+ real(dp), parameter :: half = 0.5_dp
+
+ ! Cross products for triangle surface vectors
+ nx = half * (py*qz-pz*qy)
+ ny = half * (pz*qx-px*qz)
+ nz = half * (px*qy-py*qx)
+
+end subroutine
+
+
+subroutine find_intersection_point( &
+! plane defined by three face corners:
+ x1,y1,z1,&
+ x2,y2,z2, &
+ x3,y3,z3, &
+! line defined by cell center and neighbour center:
+ x4,y4,z4, &
+ x5,y5,z5, &
+! intersection point (output):
+ xjp,yjp,zjp &
+ )
+!
+!***********************************************************************
+! Find intersection point (pjp={xjp,yjp,zjp}) of
+! plane (defined by points p1={x1,y1,z1}, p2={x2,y2,z2} and p3={x3,y3,z3}),
+! and line (defined by points p4={x4,y4,z4} and p5={x5,y5,z5}).
+! The intersection point j' is not the face center j on non-orthogonal meshes.
+! There is an "intersection point offset" |jj'| which determines the level
+! of nonorthogonality.
+!
+!
+! |1 1 1 1 | |1 1 1 0 |
+! t = - |x1 x2 x3 x4| / |x1 x2 x3 x5-x4| (mind the minus sign!)
+! |y1 y2 y3 y4| / |y1 y2 y3 y5-y4|
+! |z1 z2 z3 z4| |z1 z2 z3 z5-z4|
+!
+! And intersection point is given by:
+! xj = x4 +(x5-x4)*t
+! yj = y4 +(y5-y4)*t
+! zj = z4 +(z5-z4)*t
+!
+!
+! Nikola Mirkov 2016.
+!
+!***********************************************************************
+ implicit none
+!
+!***********************************************************************
+!
+
+ real(dp), intent(in) :: x1,y1,z1,&
+ x2,y2,z2, &
+ x3,y3,z3, &
+ x4,y4,z4, &
+ x5,y5,z5
+ real(dp), intent(inout) :: xjp,yjp,zjp
+
+ real(dp) :: t
+
+ ! Produced by MATLAB symbolic tool.
+ t =-(x2*(y3*z4-y4*z3)-x1*(y3*z4-y4*z3)-x3*(y2*z4-y4*z2)+x1*(y2*z4-y4*z2)+x3*(y1*z4-y4*z1)-x2* &
+ (y1*z4-y4*z1)+x4*(y2*z3-y3*z2)-x1*(y2*z3-y3*z2)-x4*(y1*z3-y3*z1)+x2*(y1*z3-y3*z1)+x4* &
+ (y1*z2-y2*z1)-x3*(y1*z2-y2*z1)) &
+ /(x2*(y3*(z5-z4)-(y5-y4)*z3)-x1*(y3*(z5-z4)-(y5-y4)*z3)-x3*(y2*(z5-z4)-(y5-y4)*z2)+x1* &
+ (y2*(z5-z4)-(y5-y4)*z2)+x3*(y1*(z5-z4)-(y5-y4)*z1)-x2*(y1*(z5-z4)-(y5-y4)*z1)+(x5-x4)* &
+ (y2*z3-y3*z2)-(x5-x4)*(y1*z3-y3*z1)+(x5-x4)*(y1*z2-y2*z1) + tiny)
+
+ xjp = x4 +(x5-x4)*t
+ yjp = y4 +(y5-y4)*t
+ zjp = z4 +(z5-z4)*t
+
+end subroutine
+
+
+subroutine read_line_faces_file_polyMesh(faces_file,nn,nod,nmax)
+ implicit none
+ integer, intent(in) :: faces_file
+ integer, intent(in) :: nmax
+ integer, intent(out) :: nn
+ integer, dimension(nmax), intent(out) :: nod
+ integer :: j,m,n
+ character(len=30) :: char_string,char_string2
+
+ nn = 0
+ nod = 0
+
+ ! Read how many nodes in face
+ read(faces_file,*) char_string ! e.g. 4(1 22 463 442)
+ read(char_string(1:1),*)j ! in this example j=4
+ backspace(faces_file) ! go back so you are able to read this line again (what can I do...)
+
+ read(faces_file,*) char_string,nod(2:j-1),char_string2
+
+ ! Char to double conversion:
+ read(char_string(1:1),*)j ! number of vertrices
+ read(char_string(3:),*) m ! first vertex
+ read(char_string2(1:len_trim(char_string2)-1),*) n ! last vertex
+
+ nn = j
+ nod(1) = m + 1 ! <
+ nod(2:j-1) = nod(2:j-1) + 1 ! < We are going from zero to one based numbering because of Fortran
+ nod(nn) = n + 1 ! <
+
+end subroutine
+
+
+
+end module
\ No newline at end of file
diff --git a/src/misc/precision.f90 b/src/misc/precision.f90
new file mode 100644
index 0000000..a56b4c3
--- /dev/null
+++ b/src/misc/precision.f90
@@ -0,0 +1,8 @@
+
+module prec
+!
+! define precision for floating-point numbers
+!
+ ! double precision
+ integer, parameter :: dp = kind(1.0d0)
+end module prec
\ No newline at end of file